{-# LINE 1 "src/IGraph/Algorithms/Community.chs" #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE DataKinds #-}
module IGraph.Algorithms.Community
( modularity
, findCommunity
, CommunityMethod(..)
, defaultLeadingEigenvector
, defaultSpinglass
) where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Marshal.Utils as C2HSImp
import qualified Foreign.Ptr as C2HSImp
import Data.Function (on)
import Data.List (sortBy, groupBy)
import Data.List.Ordered (nubSortBy)
import Data.Ord (comparing)
import System.IO.Unsafe (unsafePerformIO)
import Foreign
import Foreign.C.Types
import IGraph
import IGraph.Internal.C2HS
import IGraph.Internal
{-# LINE 23 "src/IGraph/Algorithms/Community.chs" #-}
import IGraph.Internal.Constants
{-# LINE 24 "src/IGraph/Algorithms/Community.chs" #-}
modularity :: Graph d v e
-> [[Int]]
-> Maybe [Double]
-> Double
modularity gr clusters ws
| length nds /= length (concat clusters) = error "Duplicated nodes"
| nds /= nodes gr = error "Some nodes were not given community assignments"
| otherwise = unsafePerformIO $ withList membership $ \membership' ->
withListMaybe ws (igraphModularity (_graph gr) membership')
where
(membership, nds) = unzip $ nubSortBy (comparing snd) $ concat $
zipWith f [0 :: Int ..] clusters
where
f i xs = zip (repeat i) xs
igraphModularity :: (IGraph) -> (Ptr Vector) -> (Ptr Vector) -> IO ((Double))
igraphModularity a1 a2 a4 =
(withIGraph) a1 $ \a1' ->
let {a2' = castPtr a2} in
alloca $ \a3' ->
let {a4' = castPtr a4} in
igraphModularity'_ a1' a2' a3' a4' >>= \res ->
peekFloatConv a3'>>= \a3'' ->
return (a3'')
{-# LINE 47 "src/IGraph/Algorithms/Community.chs" #-}
data CommunityMethod =
LeadingEigenvector
{ _nIter :: Int
}
| Spinglass
{ _nSpins :: Int
, _startTemp :: Double
, _stopTemp :: Double
, _coolFact :: Double
, _gamma :: Double
}
defaultLeadingEigenvector :: CommunityMethod
defaultLeadingEigenvector = LeadingEigenvector 10000
defaultSpinglass :: CommunityMethod
defaultSpinglass = Spinglass
{ _nSpins = 25
, _startTemp = 1.0
, _stopTemp = 0.01
, _coolFact = 0.99
, _gamma = 1.0 }
findCommunity :: Graph 'U v e
-> Maybe [Double]
-> CommunityMethod
-> [[Int]]
findCommunity gr ws method = unsafePerformIO $ allocaVector $ \result ->
withListMaybe ws $ \ws' -> do
case method of
LeadingEigenvector n -> allocaArpackOpt $ \arpack ->
igraphCommunityLeadingEigenvector (_graph gr) ws' nullPtr result
n arpack nullPtr False
nullPtr nullPtr nullPtr
nullFunPtr nullPtr
Spinglass{..} -> igraphCommunitySpinglass (_graph gr) ws' nullPtr nullPtr result
nullPtr _nSpins False _startTemp
_stopTemp _coolFact
IgraphSpincommUpdateConfig _gamma
IgraphSpincommImpOrig 1.0
fmap ( map (fst . unzip) . groupBy ((==) `on` snd)
. sortBy (comparing snd) . zip [0..] ) $ toList result
igraphCommunitySpinglass :: (IGraph) -> (Ptr Vector) -> (Ptr CDouble) -> (Ptr CDouble) -> (Ptr Vector) -> (Ptr Vector) -> (Int) -> (Bool) -> (Double) -> (Double) -> (Double) -> (SpincommUpdate) -> (Double) -> (SpinglassImplementation) -> (Double) -> IO ()
igraphCommunitySpinglass a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 =
(withIGraph) a1 $ \a1' ->
let {a2' = castPtr a2} in
let {a3' = id a3} in
let {a4' = id a4} in
let {a5' = castPtr a5} in
let {a6' = castPtr a6} in
let {a7' = fromIntegral a7} in
let {a8' = C2HSImp.fromBool a8} in
let {a9' = realToFrac a9} in
let {a10' = realToFrac a10} in
let {a11' = realToFrac a11} in
let {a12' = (fromIntegral . fromEnum) a12} in
let {a13' = realToFrac a13} in
let {a14' = (fromIntegral . fromEnum) a14} in
let {a15' = realToFrac a15} in
igraphCommunitySpinglass'_ a1' a2' a3' a4' a5' a6' a7' a8' a9' a10' a11' a12' a13' a14' a15' >>= \res ->
return ()
{-# LINE 109 "src/IGraph/Algorithms/Community.chs" #-}
igraphCommunityLeadingEigenvector :: (IGraph) -> (Ptr Vector) -> (Ptr Matrix) -> (Ptr Vector) -> (Int) -> (Ptr ArpackOpt) -> (Ptr CDouble) -> (Bool) -> (Ptr Vector) -> (Ptr VectorPtr) -> (Ptr Vector) -> (T) -> (Ptr ()) -> IO ()
igraphCommunityLeadingEigenvector a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 =
(withIGraph) a1 $ \a1' ->
let {a2' = castPtr a2} in
let {a3' = castPtr a3} in
let {a4' = castPtr a4} in
let {a5' = fromIntegral a5} in
let {a6' = castPtr a6} in
let {a7' = id a7} in
let {a8' = C2HSImp.fromBool a8} in
let {a9' = castPtr a9} in
let {a10' = castPtr a10} in
let {a11' = castPtr a11} in
let {a12' = id a12} in
let {a13' = id a13} in
igraphCommunityLeadingEigenvector'_ a1' a2' a3' a4' a5' a6' a7' a8' a9' a10' a11' a12' a13' >>= \res ->
return ()
{-# LINE 125 "src/IGraph/Algorithms/Community.chs" #-}
type T = FunPtr ( Ptr ()
-> CLong
-> CDouble
-> Ptr ()
-> FunPtr (Ptr CDouble -> Ptr CDouble -> CInt -> Ptr () -> IO CInt)
-> Ptr ()
-> Ptr ()
-> IO CInt)
foreign import ccall safe "IGraph/Algorithms/Community.chs.h igraph_modularity"
igraphModularity'_ :: ((C2HSImp.Ptr (IGraph)) -> ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CDouble) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt)))))
foreign import ccall safe "IGraph/Algorithms/Community.chs.h igraph_community_spinglass"
igraphCommunitySpinglass'_ :: ((C2HSImp.Ptr (IGraph)) -> ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CDouble) -> ((C2HSImp.Ptr C2HSImp.CDouble) -> ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CInt -> (C2HSImp.CDouble -> (C2HSImp.CInt -> (C2HSImp.CDouble -> (IO C2HSImp.CInt))))))))))))))))
foreign import ccall safe "IGraph/Algorithms/Community.chs.h igraph_community_leading_eigenvector"
igraphCommunityLeadingEigenvector'_ :: ((C2HSImp.Ptr (IGraph)) -> ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CDouble) -> (C2HSImp.CInt -> ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> ((C2HSImp.FunPtr ((C2HSImp.Ptr ()) -> (C2HSImp.CLong -> (C2HSImp.CDouble -> ((C2HSImp.Ptr ()) -> ((C2HSImp.FunPtr ((C2HSImp.Ptr C2HSImp.CDouble) -> ((C2HSImp.Ptr C2HSImp.CDouble) -> (C2HSImp.CInt -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt)))))) -> ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))))))))) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))))))))))))))