packages feed

haskell-igraph 0.2.2 → 0.3.0

raw patch · 16 files changed

+265/−64 lines, 16 filesdep +data-ordlistdep +matrices

Dependencies added: data-ordlist, matrices

Files

haskell-igraph.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                haskell-igraph-version:             0.2.2+version:             0.3.0 synopsis:            Imcomplete igraph bindings description:         This is an attempt to create a complete bindings for the                      igraph<"http://igraph.org/c/"> library.@@ -31,6 +31,7 @@     IGraph.Internal.Isomorphism     IGraph.Internal.Selector     IGraph.Internal.Structure+    IGraph.Internal.Motif     IGraph.Internal.Clique     IGraph.Internal.Community     IGraph.Internal.Layout@@ -79,12 +80,16 @@   other-modules:     Test.Basic     Test.Structure+    Test.Isomorphism+    Test.Motif     Test.Utils    default-language:    Haskell2010   build-depends:       base     , haskell-igraph+    , data-ordlist+    , matrices     , tasty     , tasty-golden     , tasty-hunit
src/IGraph.hs view
@@ -17,8 +17,10 @@     , pre     , suc -    , filterNode-    , filterEdge+    , mapNodes+    , mapEdges+    , filterNodes+    , filterEdges      , nmap     , emap@@ -28,11 +30,11 @@ import           Control.Monad             (forM_, liftM) import           Control.Monad.Primitive import           Control.Monad.ST          (runST)+import           Data.Binary import           Data.Hashable             (Hashable) import qualified Data.HashMap.Strict       as M-import           Data.List                 (nub)+import qualified Data.HashSet as S import           Data.Maybe-import Data.Binary import           System.IO.Unsafe          (unsafePerformIO)  import           IGraph.Internal.Attribute@@ -150,7 +152,7 @@   where     es' = flip map es $ \((fr, to), x) -> ((f fr, f to), x)       where f x = M.lookupDefault undefined x labelToId-    labels = nub $ concat [ [a,b] | ((a,b),_) <- es ]+    labels = S.toList $ S.fromList $ concat [ [a,b] | ((a,b),_) <- es ]     labelToId = M.fromList $ zip labels [0..]  unsafeFreeze :: (Hashable v, Eq v, Read v, PrimMonad m) => MLGraph (PrimState m) d v e -> m (LGraph d v e)@@ -193,18 +195,39 @@     vitToList vit  -- | Keep nodes that satisfy the constraint-filterNode :: (Hashable v, Eq v, Read v, Graph d)-           => (LGraph d v e -> Node -> Bool) -> LGraph d v e -> LGraph d v e-filterNode f gr = runST $ do+filterNodes :: (Hashable v, Eq v, Read v, Graph d)+            => (LGraph d v e -> Node -> Bool) -> LGraph d v e -> LGraph d v e+filterNodes f gr = runST $ do     let deleted = filter (not . f gr) $ nodes gr     gr' <- thaw gr     delNodes deleted gr'     unsafeFreeze gr' +-- | Apply a function to change nodes' labels.+mapNodes :: (Graph d, Read v1, Show v2, Hashable v2, Eq v2, Read v2)+         => (Node -> v1 -> v2) -> LGraph d v1 e -> LGraph d v2 e+mapNodes f gr = runST $ do+    (MLGraph gptr) <- thaw gr+    let gr' = MLGraph gptr+    forM_ (nodes gr) $ \x -> setNodeAttr x (f x $ nodeLab gr x) gr'+    unsafeFreeze gr'++-- | Apply a function to change edges' labels.+mapEdges :: (Graph d, Read e1, Show e2, Hashable v, Eq v, Read v)+         => (Edge -> e1 -> e2) -> LGraph d v e1 -> LGraph d v e2+mapEdges f gr = runST $ do+    (MLGraph gptr) <- thaw gr+    let gr' = MLGraph gptr+    forM_ [0 .. nEdges gr - 1] $ \x -> do+        e <- unsafePrimToPrim $ igraphEdge (_graph gr) x+        setEdgeAttr x (f e $ edgeLabByEid gr x) gr'+    unsafeFreeze gr'++ -- | Keep nodes that satisfy the constraint-filterEdge :: (Hashable v, Eq v, Read v, Graph d)-           => (LGraph d v e -> Edge -> Bool) -> LGraph d v e -> LGraph d v e-filterEdge f gr = runST $ do+filterEdges :: (Hashable v, Eq v, Read v, Graph d)+            => (LGraph d v e -> Edge -> Bool) -> LGraph d v e -> LGraph d v e+filterEdges f gr = runST $ do     let deleted = filter (not . f gr) $ edges gr     gr' <- thaw gr     delEdges deleted gr'
src/IGraph/Exporter/GEXF.hs view
@@ -53,8 +53,8 @@     { _edgeLabel = ""     , _edgeColour = opaque black     , _edgeWeight = 1.0-    , _edgeArrowLength = 5.0-    , _edgeZindex = 0+    , _edgeArrowLength = 10+    , _edgeZindex = 2     }  genXMLTree :: (ArrowXml a, Graph d) => LGraph d NodeAttr EdgeAttr -> a XmlTree XmlTree
src/IGraph/Exporter/Graphics.hs view
@@ -26,19 +26,24 @@                  , _nodeZindex nattr )       where         nattr = nodeLab gr x-    drawEdge (from, to) = {-arrowBetween'+    drawEdge (from, to) = ( arrowBetween'         ( with & arrowTail .~ noTail                & arrowHead .~ arrowH+               & headStyle %~ fc red                & headLength .~ output (_edgeArrowLength eattr)-        ) start end-}-        ( fromVertices [start, end]-        # lwO (_edgeWeight eattr) # lcA (_edgeColour eattr), _edgeZindex eattr )+        ) start end # lwO (_edgeWeight eattr) # lcA (_edgeColour eattr), _edgeZindex eattr )       where         eattr = edgeLab gr (from, to)-        start = _positionX nattr1 ^& _positionY nattr1-        end = _positionX nattr2 ^& _positionY nattr2+        start = x1 ^& y1+        end = (alpha * x1 + (1 - alpha) * x2) ^& (alpha * y1 + (1 - alpha) * y2)+        x1 = _positionX nattr1+        y1 = _positionY nattr1+        x2 = _positionX nattr2+        y2 = _positionY nattr2+        alpha = r / sqrt ((x1 - x2)**2 + (y1 - y2)**2)+        r = _size nattr2         nattr1 = nodeLab gr from         nattr2 = nodeLab gr to-    --arrowH | isDirected gr = dart-    --       | otherwise = noHead+        arrowH | isDirected gr = dart+               | otherwise = noHead {-# INLINE graphToDiagram #-}
src/IGraph/Generators.hs view
@@ -9,20 +9,18 @@ import IGraph.Internal.Constants import IGraph.Internal.Initialization -data ErdosRenyiModel = GNP-                     | GNM+data ErdosRenyiModel = GNP Int Double+                     | GNM Int Int  erdosRenyiGame :: Graph d                => ErdosRenyiModel-               -> Int   -- ^ n-               -> Double   -- ^ p or m                -> d     -- ^ directed                -> Bool  -- ^ self-loop                -> IO (LGraph d () ())-erdosRenyiGame model n p_or_m d self = do-    gp <- igraphInit >> igraphErdosRenyiGame model' n p_or_m (isD d) self+erdosRenyiGame (GNP n p) d self = do+    gp <- igraphInit >> igraphErdosRenyiGame IgraphErdosRenyiGnp n p (isD d) self     unsafeFreeze $ MLGraph gp-  where-    model' = case model of-        GNP -> IgraphErdosRenyiGnp-        GNM -> IgraphErdosRenyiGnm+erdosRenyiGame (GNM n m) d self = do+    gp <- igraphInit >> igraphErdosRenyiGame IgraphErdosRenyiGnm n+        (fromIntegral m) (isD d) self+    unsafeFreeze $ MLGraph gp
src/IGraph/Internal/Graph.chs view
@@ -53,4 +53,7 @@  {#fun igraph_full as ^ { +, `Int', `Bool', `Bool' } -> `IGraphPtr' #} -{#fun igraph_erdos_renyi_game as ^ {+, `ErdosRenyi', `Int', `Double', `Bool', `Bool'} -> `IGraphPtr' #}+{#fun igraph_erdos_renyi_game as ^ { +, `ErdosRenyi', `Int', `Double', `Bool'+    , `Bool'} -> `IGraphPtr' #}+    +{#fun igraph_isoclass_create as ^ { +, `Int', `Int', `Bool' } -> `IGraphPtr' #}
src/IGraph/Internal/Isomorphism.chs view
@@ -14,3 +14,5 @@     id `FunPtr (Ptr IGraphPtr -> Ptr IGraphPtr -> CInt -> CInt -> Ptr () -> IO CInt)',     id `FunPtr (Ptr IGraphPtr -> Ptr IGraphPtr -> CInt -> CInt -> Ptr () -> IO CInt)',     id `Ptr ()'} -> `Int' #}++{#fun igraph_isomorphic as ^ { `IGraphPtr', `IGraphPtr', id `Ptr CInt' } -> `Int' #}
+ src/IGraph/Internal/Motif.chs view
@@ -0,0 +1,20 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module IGraph.Internal.Motif where++import qualified Foreign.Marshal.Utils as C2HSImp+import qualified Foreign.Ptr as C2HSImp+import Foreign+import Foreign.C.Types++{#import IGraph.Internal.Graph #}+{#import IGraph.Internal.Selector #}+{#import IGraph.Internal.Constants #}+{#import IGraph.Internal.Data #}++#include "igraph/igraph.h"++{#fun igraph_triad_census as ^ { `IGraphPtr'+                               , `VectorPtr' } -> `Int' #}++{#fun igraph_motifs_randesu as ^ { `IGraphPtr', `VectorPtr', `Int'+                                 , `VectorPtr' } -> `Int' #}
src/IGraph/Isomorphism.hs view
@@ -1,12 +1,21 @@-module IGraph.Isomorphism (getSubisomorphisms) where+module IGraph.Isomorphism+    ( getSubisomorphisms+    , isomorphic+    , isoclassCreate+    , isoclass3+    , isoclass4+    ) where  import           Foreign import           Foreign.C.Types-import           System.IO.Unsafe            (unsafePerformIO)+import           System.IO.Unsafe               (unsafePerformIO)  import           IGraph import           IGraph.Internal.Data+import           IGraph.Internal.Graph+import           IGraph.Internal.Initialization (igraphInit) import           IGraph.Internal.Isomorphism+import           IGraph.Mutable  getSubisomorphisms :: Graph d                    => LGraph d v1 e1  -- ^ graph to be searched in@@ -21,3 +30,36 @@     gptr1 = _graph g1     gptr2 = _graph g2 {-# INLINE getSubisomorphisms #-}++-- | Determine whether two graphs are isomorphic.+isomorphic :: Graph d+           => LGraph d v1 e1+           -> LGraph d v2 e2+           -> Bool+isomorphic g1 g2 = unsafePerformIO $ alloca $ \ptr -> do+    _ <- igraphIsomorphic (_graph g1) (_graph g2) ptr+    x <- peek ptr+    return (x /= 0)++-- | Creates a graph from the given isomorphism class.+-- This function is implemented only for graphs with three or four vertices.+isoclassCreate :: Graph d+               => Int   -- ^ The number of vertices to add to the graph.+               -> Int   -- ^ The isomorphism class+               -> d+               -> LGraph d () ()+isoclassCreate size idx d = unsafePerformIO $ do+    gp <- igraphInit >> igraphIsoclassCreate size idx (isD d)+    unsafeFreeze $ MLGraph gp++isoclass3 :: Graph d => d -> [LGraph d () ()]+isoclass3 d = map (flip (isoclassCreate 3) d) n+  where+    n | isD d = [0..15]+      | otherwise = [0..3]++isoclass4 :: Graph d => d -> [LGraph d () ()]+isoclass4 d = map (flip (isoclassCreate 4) d) n+  where+    n | isD d = [0..217]+      | otherwise = [0..10]
src/IGraph/Motif.hs view
@@ -1,7 +1,14 @@ module IGraph.Motif-    (triad) where+    ( triad+    , triadCensus+    ) where +import Data.Hashable (Hashable)+import System.IO.Unsafe (unsafePerformIO)+ import IGraph+import IGraph.Internal.Motif+import IGraph.Internal.Data  -- | Every triple of vertices in a directed graph -- 003: A, B, C, the empty graph.@@ -12,7 +19,7 @@ -- 021C: A->B->C, the directed line. -- 111D: A<->B<-C. -- 111U: A<->B->C.--- 030T: A->B<-C, A->C.+-- 030T: A->B<-C, A->C. Feed forward loop. -- 030C: A<-B<-C, A->C. -- 201: A<->B<->C. -- 120D: A<-B->C, A<->C.@@ -21,9 +28,10 @@ -- 210: A->B<->C, A<->C. -- 300: A<->B<->C, A<->C, the complete graph. triad :: [LGraph D () ()]-triad = map make xs+triad = map make edgeList   where-    xs = [ []+    edgeList =+         [ []          , [(0,1)]          , [(0,1), (1,0)]          , [(1,0), (1,2)]@@ -38,8 +46,15 @@          , [(0,1), (2,1), (0,2), (2,0)]          , [(0,1), (1,2), (0,2), (2,0)]          , [(0,1), (1,2), (2,1), (0,2), (2,0)]-         , [(0,1), (1,2), (1,2), (2,1), (0,2), (2,0)]+         , [(0,1), (1,0), (1,2), (2,1), (0,2), (2,0)]          ]+    make :: [(Int, Int)] -> LGraph D () ()+    make xs = mkGraph (replicate 3 ()) $ zip xs $ repeat () -make :: [(Int, Int)] -> LGraph D () ()-make xs = mkGraph (replicate (length xs) ()) $ zip xs $ repeat ()+triadCensus :: (Hashable v, Eq v, Read v) => LGraph d v e -> [Int]+triadCensus gr = unsafePerformIO $ do+    vptr <- igraphVectorNew 0+    igraphTriadCensus (_graph gr) vptr+    map truncate <$> vectorPtrToList vptr++-- motifsRandesu
src/IGraph/Mutable.hs view
@@ -1,14 +1,16 @@ {-# LANGUAGE MultiParamTypeClasses #-} module IGraph.Mutable where -import Foreign-import Control.Monad.Primitive+import           Control.Monad                  (when)+import           Control.Monad.Primitive+import qualified Data.ByteString.Char8          as B+import           Foreign -import IGraph.Internal.Graph-import IGraph.Internal.Selector-import IGraph.Internal.Data-import IGraph.Internal.Attribute-import IGraph.Internal.Initialization+import           IGraph.Internal.Attribute+import           IGraph.Internal.Data+import           IGraph.Internal.Graph+import           IGraph.Internal.Initialization+import           IGraph.Internal.Selector  -- constants vertexAttr :: String@@ -110,3 +112,21 @@         return ()       where         eids = flip map es $ \(fr, to) -> igraphGetEid g fr to True True++setNodeAttr :: (PrimMonad m, Show v)+            => Int   -- ^ Node id+            -> v+            -> MLGraph (PrimState m) d v e+            -> m ()+setNodeAttr nodeId x (MLGraph gr) = unsafePrimToPrim $ do+    err <- igraphCattributeVASSet gr vertexAttr nodeId $ show x+    when (err /= 0) $ error "Fail to set node attribute!"++setEdgeAttr :: (PrimMonad m, Show v)+            => Int   -- ^ Edge id+            -> v+            -> MLGraph (PrimState m) d v e+            -> m ()+setEdgeAttr edgeId x (MLGraph gr) = unsafePrimToPrim $ do+    err <- igraphCattributeEASSet gr edgeAttr edgeId $ show x+    when (err /= 0) $ error "Fail to set edge attribute!"
tests/Test/Basic.hs view
@@ -2,20 +2,23 @@     ( tests     ) where -import Control.Monad.ST-import Test.Tasty-import Test.Tasty.HUnit-import Test.Utils-import System.IO.Unsafe-import Data.List+import           Control.Monad.ST+import           Data.List+import           Data.List.Ordered (nubSort)+import           Data.Maybe+import           System.IO.Unsafe+import           Test.Tasty+import           Test.Tasty.HUnit+import           Test.Utils -import IGraph-import IGraph.Mutable-import IGraph.Structure+import           IGraph+import           IGraph.Mutable+import           IGraph.Structure  tests :: TestTree tests = testGroup "Basic tests"     [ graphCreation+    , graphCreationLabeled     , graphEdit     ] @@ -23,13 +26,27 @@ graphCreation = testGroup "Graph creation"     [ testCase "" $ assertBool "" $ nNodes simple == 3 && nEdges simple == 3     , testCase "" $ [(0,1),(1,2),(2,0)] @=? (sort $ edges simple)-    , testCase "" $ assertBool "" $ nNodes gr == 100 && nEdges gr == 1000+    , testCase "" $ assertBool "" $ nNodes gr == 100 && nEdges gr == m     , testCase "" $ edgeList @=? (sort $ edges gr)     ]   where     edgeList = sort $ unsafePerformIO $ randEdges 1000 100+    m = length edgeList     gr = mkGraph (replicate 100 ()) $ zip edgeList $ repeat () :: LGraph D () ()     simple = mkGraph (replicate 3 ()) $ zip [(0,1),(1,2),(2,0)] $ repeat () :: LGraph D () ()++graphCreationLabeled :: TestTree+graphCreationLabeled = testGroup "Graph creation -- with labels"+    [ testCase "" $ assertBool "" $ nNodes gr == n && nEdges gr == m+    , testCase "" $ edgeList @=? (sort $ map (\(fr,to) ->+        (nodeLab gr fr, nodeLab gr to)) $ edges gr)+    ]+  where+    edgeList = sort $ map (\(a,b) -> (show a, show b)) $ unsafePerformIO $ randEdges 10000 1000+    n = length $ nubSort $ concatMap (\(a,b) -> [a,b]) edgeList+    m = length edgeList+    gr = fromLabeledEdges $ zip edgeList $ repeat () :: LGraph D String ()+  graphEdit :: TestTree graphEdit = testGroup "Graph editing"
+ tests/Test/Isomorphism.hs view
@@ -0,0 +1,26 @@+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)
+ tests/Test/Motif.hs view
@@ -0,0 +1,21 @@+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 ]
tests/Test/Utils.hs view
@@ -2,7 +2,7 @@  import Control.Monad import System.Random-import Data.List+import Data.List.Ordered  randEdges :: Int  -- ^ number of edges to generate           -> Int  -- ^ number of nodes in the graph@@ -10,4 +10,4 @@ randEdges n nd = do     fr <- replicateM (2*n) $ randomRIO (0,nd-1)     to <- replicateM (2*n) $ randomRIO (0,nd-1)-    return $ take n $ nub $ filter (uncurry (/=)) $ zip fr to+    return $ take n $ nubSort $ filter (uncurry (/=)) $ zip fr to
tests/test.hs view
@@ -1,9 +1,13 @@-import qualified Test.Basic as Basic-import qualified Test.Structure as Structure-import Test.Tasty+import qualified Test.Basic       as Basic+import qualified Test.Isomorphism as Isomorphism+import qualified Test.Motif       as Motif+import qualified Test.Structure   as Structure+import           Test.Tasty  main :: IO () main = defaultMain $ testGroup "Haskell-igraph Tests"     [ Basic.tests     , Structure.tests+    , Motif.tests+    , Isomorphism.tests     ]