Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
H
haskell-igraph
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
1
Issues
1
List
Board
Labels
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
gargantext
haskell-igraph
Commits
34553acc
Commit
34553acc
authored
Feb 23, 2020
by
Kai Zhang
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
refactoring
parent
c5f3b13a
Changes
11
Show whitespace changes
Inline
Side-by-side
Showing
11 changed files
with
256 additions
and
140 deletions
+256
-140
ChangeLog.md
ChangeLog.md
+6
-1
haskell-igraph.cabal
haskell-igraph.cabal
+3
-3
Algorithms.hs
src/IGraph/Algorithms.hs
+2
-2
Clique.chs
src/IGraph/Algorithms/Clique.chs
+9
-4
Community.chs
src/IGraph/Algorithms/Community.chs
+94
-47
Generators.chs
src/IGraph/Algorithms/Generators.chs
+15
-0
Isomorphism.chs
src/IGraph/Algorithms/Isomorphism.chs
+13
-12
Layout.chs
src/IGraph/Algorithms/Layout.chs
+62
-54
Motif.chs
src/IGraph/Algorithms/Motif.chs
+24
-5
Structure.chs
src/IGraph/Algorithms/Structure.chs
+12
-11
Algorithms.hs
tests/Test/Algorithms.hs
+16
-1
No files found.
ChangeLog.md
View file @
34553acc
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
...
...
haskell-igraph.cabal
View file @
34553acc
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.
1
0 && < 5.0
, bytestring >= 0.9
, bytestring >= 0.9
, cereal
, cereal
, conduit >= 1.3.0
, conduit >= 1.3.0
...
...
src/IGraph/Algorithms.hs
View file @
34553acc
...
@@ -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
...
...
src/IGraph/Algorithms/Clique.chs
View file @
34553acc
...
@@ -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 ^
...
...
src/IGraph/Algorithms/Community.chs
View file @
34553acc
...
@@ -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- #}
src/IGraph/Algorithms/Generators.chs
View file @
34553acc
...
@@ -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
...
...
src/IGraph/Algorithms/Isomorphism.chs
View file @
34553acc
{-# 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
...
...
src/IGraph/Algorithms/Layout.chs
View file @
34553acc
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE ForeignFunctionInterface #-}
module IGraph.Algorithms.Layout
module IGraph.Algorithms.Layout
(
getL
ayout
(
l
ayout
, LayoutMethod(..)
, LayoutMethod(..)
,
defaultK
amadaKawai
,
k
amadaKawai
,
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'
...
...
src/IGraph/Algorithms/Motif.chs
View file @
34553acc
{-# 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- #}
src/IGraph/Algorithms/Structure.chs
View file @
34553acc
...
@@ -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'
...
...
tests/Test/Algorithms.hs
View file @
34553acc
...
@@ -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
))
$
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment