Commit 34553acc authored by Kai Zhang's avatar Kai Zhang

refactoring

parent c5f3b13a
Revision history for haskell-igraph Revision history for haskell-igraph
=================================== ===================================
v0.8.0 -- XXXX-XX-XX v0.8.1 -- 2020-02-XX
--------------------
Add more functions
v0.8.0 -- 2020-02-22
-------------------- --------------------
* Ship igraph C sources v0.8.0 * Ship igraph C sources v0.8.0
......
cabal-version: 2.2 cabal-version: 2.2
name: haskell-igraph name: haskell-igraph
version: 0.8.0 version: 0.8.1
synopsis: Bindings to the igraph C library (v0.8.0). synopsis: Bindings to the igraph C library (v0.8.0).
description: igraph<"http://igraph.org/c/"> is a library for creating description: igraph<"http://igraph.org/c/"> is a library for creating
and manipulating large graphs. This package provides the Haskell and manipulating large graphs. This package provides the Haskell
...@@ -41,7 +41,7 @@ library ...@@ -41,7 +41,7 @@ library
IGraph.Algorithms.Structure IGraph.Algorithms.Structure
IGraph.Algorithms.Community IGraph.Algorithms.Community
IGraph.Algorithms.Clique IGraph.Algorithms.Clique
--IGraph.Algorithms.Layout IGraph.Algorithms.Layout
IGraph.Algorithms.Motif IGraph.Algorithms.Motif
IGraph.Algorithms.Generators IGraph.Algorithms.Generators
IGraph.Algorithms.Isomorphism IGraph.Algorithms.Isomorphism
...@@ -51,7 +51,7 @@ library ...@@ -51,7 +51,7 @@ library
IGraph.Internal.C2HS IGraph.Internal.C2HS
build-depends: build-depends:
base >= 4.0 && < 5.0 base >= 4.10 && < 5.0
, bytestring >= 0.9 , bytestring >= 0.9
, cereal , cereal
, conduit >= 1.3.0 , conduit >= 1.3.0
......
...@@ -2,7 +2,7 @@ module IGraph.Algorithms ...@@ -2,7 +2,7 @@ module IGraph.Algorithms
( module IGraph.Algorithms.Structure ( module IGraph.Algorithms.Structure
, module IGraph.Algorithms.Community , module IGraph.Algorithms.Community
, module IGraph.Algorithms.Clique , module IGraph.Algorithms.Clique
-- , module IGraph.Algorithms.Layout , module IGraph.Algorithms.Layout
, module IGraph.Algorithms.Motif , module IGraph.Algorithms.Motif
, module IGraph.Algorithms.Generators , module IGraph.Algorithms.Generators
, module IGraph.Algorithms.Isomorphism , module IGraph.Algorithms.Isomorphism
...@@ -12,7 +12,7 @@ module IGraph.Algorithms ...@@ -12,7 +12,7 @@ module IGraph.Algorithms
import IGraph.Algorithms.Structure import IGraph.Algorithms.Structure
import IGraph.Algorithms.Community import IGraph.Algorithms.Community
import IGraph.Algorithms.Clique import IGraph.Algorithms.Clique
--import IGraph.Algorithms.Layout import IGraph.Algorithms.Layout
import IGraph.Algorithms.Motif import IGraph.Algorithms.Motif
import IGraph.Algorithms.Generators import IGraph.Algorithms.Generators
import IGraph.Algorithms.Isomorphism import IGraph.Algorithms.Isomorphism
......
...@@ -6,10 +6,7 @@ module IGraph.Algorithms.Clique ...@@ -6,10 +6,7 @@ module IGraph.Algorithms.Clique
, cliqueNumber , cliqueNumber
) where ) where
import Control.Applicative ((<$>))
import System.IO.Unsafe (unsafePerformIO) import System.IO.Unsafe (unsafePerformIO)
import qualified Foreign.Ptr as C2HSImp
import Foreign import Foreign
import IGraph import IGraph
...@@ -18,6 +15,7 @@ import IGraph.Internal.C2HS ...@@ -18,6 +15,7 @@ import IGraph.Internal.C2HS
#include "haskell_igraph.h" #include "haskell_igraph.h"
-- | Find all or some cliques in a graph.
cliques :: Graph d v e cliques :: Graph d v e
-> (Int, Int) -- ^ Minimum and maximum size of the cliques to be returned. -> (Int, Int) -- ^ Minimum and maximum size of the cliques to be returned.
-- No bound will be used if negative or zero -- No bound will be used if negative or zero
...@@ -27,12 +25,16 @@ cliques gr (lo, hi) = unsafePerformIO $ allocaVectorPtr $ \vptr -> do ...@@ -27,12 +25,16 @@ cliques gr (lo, hi) = unsafePerformIO $ allocaVectorPtr $ \vptr -> do
(map.map) truncate <$> toLists vptr (map.map) truncate <$> toLists vptr
{#fun igraph_cliques as ^ { `IGraph', castPtr `Ptr VectorPtr', `Int', `Int' } -> `CInt' void- #} {#fun igraph_cliques as ^ { `IGraph', castPtr `Ptr VectorPtr', `Int', `Int' } -> `CInt' void- #}
-- | Finds the largest clique(s) in a graph.
-- Time complexity: O(3^(|V|/3)) worst case.
largestCliques :: Graph d v e -> [[Int]] largestCliques :: Graph d v e -> [[Int]]
largestCliques gr = unsafePerformIO $ allocaVectorPtr $ \vptr -> do largestCliques gr = unsafePerformIO $ allocaVectorPtr $ \vptr -> do
igraphLargestCliques (_graph gr) vptr igraphLargestCliques (_graph gr) vptr
(map.map) truncate <$> toLists vptr (map.map) truncate <$> toLists vptr
{#fun igraph_largest_cliques as ^ { `IGraph', castPtr `Ptr VectorPtr' } -> `CInt' void- #} {#fun igraph_largest_cliques as ^ { `IGraph', castPtr `Ptr VectorPtr' } -> `CInt' void- #}
-- | Find all maximal cliques of a graph. Time complexity: O(d(n-d)3^(d/3))
-- worst case, d is the degeneracy of the graph.
maximalCliques :: Graph d v e maximalCliques :: Graph d v e
-> (Int, Int) -- ^ Minimum and maximum size of the cliques to be returned. -> (Int, Int) -- ^ Minimum and maximum size of the cliques to be returned.
-- No bound will be used if negative or zero -- No bound will be used if negative or zero
...@@ -42,6 +44,9 @@ maximalCliques gr (lo, hi) = unsafePerformIO $ allocaVectorPtr $ \vpptr -> do ...@@ -42,6 +44,9 @@ maximalCliques gr (lo, hi) = unsafePerformIO $ allocaVectorPtr $ \vpptr -> do
(map.map) truncate <$> toLists vpptr (map.map) truncate <$> toLists vpptr
{#fun igraph_maximal_cliques as ^ { `IGraph', castPtr `Ptr VectorPtr', `Int', `Int' } -> `CInt' void- #} {#fun igraph_maximal_cliques as ^ { `IGraph', castPtr `Ptr VectorPtr', `Int', `Int' } -> `CInt' void- #}
-- | Find the clique number of the graph. The clique number of a graph is
-- the size of the largest clique.
-- Time complexity: O(3^(|V|/3)) worst case.
cliqueNumber :: Graph d v e -> Int cliqueNumber :: Graph d v e -> Int
cliqueNumber gr = unsafePerformIO $ igraphCliqueNumber $ _graph gr cliqueNumber gr = unsafePerformIO $ igraphCliqueNumber $ _graph gr
{#fun igraph_clique_number as ^ {#fun igraph_clique_number as ^
......
...@@ -2,11 +2,12 @@ ...@@ -2,11 +2,12 @@
{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
module IGraph.Algorithms.Community module IGraph.Algorithms.Community
( modularity ( findCommunity
, findCommunity
, CommunityMethod(..) , CommunityMethod(..)
, defaultLeadingEigenvector , leadingEigenvector
, defaultSpinglass , spinglass
, leiden
, modularity
) where ) where
import Data.Function (on) import Data.Function (on)
...@@ -14,37 +15,53 @@ import Data.List (sortBy, groupBy) ...@@ -14,37 +15,53 @@ import Data.List (sortBy, groupBy)
import Data.List.Ordered (nubSortBy) import Data.List.Ordered (nubSortBy)
import Data.Ord (comparing) import Data.Ord (comparing)
import System.IO.Unsafe (unsafePerformIO) import System.IO.Unsafe (unsafePerformIO)
import Data.Serialize (Serialize)
import Foreign import Foreign
import Foreign.C.Types import Foreign.C.Types
import IGraph import IGraph
import IGraph.Random
import IGraph.Internal.C2HS import IGraph.Internal.C2HS
{#import IGraph.Internal #} {#import IGraph.Internal #}
{#import IGraph.Internal.Constants #} {#import IGraph.Internal.Constants #}
#include "haskell_igraph.h" #include "haskell_igraph.h"
modularity :: Graph d v e -- | Detecting community structure.
-> [[Int]] -- ^ Communities. findCommunity :: (Serialize v, Serialize e)
-> Maybe [Double] -- ^ Weights => Graph 'U v e
-> Double -> Maybe (v -> Double) -- ^ Function to assign node weights
modularity gr clusters ws -> Maybe (e -> Double) -- ^ Function to assign edge weights
| length nds /= length (concat clusters) = error "Duplicated nodes" -> CommunityMethod -- ^ Community finding algorithms
| nds /= nodes gr = error "Some nodes were not given community assignments" -> Gen
| otherwise = unsafePerformIO $ withList membership $ \membership' -> -> [[Int]]
withListMaybe ws (igraphModularity (_graph gr) membership') findCommunity gr getNodeW getEdgeW method _ = unsafePerformIO $ allocaVector $ \result ->
where withListMaybe ew $ \ew' -> do
(membership, nds) = unzip $ nubSortBy (comparing snd) $ concat $ case method of
zipWith f [0 :: Int ..] clusters LeadingEigenvector n -> allocaArpackOpt $ \arpack ->
igraphCommunityLeadingEigenvector (_graph gr) ew' nullPtr result
n arpack nullPtr False
nullPtr nullPtr nullPtr
nullFunPtr nullPtr
Spinglass{..} -> igraphCommunitySpinglass (_graph gr) ew' nullPtr nullPtr result
nullPtr _nSpins False _startTemp
_stopTemp _coolFact
IgraphSpincommUpdateConfig _gamma
IgraphSpincommImpOrig 1.0
Leiden{..} -> do
_ <- withListMaybe nw $ \nw' -> igraphCommunityLeiden
(_graph gr) ew' nw' _resolution _beta False result nullPtr
return ()
fmap ( map (fst . unzip) . groupBy ((==) `on` snd)
. sortBy (comparing snd) . zip [0..] ) $ toList result
where where
f i xs = zip (repeat i) xs ew = case getEdgeW of
{#fun igraph_modularity as ^ Nothing -> Nothing
{ `IGraph' Just f -> Just $ map (f . snd) $ labEdges gr
, castPtr `Ptr Vector' nw = case getNodeW of
, alloca- `Double' peekFloatConv* Nothing -> Nothing
, castPtr `Ptr Vector' Just f -> Just $ map (f . snd) $ labNodes gr
} -> `CInt' void- #}
data CommunityMethod = data CommunityMethod =
LeadingEigenvector LeadingEigenvector
...@@ -57,38 +74,29 @@ data CommunityMethod = ...@@ -57,38 +74,29 @@ data CommunityMethod =
, _coolFact :: Double -- ^ the cooling factor for the simulated annealing , _coolFact :: Double -- ^ the cooling factor for the simulated annealing
, _gamma :: Double -- ^ the gamma parameter of the algorithm. , _gamma :: Double -- ^ the gamma parameter of the algorithm.
} }
| Leiden
{ _resolution :: Double
, _beta :: Double
}
defaultLeadingEigenvector :: CommunityMethod -- | Default parameters for the leading eigenvector algorithm.
defaultLeadingEigenvector = LeadingEigenvector 10000 leadingEigenvector :: CommunityMethod
leadingEigenvector = LeadingEigenvector 10000
defaultSpinglass :: CommunityMethod -- | Default parameters for the spin-glass algorithm.
defaultSpinglass = Spinglass spinglass :: CommunityMethod
spinglass = Spinglass
{ _nSpins = 25 { _nSpins = 25
, _startTemp = 1.0 , _startTemp = 1.0
, _stopTemp = 0.01 , _stopTemp = 0.01
, _coolFact = 0.99 , _coolFact = 0.99
, _gamma = 1.0 } , _gamma = 1.0 }
findCommunity :: Graph 'U v e -- | Default parameters for the leiden algorithm.
-> Maybe [Double] -- ^ node weights leiden :: CommunityMethod
-> CommunityMethod -- ^ Community finding algorithms leiden = Leiden
-> [[Int]] { _resolution = 1
findCommunity gr ws method = unsafePerformIO $ allocaVector $ \result -> , _beta = 0 }
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
{#fun igraph_community_spinglass as ^ {#fun igraph_community_spinglass as ^
{ `IGraph' { `IGraph'
...@@ -124,6 +132,18 @@ findCommunity gr ws method = unsafePerformIO $ allocaVector $ \result -> ...@@ -124,6 +132,18 @@ findCommunity gr ws method = unsafePerformIO $ allocaVector $ \result ->
, id `Ptr ()' , id `Ptr ()'
} -> `CInt' void- #} } -> `CInt' void- #}
{#fun igraph_community_leiden as ^
{ `IGraph'
, castPtr `Ptr Vector'
, castPtr `Ptr Vector'
, `Double'
, `Double'
, `Bool'
, castPtr `Ptr Vector'
, alloca- `Int' peekIntConv*
, id `Ptr CDouble'
} -> `CInt' void- #}
type T = FunPtr ( Ptr () type T = FunPtr ( Ptr ()
-> CLong -> CLong
-> CDouble -> CDouble
...@@ -132,3 +152,30 @@ type T = FunPtr ( Ptr () ...@@ -132,3 +152,30 @@ type T = FunPtr ( Ptr ()
-> Ptr () -> Ptr ()
-> Ptr () -> Ptr ()
-> IO CInt) -> IO CInt)
-- | Calculate the modularity of a graph with respect to some vertex types.
modularity :: Serialize e
=> Graph d v e
-> Maybe (e -> Double) -- ^ Function to assign edge weights
-> [[Int]] -- ^ Communities.
-> Double
modularity gr getEdgeW clusters
| 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
ws = case getEdgeW of
Nothing -> Nothing
Just f -> Just $ map (f . snd) $ labEdges gr
{#fun igraph_modularity as ^
{ `IGraph'
, castPtr `Ptr Vector'
, alloca- `Double' peekFloatConv*
, castPtr `Ptr Vector'
} -> `CInt' void- #}
...@@ -5,6 +5,7 @@ module IGraph.Algorithms.Generators ...@@ -5,6 +5,7 @@ module IGraph.Algorithms.Generators
( full ( full
, star , star
, ring , ring
, zacharyKarate
, ErdosRenyiModel(..) , ErdosRenyiModel(..)
, erdosRenyiGame , erdosRenyiGame
, degreeSequenceGame , degreeSequenceGame
...@@ -78,6 +79,20 @@ ring n = unsafePerformIO $ do ...@@ -78,6 +79,20 @@ ring n = unsafePerformIO $ do
, `Bool' , `Bool'
} -> `CInt' void- #} } -> `CInt' void- #}
-- | Zachary's karate club
zacharyKarate :: Graph 'U () ()
zacharyKarate = mkGraph (replicate 34 ()) $ map (\(a, b) -> ((a-1,b-1),())) es
where
es = [ (2,1),(3,1),(3,2),(4,1),(4,2),(4,3),(5,1),(6,1),(7,1),(7,5),(7,6)
, (8,1),(8,2),(8,3),(8,4),(9,1),(9,3),(10,3),(11,1),(11,5),(11,6)
, (12,1),(13,1),(13,4),(14,1),(14,2),(14,3),(14,4),(17,6),(17,7)
, (18,1),(18,2),(20,1),(20,2),(22,1),(22,2),(26,24),(26,25)
, (28,3),(28,24),(28,25),(29,3),(30,24),(30,27),(31,2),(31,9)
, (32,1),(32,25),(32,26),(32,29),(33,3),(33,9),(33,15),(33,16)
, (33,19),(33,21),(33,23),(33,24),(33,30),(33,31),(33,32)
, (34,9),(34,10),(34,14),(34,15),(34,16),(34,19),(34,20),(34,21)
, (34,23),(34,24),(34,27),(34,28),(34,29),(34,30),(34,31),(34,32),(34,33) ]
data ErdosRenyiModel = GNP Int Double -- ^ G(n,p) graph, every possible edge is data ErdosRenyiModel = GNP Int Double -- ^ G(n,p) graph, every possible edge is
-- included in the graph with probability p. -- included in the graph with probability p.
| GNM Int Int -- ^ G(n,m) graph, m edges are selected | GNM Int Int -- ^ G(n,m) graph, m edges are selected
......
{-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
module IGraph.Algorithms.Isomorphism module IGraph.Algorithms.Isomorphism
( getSubisomorphisms ( isomorphic
, isomorphic , getSubisomorphisms
, isoclassCreate , isoclassCreate
, isoclass3 , isoclass3
, isoclass4 , isoclass4
...@@ -20,6 +20,17 @@ import IGraph.Internal.Initialization (igraphInit) ...@@ -20,6 +20,17 @@ import IGraph.Internal.Initialization (igraphInit)
#include "haskell_igraph.h" #include "haskell_igraph.h"
-- | Determine whether two graphs are isomorphic.
isomorphic :: Graph d v1 e1
-> Graph d v2 e2
-> Bool
isomorphic g1 g2 = unsafePerformIO $ alloca $ \ptr -> do
_ <- igraphIsomorphic (_graph g1) (_graph g2) ptr
x <- peek ptr
return (x /= 0)
{-# INLINE isomorphic #-}
{#fun igraph_isomorphic as ^ { `IGraph', `IGraph', id `Ptr CInt' } -> `CInt' void- #}
getSubisomorphisms :: Graph d v1 e1 -- ^ graph to be searched in getSubisomorphisms :: Graph d v1 e1 -- ^ graph to be searched in
-> Graph d v2 e2 -- ^ smaller graph -> Graph d v2 e2 -- ^ smaller graph
-> [[Int]] -> [[Int]]
...@@ -44,16 +55,6 @@ getSubisomorphisms g1 g2 = unsafePerformIO $ allocaVectorPtr $ \vpptr -> do ...@@ -44,16 +55,6 @@ getSubisomorphisms g1 g2 = unsafePerformIO $ allocaVectorPtr $ \vpptr -> do
, id `Ptr ()' , id `Ptr ()'
} -> `CInt' void- #} } -> `CInt' void- #}
-- | Determine whether two graphs are isomorphic.
isomorphic :: Graph d v1 e1
-> Graph d v2 e2
-> Bool
isomorphic g1 g2 = unsafePerformIO $ alloca $ \ptr -> do
_ <- igraphIsomorphic (_graph g1) (_graph g2) ptr
x <- peek ptr
return (x /= 0)
{#fun igraph_isomorphic as ^ { `IGraph', `IGraph', id `Ptr CInt' } -> `CInt' void- #}
-- | Creates a graph from the given isomorphism class. -- | Creates a graph from the given isomorphism class.
-- This function is implemented only for graphs with three or four vertices. -- This function is implemented only for graphs with three or four vertices.
isoclassCreate :: forall d. SingI d isoclassCreate :: forall d. SingI d
......
{-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE ForeignFunctionInterface #-}
module IGraph.Algorithms.Layout module IGraph.Algorithms.Layout
( getLayout ( layout
, LayoutMethod(..) , LayoutMethod(..)
, defaultKamadaKawai , kamadaKawai
, defaultLGL , lgl
) where ) where
import Data.Maybe (isJust) import Data.Maybe (isJust, fromMaybe)
import Foreign (nullPtr) import Foreign (nullPtr)
import System.IO.Unsafe (unsafePerformIO)
import Foreign import Foreign
import IGraph import IGraph
import IGraph.Random
{#import IGraph.Internal #} {#import IGraph.Internal #}
#include "haskell_igraph.h" #include "haskell_igraph.h"
layout :: Graph d v e -> LayoutMethod -> Gen -> [(Double, Double)]
layout gr method _ = unsafePerformIO $ case method of
Random -> allocaMatrix $ \mat -> do
igraphLayoutRandom gptr mat
getResult mat
KamadaKawai seed niter kkconst epsilon -> do
let f mat = igraphLayoutKamadaKawai gptr mat (isJust seed) niter
epsilon (fromMaybe (fromIntegral $ nNodes gr) kkconst) nullPtr
nullPtr nullPtr nullPtr nullPtr
case seed of
Nothing -> allocaMatrix $ \mat -> do
f mat
getResult mat
Just s -> withRowLists ((\(x,y) -> [x,y]) $ unzip s) $ \mat -> do
f mat
getResult mat
LGL niter delta area coolexp repulserad cellsize -> allocaMatrix $ \mat -> do
igraphLayoutLgl gptr mat niter (delta n) (area n) coolexp
(repulserad n) (cellsize n) (-1)
getResult mat
where
n = nNodes gr
gptr = _graph gr
getResult mat = (\[x, y] -> zip x y) <$> toColumnLists mat
data LayoutMethod = data LayoutMethod =
KamadaKawai { kk_seed :: !(Maybe [(Double, Double)]) Random
, kk_nIter :: !Int | KamadaKawai { kk_seed :: Maybe [(Double, Double)]
, kk_sigma :: (Int -> Double) -- ^ The base standard deviation of , kk_nIter :: Int
-- position change proposals , kk_const :: Maybe Double -- ^ The Kamada-Kawai vertex attraction constant
, kk_startTemp :: !Double -- ^ The initial temperature for the annealing , kk_epsilon :: Double
, kk_coolFact :: !Double -- ^ The cooling factor for the simulated annealing } -- ^ The Kamada-Kawai algorithm. Time complexity: O(|V|)
, kk_const :: (Int -> Double) -- ^ The Kamada-Kawai vertex attraction constant -- for each iteration, after an O(|V|^2 log|V|)
} -- initialization step.
| LGL { lgl_nIter :: !Int | LGL { lgl_nIter :: !Int
, lgl_maxdelta :: (Int -> Double) -- ^ The maximum length of the move allowed , lgl_maxdelta :: (Int -> Double) -- ^ The maximum length of the move allowed
-- for a vertex in a single iteration. A reasonable default is the number of vertices. -- for a vertex in a single iteration. A reasonable default is the number of vertices.
...@@ -38,18 +67,17 @@ data LayoutMethod = ...@@ -38,18 +67,17 @@ data LayoutMethod =
, lgl_cellsize :: (Int -> Double) , lgl_cellsize :: (Int -> Double)
} }
defaultKamadaKawai :: LayoutMethod -- | Default parameters for the Kamada-Kawai algorithm.
defaultKamadaKawai = KamadaKawai kamadaKawai :: LayoutMethod
kamadaKawai = KamadaKawai
{ kk_seed = Nothing { kk_seed = Nothing
, kk_nIter = 10 , kk_nIter = 10
, kk_sigma = \x -> fromIntegral x / 4 , kk_const = Nothing
, kk_startTemp = 10 , kk_epsilon = 0 }
, kk_coolFact = 0.99
, kk_const = \x -> fromIntegral $ x^2
}
defaultLGL :: LayoutMethod -- | Default parameters for the LGL algorithm.
defaultLGL = LGL lgl :: LayoutMethod
lgl = LGL
{ lgl_nIter = 100 { lgl_nIter = 100
, lgl_maxdelta = \x -> fromIntegral x , lgl_maxdelta = \x -> fromIntegral x
, lgl_area = area , lgl_area = area
...@@ -60,40 +88,20 @@ defaultLGL = LGL ...@@ -60,40 +88,20 @@ defaultLGL = LGL
where where
area x = fromIntegral $ x^2 area x = fromIntegral $ x^2
getLayout :: Graph d v e -> LayoutMethod -> IO [(Double, Double)] -- | Places the vertices uniform randomly on a plane.
getLayout gr method = case method of {#fun igraph_layout_random as ^
KamadaKawai seed niter sigma initemp coolexp kkconst -> case seed of
Nothing -> allocaMatrix $ \mat -> do
igraphLayoutKamadaKawai gptr mat niter (sigma n) initemp coolexp
(kkconst n) (isJust seed) nullPtr nullPtr nullPtr nullPtr
[x, y] <- toColumnLists mat
return $ zip x y
Just xs -> if length xs /= nNodes gr
then error "Seed error: incorrect size"
else withRowLists ((\(x,y) -> [x,y]) (unzip xs)) $ \mat -> do
igraphLayoutKamadaKawai gptr mat niter (sigma n) initemp coolexp
(kkconst n) (isJust seed) nullPtr nullPtr nullPtr nullPtr
[x, y] <- toColumnLists mat
return $ zip x y
LGL niter delta area coolexp repulserad cellsize -> allocaMatrix $ \mat -> do
igraphLayoutLgl gptr mat niter (delta n) (area n) coolexp
(repulserad n) (cellsize n) (-1)
[x, y] <- toColumnLists mat
return $ zip x y
where
n = nNodes gr
gptr = _graph gr
{#fun igraph_layout_kamada_kawai as ^
{ `IGraph' { `IGraph'
, castPtr `Ptr Matrix' , castPtr `Ptr Matrix'
, `Int' } -> `CInt' void- #}
, `Double'
, `Double' {#fun igraph_layout_kamada_kawai as ^
, `Double' { `IGraph' -- ^ Graph
, `Double' , castPtr `Ptr Matrix' -- ^ Pointer to the result matrix
, `Bool' , `Bool' -- ^ Whether to use the seed
, `Int' -- ^ The maximum number of iterations to perform
, `Double' -- ^ epsilon
, `Double' -- ^ kkconst
, castPtr `Ptr Vector' -- ^ edges weights
, castPtr `Ptr Vector' , castPtr `Ptr Vector'
, castPtr `Ptr Vector' , castPtr `Ptr Vector'
, castPtr `Ptr Vector' , castPtr `Ptr Vector'
......
{-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
module IGraph.Algorithms.Motif module IGraph.Algorithms.Motif
( triad ( dyadCensus
, triad
, triadCensus , triadCensus
) where ) where
...@@ -10,10 +11,26 @@ import System.IO.Unsafe (unsafePerformIO) ...@@ -10,10 +11,26 @@ import System.IO.Unsafe (unsafePerformIO)
import Foreign import Foreign
import IGraph import IGraph
import IGraph.Internal.C2HS
{#import IGraph.Internal #} {#import IGraph.Internal #}
#include "haskell_igraph.h" #include "haskell_igraph.h"
-- | Dyad census means classifying each pair of vertices of a directed graph
-- into three categories: mutual, there is an edge from a to b and also
-- from b to a; asymmetric, there is an edge either from a to b or
-- from b to a but not the other way; null, no edges between a and b.
dyadCensus :: Graph D v e -> (Int, Int, Int)
dyadCensus = unsafePerformIO . igraphDyadCensus . _graph
{-# INLINE dyadCensus #-}
{#fun igraph_dyad_census as ^
{ `IGraph'
, alloca- `Int' peekIntConv*
, alloca- `Int' peekIntConv*
, alloca- `Int' peekIntConv*
} -> `CInt' void- #}
-- | Every triple of vertices in a directed graph -- | Every triple of vertices in a directed graph
-- 003: A, B, C, the empty graph. -- 003: A, B, C, the empty graph.
-- 012: A->B, C, a graph with a single directed edge. -- 012: A->B, C, a graph with a single directed edge.
...@@ -54,16 +71,18 @@ triad = map make edgeList ...@@ -54,16 +71,18 @@ triad = map make edgeList
] ]
make :: [(Int, Int)] -> Graph 'D () () make :: [(Int, Int)] -> Graph 'D () ()
make xs = mkGraph (replicate 3 ()) $ zip xs $ repeat () make xs = mkGraph (replicate 3 ()) $ zip xs $ repeat ()
{-# INLINE triad #-}
triadCensus :: (Ord v, Read v) => Graph d v e -> [Int] -- | Calculating the triad census means classifying every triple of vertices
-- in a directed graph. A triple can be in one of 16 states listed in `triad`.
triadCensus :: (Ord v, Read v) => Graph D v e -> [Int]
triadCensus gr = unsafePerformIO $ allocaVector $ \result -> do triadCensus gr = unsafePerformIO $ allocaVector $ \result -> do
igraphTriadCensus (_graph gr) result igraphTriadCensus (_graph gr) result
map truncate <$> toList result map truncate <$> toList result
{-# INLINE triadCensus #-}
-- motifsRandesu
{#fun igraph_triad_census as ^ { `IGraph' {#fun igraph_triad_census as ^ { `IGraph'
, castPtr `Ptr Vector' } -> `CInt' void- #} , castPtr `Ptr Vector' } -> `CInt' void- #}
-- motifsRandesu
{#fun igraph_motifs_randesu as ^ { `IGraph', castPtr `Ptr Vector', `Int' {#fun igraph_motifs_randesu as ^ { `IGraph', castPtr `Ptr Vector', `Int'
, castPtr `Ptr Vector' } -> `CInt' void- #} , castPtr `Ptr Vector' } -> `CInt' void- #}
...@@ -29,14 +29,6 @@ import IGraph.Internal.C2HS ...@@ -29,14 +29,6 @@ import IGraph.Internal.C2HS
#include "haskell_igraph.h" #include "haskell_igraph.h"
{#fun igraph_shortest_paths as ^
{ `IGraph'
, castPtr `Ptr Matrix'
, castPtr %`Ptr VertexSelector'
, castPtr %`Ptr VertexSelector'
, `Neimode'
} -> `CInt' void- #}
-- Calculates and returns a single unweighted shortest path from a given vertex -- Calculates and returns a single unweighted shortest path from a given vertex
-- to another one. If there are more than one shortest paths between the two -- to another one. If there are more than one shortest paths between the two
-- vertices, then an arbitrary one is returned. -- vertices, then an arbitrary one is returned.
...@@ -53,6 +45,7 @@ shortestPath gr s t getEdgeW = unsafePerformIO $ allocaVector $ \path -> do ...@@ -53,6 +45,7 @@ shortestPath gr s t getEdgeW = unsafePerformIO $ allocaVector $ \path -> do
Just f -> withList (map (f . snd) $ labEdges gr) $ \ws -> Just f -> withList (map (f . snd) $ labEdges gr) $ \ws ->
igraphGetShortestPathDijkstra (_graph gr) path nullPtr s t ws IgraphOut igraphGetShortestPathDijkstra (_graph gr) path nullPtr s t ws IgraphOut
map truncate <$> toList path map truncate <$> toList path
{-# INLINE shortestPath #-}
{#fun igraph_get_shortest_path as ^ {#fun igraph_get_shortest_path as ^
{ `IGraph' { `IGraph'
, castPtr `Ptr Vector' , castPtr `Ptr Vector'
...@@ -71,13 +64,16 @@ shortestPath gr s t getEdgeW = unsafePerformIO $ allocaVector $ \path -> do ...@@ -71,13 +64,16 @@ shortestPath gr s t getEdgeW = unsafePerformIO $ allocaVector $ \path -> do
, `Neimode' , `Neimode'
} -> `CInt' void- #} } -> `CInt' void- #}
-- | Creates a subgraph induced by the specified vertices. This function collects
-- the specified vertices and all edges between them to a new graph.
inducedSubgraph :: (Ord v, Serialize v) inducedSubgraph :: (Ord v, Serialize v)
=> Graph d v e => Graph d v e
-> [Int] -> [Node]
-> Graph d v e -> Graph d v e
inducedSubgraph gr nds = unsafePerformIO $ withVerticesList nds $ \vs -> inducedSubgraph gr nds = unsafePerformIO $ withVerticesList nds $ \vs ->
igraphInducedSubgraph (_graph gr) vs IgraphSubgraphCreateFromScratch >>= igraphInducedSubgraph (_graph gr) vs IgraphSubgraphCreateFromScratch >>=
(\g -> return $ Graph g $ mkLabelToId g) (\g -> return $ Graph g $ mkLabelToId g)
{-# INLINE inducedSubgraph #-}
{#fun igraph_induced_subgraph as ^ {#fun igraph_induced_subgraph as ^
{ `IGraph' { `IGraph'
, allocaIGraph- `IGraph' addIGraphFinalizer* , allocaIGraph- `IGraph' addIGraphFinalizer*
...@@ -88,10 +84,11 @@ inducedSubgraph gr nds = unsafePerformIO $ withVerticesList nds $ \vs -> ...@@ -88,10 +84,11 @@ inducedSubgraph gr nds = unsafePerformIO $ withVerticesList nds $ \vs ->
-- | Decides whether the graph is weakly connected. -- | Decides whether the graph is weakly connected.
isConnected :: Graph d v e -> Bool isConnected :: Graph d v e -> Bool
isConnected gr = igraphIsConnected (_graph gr) IgraphWeak isConnected gr = igraphIsConnected (_graph gr) IgraphWeak
{-# INLINE isConnected #-}
isStronglyConnected :: Graph 'D v e -> Bool isStronglyConnected :: Graph 'D v e -> Bool
isStronglyConnected gr = igraphIsConnected (_graph gr) IgraphStrong isStronglyConnected gr = igraphIsConnected (_graph gr) IgraphStrong
{-# INLINE isStronglyConnected #-}
{#fun pure igraph_is_connected as ^ {#fun pure igraph_is_connected as ^
{ `IGraph' { `IGraph'
, alloca- `Bool' peekBool* , alloca- `Bool' peekBool*
...@@ -124,11 +121,14 @@ isDag = igraphIsDag . _graph ...@@ -124,11 +121,14 @@ isDag = igraphIsDag . _graph
{ `IGraph' { `IGraph'
, alloca- `Bool' peekBool* , alloca- `Bool' peekBool*
} -> `CInt' void- #} } -> `CInt' void- #}
{-# INLINE isDag #-}
-- | Calculate a possible topological sorting of the graph. -- | Calculate a possible topological sorting of the graph. Raise error if the
-- graph is not acyclic.
topSort :: Graph d v e -> [Node] topSort :: Graph d v e -> [Node]
topSort gr | isDag gr = topSortUnsafe gr topSort gr | isDag gr = topSortUnsafe gr
| otherwise = error "the graph is not acyclic" | otherwise = error "the graph is not acyclic"
{-# INLINE topSort #-}
-- | Calculate a possible topological sorting of the graph. If the graph is not -- | Calculate a possible topological sorting of the graph. If the graph is not
-- acyclic (it has at least one cycle), a partial topological sort is returned. -- acyclic (it has at least one cycle), a partial topological sort is returned.
...@@ -138,6 +138,7 @@ topSortUnsafe gr = unsafePerformIO $ allocaVectorN n $ \res -> do ...@@ -138,6 +138,7 @@ topSortUnsafe gr = unsafePerformIO $ allocaVectorN n $ \res -> do
map truncate <$> toList res map truncate <$> toList res
where where
n = nNodes gr n = nNodes gr
{-# INLINE topSortUnsafe #-}
{#fun igraph_topological_sorting as ^ {#fun igraph_topological_sorting as ^
{ `IGraph' { `IGraph'
, castPtr `Ptr Vector' , castPtr `Ptr Vector'
......
...@@ -87,10 +87,25 @@ decomposeTest = testGroup "Decompose" ...@@ -87,10 +87,25 @@ decomposeTest = testGroup "Decompose"
, (8,9), (9,10) ] , (8,9), (9,10) ]
gr = mkGraph (replicate 11 ()) $ zip es $ repeat () :: Graph 'U () () gr = mkGraph (replicate 11 ()) $ zip es $ repeat () :: Graph 'U () ()
{-
communityTest :: TestTree
communityTest = testGroup "Community"
[ consistency ]
where
consistency = testCase "Consistency" $ do
r1 <- withSeed 134 $ return . findCommunity zacharyKarate Nothing spinglass
r2 <- withSeed 14 $ return . findCommunity zacharyKarate Nothing spinglass
r1 @=? r2
-}
pagerankTest :: TestTree pagerankTest :: TestTree
pagerankTest = testGroup "PageRank" pagerankTest = testGroup "PageRank"
[ testCase "case 1" $ ranks @=? ranks' ] [ consistency
, testCase "case 1" $ ranks @=? ranks' ]
where where
consistency = testCase "Consistency" $
pagerank gr 0.85 Nothing Nothing @=?
pagerank gr 0.85 Nothing Nothing
gr = star 11 gr = star 11
ranks = [0.47,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05] ranks = [0.47,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05]
ranks' = map ((/100) . fromIntegral . round. (*100)) $ ranks' = map ((/100) . fromIntegral . round. (*100)) $
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment