Commit de2ab7cc authored by Kai Zhang's avatar Kai Zhang

add shortest path

parent 5a0af3fd
name: haskell-igraph name: haskell-igraph
version: 0.6.0 version: 0.7.0-dev
synopsis: Haskell interface of the igraph library. synopsis: Haskell interface of the igraph library.
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
...@@ -29,17 +29,18 @@ library ...@@ -29,17 +29,18 @@ library
IGraph.Internal.Constants IGraph.Internal.Constants
IGraph.Internal IGraph.Internal
IGraph IGraph
IGraph.Types
IGraph.Mutable IGraph.Mutable
IGraph.Clique IGraph.Types
IGraph.Structure
IGraph.Isomorphism
IGraph.Community
IGraph.Read IGraph.Read
IGraph.Motif
IGraph.Layout
IGraph.Generators
IGraph.Exporter.GEXF IGraph.Exporter.GEXF
IGraph.Algorithms
IGraph.Algorithms.Structure
IGraph.Algorithms.Community
IGraph.Algorithms.Clique
IGraph.Algorithms.Layout
IGraph.Algorithms.Motif
IGraph.Algorithms.Generators
IGraph.Algorithms.Isomorphism
other-modules: other-modules:
IGraph.Internal.C2HS IGraph.Internal.C2HS
...@@ -79,14 +80,12 @@ library ...@@ -79,14 +80,12 @@ library
test-suite tests test-suite tests
type: exitcode-stdio-1.0 type: exitcode-stdio-1.0
hs-source-dirs: tests hs-source-dirs: tests
ghc-options: -Wall
main-is: test.hs main-is: test.hs
other-modules: other-modules:
Test.Basic Test.Basic
Test.Attributes Test.Attributes
Test.Structure Test.Algorithms
Test.Isomorphism
Test.Motif
Test.Clique
Test.Utils Test.Utils
default-language: Haskell2010 default-language: Haskell2010
......
...@@ -6,6 +6,10 @@ ...@@ -6,6 +6,10 @@
module IGraph module IGraph
( Graph(..) ( Graph(..)
, EdgeType(..) , EdgeType(..)
, Node
, LNode
, Edge
, LEdge
, isDirected , isDirected
, nNodes , nNodes
, nodeLab , nodeLab
...@@ -115,7 +119,7 @@ nEdges :: Graph d v e -> Int ...@@ -115,7 +119,7 @@ nEdges :: Graph d v e -> Int
nEdges = unsafePerformIO . igraphEcount . _graph nEdges = unsafePerformIO . igraphEcount . _graph
{-# INLINE nEdges #-} {-# INLINE nEdges #-}
-- | Return all edges. -- | Return all edges.
edges :: Graph d v e -> [Edge] edges :: Graph d v e -> [Edge]
edges gr = map (getEdgeByEid gr) [0 .. nEdges gr - 1] edges gr = map (getEdgeByEid gr) [0 .. nEdges gr - 1]
{-# INLINE edges #-} {-# INLINE edges #-}
......
module IGraph.Algorithms
( module IGraph.Algorithms.Structure
, module IGraph.Algorithms.Community
, module IGraph.Algorithms.Clique
, module IGraph.Algorithms.Layout
, module IGraph.Algorithms.Motif
, module IGraph.Algorithms.Generators
, module IGraph.Algorithms.Isomorphism
) where
import IGraph.Algorithms.Structure
import IGraph.Algorithms.Community
import IGraph.Algorithms.Clique
import IGraph.Algorithms.Layout
import IGraph.Algorithms.Motif
import IGraph.Algorithms.Generators
import IGraph.Algorithms.Isomorphism
{-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE ForeignFunctionInterface #-}
module IGraph.Clique module IGraph.Algorithms.Clique
( cliques ( cliques
, largestCliques , largestCliques
, maximalCliques , maximalCliques
......
{-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
module IGraph.Community module IGraph.Algorithms.Community
( modularity ( modularity
, findCommunity , findCommunity
, CommunityMethod(..) , CommunityMethod(..)
......
{-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
module IGraph.Generators module IGraph.Algorithms.Generators
( full ( full
, star , star
, ErdosRenyiModel(..) , ErdosRenyiModel(..)
......
{-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
module IGraph.Isomorphism module IGraph.Algorithms.Isomorphism
( getSubisomorphisms ( getSubisomorphisms
, isomorphic , isomorphic
, isoclassCreate , isoclassCreate
......
{-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE ForeignFunctionInterface #-}
module IGraph.Layout module IGraph.Algorithms.Layout
( getLayout ( getLayout
, LayoutMethod(..) , LayoutMethod(..)
, defaultKamadaKawai , defaultKamadaKawai
......
{-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
module IGraph.Motif module IGraph.Algorithms.Motif
( triad ( triad
, triadCensus , triadCensus
) where ) where
......
{-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE ForeignFunctionInterface #-}
module IGraph.Structure module IGraph.Algorithms.Structure
( inducedSubgraph ( -- * Shortest Path Related Functions
getShortestPath
, inducedSubgraph
, closeness , closeness
, betweenness , betweenness
, eigenvectorCentrality , eigenvectorCentrality
...@@ -24,7 +26,34 @@ import IGraph.Mutable (MGraph(..)) ...@@ -24,7 +26,34 @@ import IGraph.Mutable (MGraph(..))
{#import IGraph.Internal #} {#import IGraph.Internal #}
{#import IGraph.Internal.Constants #} {#import IGraph.Internal.Constants #}
#include "igraph/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
-- to another one. If there are more than one shortest paths between the two
-- vertices, then an arbitrary one is returned.
getShortestPath :: Graph d v e
-> Node -- ^ The id of the source vertex.
-> Node -- ^ The id of the target vertex.
-> [Node]
getShortestPath gr s t = unsafePerformIO $ allocaVector $ \path -> do
igraphGetShortestPath (_graph gr) path nullPtr s t IgraphOut
map truncate <$> toList path
{#fun igraph_get_shortest_path as ^
{ `IGraph'
, castPtr `Ptr Vector'
, castPtr `Ptr Vector'
, `Int'
, `Int'
, `Neimode'
} -> `CInt' void- #}
inducedSubgraph :: (Hashable v, Eq v, Serialize v) inducedSubgraph :: (Hashable v, Eq v, Serialize v)
=> Graph d v e => Graph d v e
......
...@@ -172,7 +172,7 @@ toList vec = do ...@@ -172,7 +172,7 @@ toList vec = do
n <- igraphVectorSize vec n <- igraphVectorSize vec
allocaArray n $ \ptr -> do allocaArray n $ \ptr -> do
igraphVectorCopyTo vec ptr igraphVectorCopyTo vec ptr
liftM (map realToFrac) $ peekArray n ptr map realToFrac <$> peekArray n ptr
{-# INLINE toList #-} {-# INLINE toList #-}
{#fun igraph_vector_copy_to as ^ { castPtr `Ptr Vector', id `Ptr CDouble' } -> `()' #} {#fun igraph_vector_copy_to as ^ { castPtr `Ptr Vector', id `Ptr CDouble' } -> `()' #}
......
...@@ -24,7 +24,7 @@ import GHC.Generics (Generic) ...@@ -24,7 +24,7 @@ import GHC.Generics (Generic)
$(singletons [d| $(singletons [d|
data EdgeType = D data EdgeType = D
| U | U
deriving (Show, Read, Eq, Generic) deriving (Eq, Generic)
|]) |])
instance Serialize EdgeType instance Serialize EdgeType
......
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
module Test.Clique module Test.Algorithms
( tests ( tests
) where ) where
import Control.Arrow
import Control.Monad.ST import Control.Monad.ST
import Data.List import Data.List
import System.IO.Unsafe import qualified Data.Matrix.Unboxed as M
import Test.Tasty import Test.Tasty
import Test.Tasty.HUnit import Test.Tasty.HUnit
import Test.Utils
import IGraph import IGraph
import IGraph.Clique import IGraph.Algorithms
import IGraph.Generators
import IGraph.Mutable import IGraph.Mutable
tests :: TestTree tests :: TestTree
tests = testGroup "Clique" tests = testGroup "Algorithms"
[ graphIsomorphism
, motifTest
, cliqueTest
, subGraphs
, pagerankTest
]
graphIsomorphism :: TestTree
graphIsomorphism = testCase "Graph isomorphism" $ assertBool "" $
and (zipWith isomorphic triad triad) &&
(not . or) (zipWith isomorphic triad $ reverse triad)
motifTest :: TestTree
motifTest = testGroup "Network motif"
[ testCase "triad Census" $ M.toLists (M.ident 16 :: M.Matrix Int) @=?
map triadCensus triad ]
cliqueTest :: TestTree
cliqueTest = testGroup "Clique"
[ testCase "case 1" $ sort (map sort $ cliques gr (4,-1)) @=? c4 [ testCase "case 1" $ sort (map sort $ cliques gr (4,-1)) @=? c4
, testCase "case 2" $ sort (map sort $ cliques gr (2,2)) @=? c2 , testCase "case 2" $ sort (map sort $ cliques gr (2,2)) @=? c2
, testCase "case 3" $ sort (map sort $ largestCliques gr) @=? c4 , testCase "case 3" $ sort (map sort $ largestCliques gr) @=? c4
...@@ -34,3 +52,25 @@ tests = testGroup "Clique" ...@@ -34,3 +52,25 @@ tests = testGroup "Clique"
c3 = [ [0,3,4], [0,4,5], [1,2,3], [1,2,4], [1,2,5], [1,3,4], [1,4,5], c3 = [ [0,3,4], [0,4,5], [1,2,3], [1,2,4], [1,2,5], [1,3,4], [1,4,5],
[2,3,4], [2,4,5] ] [2,3,4], [2,4,5] ]
c4 = [[1, 2, 3, 4], [1, 2, 4, 5]] c4 = [[1, 2, 3, 4], [1, 2, 4, 5]]
subGraphs :: TestTree
subGraphs = testGroup "generate induced subgraphs"
[ testCase "" $ test case1 ]
where
case1 = ( [("a","b"), ("b","c"), ("c","a"), ("a","c")]
, ["a","c"], [("a","c"), ("c","a")] )
test (ori,ns,expect) = sort expect @=? sort result
where
gr = fromLabeledEdges $ zip ori $ repeat () :: Graph 'D String ()
ns' = map (head . getNodes gr) ns
gr' = inducedSubgraph gr ns'
result = map (nodeLab gr' *** nodeLab gr') $ edges gr'
pagerankTest :: TestTree
pagerankTest = testGroup "PageRank"
[ testCase "case 1" $ ranks @=? ranks' ]
where
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' = map ((/100) . fromIntegral . round. (*100)) $
pagerank gr Nothing Nothing 0.85
...@@ -3,14 +3,8 @@ module Test.Attributes ...@@ -3,14 +3,8 @@ module Test.Attributes
( tests ( tests
) where ) where
import Conduit
import Control.Monad
import Control.Monad.ST
import Data.List import Data.List
import Data.List.Ordered (nubSort)
import Data.Maybe
import Data.Serialize import Data.Serialize
import Foreign
import System.IO.Unsafe import System.IO.Unsafe
import Test.Tasty import Test.Tasty
import Test.Tasty.HUnit import Test.Tasty.HUnit
...@@ -20,7 +14,6 @@ import IGraph ...@@ -20,7 +14,6 @@ import IGraph
import IGraph.Exporter.GEXF import IGraph.Exporter.GEXF
import IGraph.Internal import IGraph.Internal
import IGraph.Mutable import IGraph.Mutable
import IGraph.Structure
tests :: TestTree tests :: TestTree
tests = testGroup "Attribute tests" tests = testGroup "Attribute tests"
......
...@@ -3,19 +3,17 @@ module Test.Basic ...@@ -3,19 +3,17 @@ module Test.Basic
( tests ( tests
) where ) where
import Conduit
import Control.Monad.ST import Control.Monad.ST
import Data.List import Data.List
import Data.List.Ordered (nubSort) import Data.List.Ordered (nubSort)
import Data.Maybe
import System.IO.Unsafe import System.IO.Unsafe
import Test.Tasty import Test.Tasty
import Test.Tasty.HUnit import Test.Tasty.HUnit
import Test.Utils import Test.Utils
import Conduit
import IGraph import IGraph
import qualified IGraph.Mutable as GM import qualified IGraph.Mutable as GM
import IGraph.Structure
tests :: TestTree tests :: TestTree
tests = testGroup "Basic tests" tests = testGroup "Basic tests"
......
module Test.Isomorphism
( tests
) where
import Control.Arrow
import Control.Monad.ST
import Data.List
import qualified Data.Matrix.Unboxed as M
import System.IO.Unsafe
import Test.Tasty
import Test.Tasty.HUnit
import Test.Utils
import IGraph
import IGraph
import IGraph.Motif
import IGraph.Isomorphism
tests :: TestTree
tests = testGroup "Isomorphism"
[ graphIsomorphism ]
graphIsomorphism :: TestTree
graphIsomorphism = testCase "Graph isomorphism" $ assertBool "" $
and (zipWith isomorphic triad triad) &&
(not . or) (zipWith isomorphic triad $ reverse triad)
module Test.Motif
( tests
) where
import Control.Arrow
import Control.Monad.ST
import Data.List
import qualified Data.Matrix.Unboxed as M
import System.IO.Unsafe
import Test.Tasty
import Test.Tasty.HUnit
import Test.Utils
import IGraph
import IGraph
import IGraph.Motif
tests :: TestTree
tests = testGroup "Network motif"
[ testCase "triad Census" $ M.toLists (M.ident 16 :: M.Matrix Int) @=?
map triadCensus triad ]
{-# LANGUAGE DataKinds #-}
module Test.Structure
( tests
) where
import Control.Arrow
import Control.Monad.ST
import Test.Tasty
import Test.Tasty.HUnit
import Test.Utils
import System.IO.Unsafe
import Data.List
import IGraph
import IGraph.Mutable
import IGraph.Structure
import IGraph.Generators
tests :: TestTree
tests = testGroup "Structure property tests"
[ subGraphs
, pagerankTest
]
subGraphs :: TestTree
subGraphs = testGroup "generate induced subgraphs"
[ testCase "" $ test case1 ]
where
case1 = ( [("a","b"), ("b","c"), ("c","a"), ("a","c")]
, ["a","c"], [("a","c"), ("c","a")] )
test (ori,ns,expect) = sort expect @=? sort result
where
gr = fromLabeledEdges $ zip ori $ repeat () :: Graph 'D String ()
ns' = map (head . getNodes gr) ns
gr' = inducedSubgraph gr ns'
result = map (nodeLab gr' *** nodeLab gr') $ edges gr'
pagerankTest :: TestTree
pagerankTest = testGroup "PageRank"
[ testCase "case 1" $ ranks @=? ranks' ]
where
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' = map ((/100) . fromIntegral . round. (*100)) $
pagerank gr Nothing Nothing 0.85
import qualified Test.Algorithms as Algorithms
import qualified Test.Attributes as Attributes import qualified Test.Attributes as Attributes
import qualified Test.Basic as Basic import qualified Test.Basic as Basic
import qualified Test.Clique as Clique
import qualified Test.Isomorphism as Isomorphism
import qualified Test.Motif as Motif
import qualified Test.Structure as Structure
import Test.Tasty import Test.Tasty
main :: IO () main :: IO ()
main = defaultMain $ testGroup "Haskell-igraph Tests" main = defaultMain $ testGroup "Haskell-igraph Tests"
[ Basic.tests [ Basic.tests
, Structure.tests , Algorithms.tests
, Motif.tests
, Isomorphism.tests
, Attributes.tests , Attributes.tests
, Clique.tests
] ]
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