haskell-igraph (empty) → 0.1.0
raw patch · 34 files changed
+1939/−0 lines, 34 filesdep +basedep +binarydep +bytestringsetup-changed
Dependencies added: base, binary, bytestring, bytestring-lexing, colour, data-default-class, diagrams-cairo, diagrams-lib, hashable, haskell-igraph, hxt, primitive, random, split, tasty, tasty-golden, tasty-hunit, unordered-containers
Files
- LICENSE +20/−0
- Setup.hs +2/−0
- cbits/Selector.chs.c +21/−0
- cbits/Structure.chs.c +78/−0
- cbits/haskelligraph.c +42/−0
- haskell-igraph.cabal +97/−0
- src/IGraph.hs +232/−0
- src/IGraph/Clique.hs +29/−0
- src/IGraph/Community.hs +73/−0
- src/IGraph/Exporter/GEXF.hs +116/−0
- src/IGraph/Exporter/Graphics.hs +44/−0
- src/IGraph/Generators.hs +28/−0
- src/IGraph/Internal/Arpack.chs +12/−0
- src/IGraph/Internal/Attribute.chs +60/−0
- src/IGraph/Internal/Clique.chs +17/−0
- src/IGraph/Internal/Community.chs +55/−0
- src/IGraph/Internal/Constants.chs +30/−0
- src/IGraph/Internal/Data.chs +149/−0
- src/IGraph/Internal/Graph.chs +56/−0
- src/IGraph/Internal/Initialization.chs +12/−0
- src/IGraph/Internal/Isomorphism.chs +16/−0
- src/IGraph/Internal/Layout.chs +38/−0
- src/IGraph/Internal/Selector.chs +127/−0
- src/IGraph/Internal/Structure.chs +61/−0
- src/IGraph/Isomorphism.hs +23/−0
- src/IGraph/Layout.hs +86/−0
- src/IGraph/Motif.hs +45/−0
- src/IGraph/Mutable.hs +112/−0
- src/IGraph/Read.hs +46/−0
- src/IGraph/Structure.hs +115/−0
- tests/Test/Basic.hs +42/−0
- tests/Test/Structure.hs +33/−0
- tests/Test/Utils.hs +13/−0
- tests/test.hs +9/−0
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2015 Kai Zhang++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ cbits/Selector.chs.c view
@@ -0,0 +1,21 @@+#include "IGraph/Internal/Selector.chs.h"+igraph_vit_t * __c2hs_wrapped__igraph_vit_new(const igraph_t * graph,+ igraph_vs_t * vs)+{+ return igraph_vit_new(graph, *vs);+}+igraph_eit_t * __c2hs_wrapped__igraph_eit_new(const igraph_t * graph,+ igraph_es_t * es)+{+ return igraph_eit_new(graph, *es);+}+int __c2hs_wrapped__igraph_delete_vertices(igraph_t * graph,+ const igraph_vs_t * vertices)+{+ return igraph_delete_vertices(graph, *vertices);+}+int __c2hs_wrapped__igraph_delete_edges(igraph_t * graph,+ igraph_es_t * edges)+{+ return igraph_delete_edges(graph, *edges);+}
+ cbits/Structure.chs.c view
@@ -0,0 +1,78 @@+#include "IGraph/Internal/Structure.chs.h"+int __c2hs_wrapped__igraph_personalized_pagerank(const igraph_t * graph,+ igraph_pagerank_algo_t algo,+ igraph_vector_t * vector,+ igraph_real_t * value,+ const igraph_vs_t * vids,+ igraph_bool_t directed,+ igraph_real_t damping,+ igraph_vector_t * reset,+ const igraph_vector_t * weights,+ void * options)+{+ return igraph_personalized_pagerank(graph,+ algo,+ vector,+ value,+ *vids,+ directed,+ damping,+ reset,+ weights,+ options);+}+int __c2hs_wrapped__igraph_pagerank(const igraph_t * graph,+ igraph_pagerank_algo_t algo,+ igraph_vector_t * vector,+ igraph_real_t * value,+ const igraph_vs_t * vids,+ igraph_bool_t directed,+ igraph_real_t damping,+ const igraph_vector_t * weights,+ void * options)+{+ return igraph_pagerank(graph,+ algo,+ vector,+ value,+ *vids,+ directed,+ damping,+ weights,+ options);+}+int __c2hs_wrapped__igraph_induced_subgraph(const igraph_t * graph,+ igraph_t * res,+ const igraph_vs_t * vids,+ igraph_subgraph_implementation_t impl)+{+ return igraph_induced_subgraph(graph, res, *vids, impl);+}+int __c2hs_wrapped__igraph_closeness(const igraph_t * graph,+ igraph_vector_t * res,+ const igraph_vs_t * vids,+ igraph_neimode_t mode,+ const igraph_vector_t * weights,+ igraph_bool_t normalized)+{+ return igraph_closeness(graph,+ res,+ *vids,+ mode,+ weights,+ normalized);+}+int __c2hs_wrapped__igraph_betweenness(const igraph_t * graph,+ igraph_vector_t * res,+ const igraph_vs_t * vids,+ igraph_bool_t directed,+ const igraph_vector_t * weights,+ igraph_bool_t nobigint)+{+ return igraph_betweenness(graph,+ res,+ *vids,+ directed,+ weights,+ nobigint);+}
+ cbits/haskelligraph.c view
@@ -0,0 +1,42 @@+#ifndef HASKELL_IGRAPH+#define HASKELL_IGRAPH++#include <igraph/igraph.h>++igraph_integer_t igraph_get_eid_(igraph_t* graph, igraph_integer_t pfrom, igraph_integer_t pto,+ igraph_bool_t directed, igraph_bool_t error)+{+ igraph_integer_t eid;+ igraph_get_eid(graph, &eid, pfrom, pto, directed, error);+ return eid;+}++char** igraph_strvector_get_(igraph_strvector_t* s, long int i)+{+ char** x = (char**) malloc (sizeof(char*));+ igraph_strvector_get(s, i, x);+ return x;+}++igraph_arpack_options_t* igraph_arpack_new()+{+ igraph_arpack_options_t *arpack = (igraph_arpack_options_t*) malloc(sizeof(igraph_arpack_options_t));+ igraph_arpack_options_init(arpack);+ return arpack;+}++void igraph_arpack_destroy(igraph_arpack_options_t* arpack)+{+ if (arpack)+ free(arpack);+ arpack = NULL;+}++void haskelligraph_init()+{+ /* attach attribute table */+ igraph_i_set_attribute_table(&igraph_cattribute_table);+}+++#endif
+ haskell-igraph.cabal view
@@ -0,0 +1,97 @@+-- Initial igraph-bindings.cabal generated by cabal init. For further+-- documentation, see http://haskell.org/cabal/users-guide/++name: haskell-igraph+version: 0.1.0+synopsis: Imcomplete igraph bindings+description: This is an attempt to create a complete bindings for the+ igraph<"http://igraph.org/c/"> library. Related work:+ https://hackage.haskell.org/package/igraph.+license: MIT+license-file: LICENSE+author: Kai Zhang+maintainer: kai@kzhang.org+copyright: (c) 2016 Kai Zhang+category: Math+build-type: Simple+cabal-version: >=1.22++Flag graphics+ Description: Enable graphics output+ Default: False++library+ exposed-modules:+ IGraph.Internal.Initialization+ IGraph.Internal.Constants+ IGraph.Internal.Arpack+ IGraph.Internal.Data+ IGraph.Internal.Graph+ IGraph.Internal.Attribute+ IGraph.Internal.Isomorphism+ IGraph.Internal.Selector+ IGraph.Internal.Structure+ IGraph.Internal.Clique+ IGraph.Internal.Community+ IGraph.Internal.Layout+ IGraph+ IGraph.Mutable+ IGraph.Clique+ IGraph.Structure+ IGraph.Isomorphism+ IGraph.Community+ IGraph.Read+ IGraph.Motif+ IGraph.Layout+ IGraph.Generators+ IGraph.Exporter.GEXF++ if flag(graphics)+ exposed-modules: IGraph.Exporter.Graphics++ if flag(graphics)+ build-depends: diagrams-lib, diagrams-cairo++ build-depends:+ base >=4.0 && <5.0+ , binary+ , bytestring >=0.9+ , bytestring-lexing >=0.5+ , colour+ , primitive+ , unordered-containers+ , hashable+ , hxt+ , split+ , data-default-class++ extra-libraries: igraph+ hs-source-dirs: src+ default-language: Haskell2010+ build-tools: c2hs >=0.25.0+ C-Sources:+ cbits/haskelligraph.c+ cbits/Selector.chs.c+ cbits/Structure.chs.c++test-suite tests+ type: exitcode-stdio-1.0+ hs-source-dirs: tests+ main-is: test.hs+ other-modules:+ Test.Basic+ Test.Structure+ Test.Utils++ default-language: Haskell2010+ build-depends:+ base+ , haskell-igraph+ , tasty+ , tasty-golden+ , tasty-hunit+ , random++source-repository head+ type: git+ location: https://github.com/kaizhang/haskell-igraph.git
+ src/IGraph.hs view
@@ -0,0 +1,232 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MultiParamTypeClasses #-}+module IGraph+ ( LGraph(..)+ , U(..)+ , D(..)+ , Graph(..)+ , mkGraph+ , fromLabeledEdges++ , unsafeFreeze+ , freeze+ , unsafeThaw+ , thaw++ , neighbors+ , pre+ , suc++ , filterNode+ , filterEdge++ , nmap+ , emap+ ) where++import Control.Arrow ((***))+import Control.Monad (forM_, liftM)+import Control.Monad.Primitive+import Control.Monad.ST (runST)+import Data.Hashable (Hashable)+import qualified Data.HashMap.Strict as M+import Data.List (nub)+import Data.Maybe+import Data.Binary+import System.IO.Unsafe (unsafePerformIO)++import IGraph.Internal.Attribute+import IGraph.Internal.Constants+import IGraph.Internal.Graph+import IGraph.Internal.Selector+import IGraph.Mutable++type Node = Int+type Edge = (Node, Node)++-- | graph with labeled nodes and edges+data LGraph d v e = LGraph+ { _graph :: IGraphPtr+ , _labelToNode :: M.HashMap v [Node]+ }++instance ( Binary v, Hashable v, Read v, Show v, Eq v+ , Binary e, Read e, Show e, Graph d) => Binary (LGraph d v e) where+ put gr = do+ put nlabs+ put es+ put elabs+ where+ nlabs = map (nodeLab gr) $ nodes gr+ es = edges gr+ elabs = map (edgeLab gr) es+ get = do+ nlabs <- get+ es <- get+ elabs <- get+ return $ mkGraph nlabs $ zip es elabs++class MGraph d => Graph d where+ isDirected :: LGraph d v e -> Bool+ isD :: d -> Bool++ nNodes :: LGraph d v e -> Int+ nNodes (LGraph g _) = igraphVcount g+ {-# INLINE nNodes #-}++ nodes :: LGraph d v e -> [Int]+ nodes gr = [0 .. nNodes gr - 1]+ {-# INLINE nodes #-}++ nEdges :: LGraph d v e -> Int+ nEdges (LGraph g _) = igraphEcount g+ {-# INLINE nEdges #-}++ edges :: LGraph d v e -> [Edge]+ edges gr@(LGraph g _) = unsafePerformIO $ mapM (igraphEdge g) [0..n-1]+ where+ n = nEdges gr+ {-# INLINE edges #-}++ hasEdge :: LGraph d v e -> Edge -> Bool+ hasEdge (LGraph g _) (fr, to)+ | igraphGetEid g fr to True False < 0 = False+ | otherwise = True+ {-# INLINE hasEdge #-}++ nodeLab :: Read v => LGraph d v e -> Node -> v+ nodeLab (LGraph g _) i = read $ igraphCattributeVAS g vertexAttr i+ {-# INLINE nodeLab #-}++ nodeLabMaybe :: Read v => LGraph d v e -> Node -> Maybe v+ nodeLabMaybe gr@(LGraph g _) i =+ if igraphCattributeHasAttr g IgraphAttributeVertex vertexAttr+ then Just $ nodeLab gr i+ else Nothing+ {-# INLINE nodeLabMaybe #-}++ getNodes :: (Hashable v, Eq v) => LGraph d v e -> v -> [Node]+ getNodes gr x = M.lookupDefault [] x $ _labelToNode gr+ {-# INLINE getNodes #-}++ edgeLab :: Read e => LGraph d v e -> Edge -> e+ edgeLab (LGraph g _) (fr,to) = read $ igraphCattributeEAS g edgeAttr $+ igraphGetEid g fr to True True+ {-# INLINE edgeLab #-}++ edgeLabMaybe :: Read e => LGraph d v e -> Edge -> Maybe e+ edgeLabMaybe gr@(LGraph g _) i =+ if igraphCattributeHasAttr g IgraphAttributeEdge edgeAttr+ then Just $ edgeLab gr i+ else Nothing+ {-# INLINE edgeLabMaybe #-}++ edgeLabByEid :: Read e => LGraph d v e -> Int -> e+ edgeLabByEid (LGraph g _) i = read $ igraphCattributeEAS g edgeAttr i+ {-# INLINE edgeLabByEid #-}+++instance Graph U where+ isDirected = const False+ isD = const False++instance Graph D where+ isDirected = const True+ isD = const True++mkGraph :: (Graph d, Hashable v, Read v, Eq v, Show v, Show e)+ => [v] -> [(Edge, e)] -> LGraph d v e+mkGraph vattr es = runST $ do+ g <- new 0+ addLNodes n vattr g+ addLEdges (map (\((fr,to),x) -> (fr,to,x)) es) g+ unsafeFreeze g+ where+ n = length vattr++fromLabeledEdges :: (Graph d, Hashable v, Read v, Eq v, Show v, Show e)+ => [((v, v), e)] -> LGraph d v e+fromLabeledEdges es = mkGraph labels es'+ 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 ]+ 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)+unsafeFreeze (MLGraph g) = return $ LGraph g labToId+ where+ labToId = M.fromListWith (++) $ zip labels $ map return [0..nV-1]+ nV = igraphVcount g+ labels = map (read . igraphCattributeVAS g vertexAttr) [0 .. nV-1]++freeze :: (Hashable v, Eq v, Read v, PrimMonad m) => MLGraph (PrimState m) d v e -> m (LGraph d v e)+freeze (MLGraph g) = do+ g' <- unsafePrimToPrim $ igraphCopy g+ unsafeFreeze (MLGraph g')++unsafeThaw :: PrimMonad m => LGraph d v e -> m (MLGraph (PrimState m) d v e)+unsafeThaw (LGraph g _) = return $ MLGraph g++thaw :: (PrimMonad m, Graph d) => LGraph d v e -> m (MLGraph (PrimState m) d v e)+thaw (LGraph g _) = unsafePrimToPrim . liftM MLGraph . igraphCopy $ g++-- | Find all neighbors of the given node+neighbors :: LGraph d v e -> Node -> [Node]+neighbors gr i = unsafePerformIO $ do+ vs <- igraphVsAdj i IgraphAll+ vit <- igraphVitNew (_graph gr) vs+ vitToList vit++-- | Find all nodes that have a link from the given node.+suc :: LGraph D v e -> Node -> [Node]+suc gr i = unsafePerformIO $ do+ vs <- igraphVsAdj i IgraphOut+ vit <- igraphVitNew (_graph gr) vs+ vitToList vit++-- | Find all nodes that link to to the given node.+pre :: LGraph D v e -> Node -> [Node]+pre gr i = unsafePerformIO $ do+ vs <- igraphVsAdj i IgraphIn+ vit <- igraphVitNew (_graph gr) vs+ 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+ let deleted = filter (not . f gr) $ nodes gr+ gr' <- thaw gr+ delNodes deleted 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+ let deleted = filter (not . f gr) $ edges gr+ gr' <- thaw gr+ delEdges deleted gr'+ unsafeFreeze gr'++-- | Map a function over the node labels in a graph+nmap :: (Graph d, Read v, Hashable u, Read u, Eq u, Show u)+ => ((Node, v) -> u) -> LGraph d v e -> LGraph d u e+nmap fn gr = unsafePerformIO $ do+ (MLGraph g) <- thaw gr+ forM_ (nodes gr) $ \i -> do+ let label = fn (i, nodeLab gr i)+ igraphCattributeVASSet g vertexAttr i (show label)+ unsafeFreeze (MLGraph g)++-- | Map a function over the edge labels in a graph+emap :: (Graph d, Read v, Hashable v, Eq v, Read e1, Show e2)+ => ((Edge, e1) -> e2) -> LGraph d v e1 -> LGraph d v e2+emap fn gr = unsafePerformIO $ do+ (MLGraph g) <- thaw gr+ forM_ (edges gr) $ \(fr, to) -> do+ let label = fn ((fr,to), edgeLabByEid gr i)+ i = igraphGetEid g fr to True True+ igraphCattributeEASSet g edgeAttr i (show label)+ unsafeFreeze (MLGraph g)
+ src/IGraph/Clique.hs view
@@ -0,0 +1,29 @@+module IGraph.Clique+ ( cliques+ , maximalCliques+ ) where++import Control.Applicative ((<$>))+import System.IO.Unsafe (unsafePerformIO)++import IGraph+import IGraph.Internal.Clique+import IGraph.Internal.Data++cliques :: LGraph d v e+ -> (Int, Int) -- ^ Minimum and maximum size of the cliques to be returned.+ -- No bound will be used if negative or zero+ -> [[Int]] -- ^ cliques represented by node ids+cliques gr (lo, hi) = unsafePerformIO $ do+ vpptr <- igraphVectorPtrNew 0+ _ <- igraphCliques (_graph gr) vpptr lo hi+ (map.map) truncate <$> vectorPPtrToList vpptr++maximalCliques :: LGraph d v e+ -> (Int, Int) -- ^ Minimum and maximum size of the cliques to be returned.+ -- No bound will be used if negative or zero+ -> [[Int]] -- ^ cliques represented by node ids+maximalCliques gr (lo, hi) = unsafePerformIO $ do+ vpptr <- igraphVectorPtrNew 0+ _ <- igraphMaximalCliques (_graph gr) vpptr lo hi+ (map.map) truncate <$> vectorPPtrToList vpptr
+ src/IGraph/Community.hs view
@@ -0,0 +1,73 @@+module IGraph.Community+ ( CommunityOpt(..)+ , CommunityMethod(..)+ , findCommunity+ ) where++import Control.Monad+import Control.Applicative ((<$>))+import Foreign+import Foreign.C.Types+import System.IO.Unsafe (unsafePerformIO)+import Data.List+import Data.Ord+import Data.Function (on)+import Data.Default.Class++import IGraph+import IGraph.Mutable (U)+import IGraph.Internal.Data+import IGraph.Internal.Constants+import IGraph.Internal.Community+import IGraph.Internal.Arpack++data CommunityOpt = CommunityOpt+ { _method :: CommunityMethod+ , _weights :: Maybe [Double]+ , _nIter :: Int -- ^ [LeadingEigenvector] number of iterations, default is 10000+ , _nSpins :: Int -- ^ [Spinglass] number of spins, default is 25+ , _startTemp :: Double -- ^ [Spinglass] the temperature at the start+ , _stopTemp :: Double -- ^ [Spinglass] the algorithm stops at this temperature+ , _coolFact :: Double -- ^ [Spinglass] the cooling factor for the simulated annealing+ , _gamma :: Double -- ^ [Spinglass] the gamma parameter of the algorithm. + }++data CommunityMethod = LeadingEigenvector+ | Spinglass++instance Default CommunityOpt where+ def = CommunityOpt+ { _method = LeadingEigenvector+ , _weights = Nothing+ , _nIter = 10000+ , _nSpins = 25+ , _startTemp = 1.0+ , _stopTemp = 0.01+ , _coolFact = 0.99+ , _gamma = 1.0+ }++findCommunity :: LGraph U v e -> CommunityOpt -> [[Int]]+findCommunity gr opt = unsafePerformIO $ do+ result <- igraphVectorNew 0+ ws <- case _weights opt of+ Just w -> listToVector w+ _ -> liftM VectorPtr $ newForeignPtr_ $ castPtr nullPtr++ case _method opt of+ LeadingEigenvector -> do+ ap <- igraphArpackNew+ igraphCommunityLeadingEigenvector (_graph gr) ws nullPtr result+ (_nIter opt) ap nullPtr False+ nullPtr nullPtr nullPtr+ nullFunPtr nullPtr + Spinglass ->+ igraphCommunitySpinglass (_graph gr) ws nullPtr nullPtr result+ nullPtr (_nSpins opt) False (_startTemp opt)+ (_stopTemp opt) (_coolFact opt)+ IgraphSpincommUpdateConfig (_gamma opt)+ IgraphSpincommImpOrig 1.0++ liftM ( map (fst . unzip) . groupBy ((==) `on` snd)+ . sortBy (comparing snd) . zip [0..] ) $ vectorPtrToList result+
+ src/IGraph/Exporter/GEXF.hs view
@@ -0,0 +1,116 @@+module IGraph.Exporter.GEXF+ ( NodeAttr(..)+ , defaultNodeAttributes+ , EdgeAttr(..)+ , defaultEdgeAttributes+ , genXMLTree+ , writeGEXF+ ) where++import Data.Hashable+import Data.Colour (AlphaColour, black, over, alphaChannel, opaque)+import Data.Colour.SRGB (toSRGB24, channelRed, channelBlue, channelGreen)+import Text.XML.HXT.Core+import Data.Tree.NTree.TypeDefs+import Text.XML.HXT.DOM.TypeDefs+import IGraph++data NodeAttr = NodeAttr+ { _size :: Double+ , _nodeColour :: AlphaColour Double+ , _nodeLabel :: String+ , _positionX :: Double+ , _positionY :: Double+ , _nodeZindex :: Int+ } deriving (Show, Read, Eq)++instance Hashable NodeAttr where+ hashWithSalt salt at = hashWithSalt salt $ _nodeLabel at++defaultNodeAttributes :: NodeAttr+defaultNodeAttributes = NodeAttr+ { _size = 0.15+ , _nodeColour = opaque black+ , _nodeLabel = ""+ , _positionX = 0+ , _positionY = 0+ , _nodeZindex = 1+ }++data EdgeAttr = EdgeAttr+ { _edgeLabel :: String+ , _edgeColour :: AlphaColour Double+ , _edgeWeight :: Double+ , _edgeArrowLength :: Double+ , _edgeZindex :: Int+ } deriving (Show, Read, Eq)++instance Hashable EdgeAttr where+ hashWithSalt salt at = hashWithSalt salt $ _edgeLabel at++defaultEdgeAttributes :: EdgeAttr+defaultEdgeAttributes = EdgeAttr+ { _edgeLabel = ""+ , _edgeColour = opaque black+ , _edgeWeight = 1.0+ , _edgeArrowLength = 5.0+ , _edgeZindex = 0+ }++genXMLTree :: (ArrowXml a, Graph d) => LGraph d NodeAttr EdgeAttr -> a XmlTree XmlTree+genXMLTree gr = root [] [gexf]+ where+ gexf = mkelem "gexf" [ attr "version" $ txt "1.2"+ , attr "xmlns" $ txt "http://www.gexf.net/1.2draft"+ , attr "xmlns:viz" $ txt "http://www.gexf.net/1.2draft/viz"+ , attr "xmlns:xsi" $ txt "http://www.w3.org/2001/XMLSchema-instance"+ , attr "xsi:schemaLocation" $ txt "http://www.gexf.net/1.2draft http://www.gexf.net/1.2draft/gexf.xsd"+ ] [graph]+ directed | isDirected gr = "directed"+ | otherwise = "undirected"+ graph = mkelem "graph" [ attr "mode" $ txt "static"+ , attr "defaultedgetype" $ txt directed+ ] [ns, es]+ ns = mkelem "nodes" [] $ map mkNode $ nodes gr+ es = mkelem "edges" [] $ map mkEdge $ edges gr+ mkNode i =+ mkelem "node" [ attr "id" $ txt $ show i+ , attr "label" $ txt $ _nodeLabel at ]+ [ aelem "viz:position" [ attr "x" $ txt $ show $ _positionX at+ , attr "y" $ txt $ show $ _positionY at ]+ , aelem "viz:color" [ attr "r" $ txt r+ , attr "g" $ txt g+ , attr "b" $ txt b+ , attr "a" $ txt a ]+ , aelem "viz:size" [attr "value" $ txt $ show $ _size at]+ ]+ where+ at = nodeLab gr i+ rgb = toSRGB24 $ _nodeColour at `over` black+ r = show (fromIntegral $ channelRed rgb :: Int)+ b = show (fromIntegral $ channelBlue rgb :: Int)+ g = show (fromIntegral $ channelGreen rgb :: Int)+ a = show $ alphaChannel $ _nodeColour at++ mkEdge (fr,to) =+ mkelem "edge" [ attr "source" $ txt $ show fr+ , attr "target" $ txt $ show to+ , attr "weight" $ txt $ show $ _edgeWeight at ]+ [ aelem "viz:color" [ attr "r" $ txt r+ , attr "g" $ txt g+ , attr "b" $ txt b+ , attr "a" $ txt a ]+ ]+ where+ at = edgeLab gr (fr,to)+ rgb = toSRGB24 $ _edgeColour at `over` black+ r = show (fromIntegral $ channelRed rgb :: Int)+ b = show (fromIntegral $ channelBlue rgb :: Int)+ g = show (fromIntegral $ channelGreen rgb :: Int)+ a = show $ alphaChannel $ _edgeColour at+{-# INLINE genXMLTree #-}++writeGEXF :: Graph d => FilePath -> LGraph d NodeAttr EdgeAttr -> IO ()+writeGEXF fl gr = runX (genXMLTree gr >>> writeDocument config fl) >> return ()+ where+ config = [withIndent yes]
+ src/IGraph/Exporter/Graphics.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+module IGraph.Exporter.Graphics+ ( renderGraph+ , graphToDiagram+ ) where++import Data.List (sortBy)+import Data.Ord (comparing)+import Diagrams.Backend.Cairo+import Diagrams.Prelude+import Diagrams.Size (dims)++import IGraph+import IGraph.Exporter.GEXF++renderGraph :: Graph d => FilePath -> Double -> Double -> LGraph d NodeAttr EdgeAttr -> IO ()+renderGraph out w h gr = renderCairo out (dims $ w ^& h) $ graphToDiagram gr++graphToDiagram :: Graph d => LGraph d NodeAttr EdgeAttr -> Diagram B+graphToDiagram gr = mconcat $ fst $ unzip $ sortBy (flip (comparing snd)) $+ map drawNode (nodes gr) ++ map drawEdge (edges gr)+ where+ drawNode x = ( moveTo (_positionX nattr ^& _positionY nattr)+ (circle (_size nattr) # lwO 0 # fcA (_nodeColour nattr))+ , _nodeZindex nattr )+ where+ nattr = nodeLab gr x+ drawEdge (from, to) = {-arrowBetween'+ ( with & arrowTail .~ noTail+ & arrowHead .~ arrowH+ & headLength .~ output (_edgeArrowLength eattr)+ ) start end-}+ ( fromVertices [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+ nattr1 = nodeLab gr from+ nattr2 = nodeLab gr to+ --arrowH | isDirected gr = dart+ -- | otherwise = noHead+{-# INLINE graphToDiagram #-}
+ src/IGraph/Generators.hs view
@@ -0,0 +1,28 @@+module IGraph.Generators+ ( ErdosRenyiModel(..)+ , erdosRenyiGame+ ) where++import IGraph+import IGraph.Mutable+import IGraph.Internal.Graph+import IGraph.Internal.Constants+import IGraph.Internal.Initialization++data ErdosRenyiModel = GNP+ | GNM++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+ unsafeFreeze $ MLGraph gp+ where+ model' = case model of+ GNP -> IgraphErdosRenyiGnp+ GNM -> IgraphErdosRenyiGnm
+ src/IGraph/Internal/Arpack.chs view
@@ -0,0 +1,12 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module IGraph.Internal.Arpack where++import Control.Monad+import Foreign+import Foreign.C.Types++#include "cbits/haskelligraph.c"++{#pointer *igraph_arpack_options_t as ArpackOptPtr foreign finalizer igraph_arpack_destroy newtype#}++{#fun igraph_arpack_new as ^ { } -> `ArpackOptPtr' #}
+ src/IGraph/Internal/Attribute.chs view
@@ -0,0 +1,60 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module IGraph.Internal.Attribute where++import qualified Data.ByteString.Char8 as B+import Control.Monad+import Control.Applicative+import Foreign+import Foreign.C.Types+import Foreign.C.String+import System.IO.Unsafe (unsafePerformIO)++{#import IGraph.Internal.Graph #}+{#import IGraph.Internal.Data #}+{#import IGraph.Internal.Constants #}++#include "igraph/igraph.h"++makeAttributeRecord :: Show a+ => String -- ^ name of the attribute+ -> [a] -- ^ values of the attribute+ -> AttributeRecord+makeAttributeRecord name xs = unsafePerformIO $ do+ ptr <- newCAString name+ value <- listToStrVector $ map (B.pack . show) xs+ return $ AttributeRecord ptr 2 value++data AttributeRecord = AttributeRecord CString Int StrVectorPtr++instance Storable AttributeRecord where+ sizeOf _ = {#sizeof igraph_attribute_record_t #}+ alignment _ = {#alignof igraph_attribute_record_t #}+ peek p = AttributeRecord+ <$> ({#get igraph_attribute_record_t->name #} p)+ <*> liftM fromIntegral ({#get igraph_attribute_record_t->type #} p)+ <*> ( do ptr <- {#get igraph_attribute_record_t->value #} p+ fptr <- newForeignPtr_ . castPtr $ ptr+ return $ StrVectorPtr fptr )+ poke p (AttributeRecord name t vptr) = do+ {#set igraph_attribute_record_t.name #} p name+ {#set igraph_attribute_record_t.type #} p $ fromIntegral t+ withStrVectorPtr vptr $ \ptr ->+ {#set igraph_attribute_record_t.value #} p $ castPtr ptr++{#fun pure igraph_cattribute_has_attr as ^ { `IGraphPtr', `AttributeElemtype', `String' } -> `Bool' #}++{#fun igraph_cattribute_GAN_set as ^ { `IGraphPtr', `String', `Double' } -> `Int' #}++{#fun pure igraph_cattribute_GAN as ^ { `IGraphPtr', `String' } -> `Double' #}++{#fun pure igraph_cattribute_VAS as ^ { `IGraphPtr', `String', `Int' } -> `String' #}++{#fun pure igraph_cattribute_EAN as ^ { `IGraphPtr', `String', `Int' } -> `Double' #}++{#fun pure igraph_cattribute_EAS as ^ { `IGraphPtr', `String', `Int' } -> `String' #}++{#fun igraph_cattribute_EAS_setv as ^ { `IGraphPtr', `String', `StrVectorPtr' } -> `Int' #}++{#fun igraph_cattribute_VAS_set as ^ { `IGraphPtr', `String', `Int', `String' } -> `Int' #}++{#fun igraph_cattribute_EAS_set as ^ { `IGraphPtr', `String', `Int', `String' } -> `Int' #}
+ src/IGraph/Internal/Clique.chs view
@@ -0,0 +1,17 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module IGraph.Internal.Clique 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.Data #}++#include "cbits/haskelligraph.c"++{#fun igraph_cliques as ^ { `IGraphPtr', `VectorPPtr', `Int', `Int' } -> `Int' #}++{#fun igraph_maximal_cliques as ^ { `IGraphPtr', `VectorPPtr', `Int', `Int' } -> `Int' #}
+ src/IGraph/Internal/Community.chs view
@@ -0,0 +1,55 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module IGraph.Internal.Community where++import Foreign+import Foreign.C.Types++{#import IGraph.Internal.Arpack #}+{#import IGraph.Internal.Graph #}+{#import IGraph.Internal.Data #}+{#import IGraph.Internal.Constants #}++#include "cbits/haskelligraph.c"++{#fun igraph_community_spinglass as ^+{ `IGraphPtr'+, `VectorPtr'+, id `Ptr CDouble'+, id `Ptr CDouble'+, `VectorPtr'+, id `Ptr VectorPtr'+, `Int'+, `Bool'+, `Double'+, `Double'+, `Double'+, `SpincommUpdate'+, `Double'+, `SpinglassImplementation'+, `Double'+} -> `Int' #}++{#fun igraph_community_leading_eigenvector as ^+{ `IGraphPtr'+, `VectorPtr'+, id `Ptr MatrixPtr'+, `VectorPtr'+, `Int'+, `ArpackOptPtr'+, id `Ptr CDouble'+, `Bool'+, id `Ptr VectorPtr'+, id `Ptr VectorPPtr'+, id `Ptr VectorPtr'+, id `T'+, id `Ptr ()'+} -> `Int' #}++type T = FunPtr ( Ptr VectorPtr+ -> CLong+ -> CDouble+ -> Ptr VectorPtr+ -> FunPtr (Ptr CDouble -> Ptr CDouble -> CInt -> Ptr () -> IO CInt)+ -> Ptr ()+ -> Ptr ()+ -> IO CInt)
+ src/IGraph/Internal/Constants.chs view
@@ -0,0 +1,30 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module IGraph.Internal.Constants where++import Foreign++#include "cbits/haskelligraph.c"++{#enum igraph_neimode_t as Neimode {underscoreToCase}+ deriving (Show, Eq) #}++{#enum igraph_edgeorder_type_t as EdgeOrderType {underscoreToCase}+ deriving (Show, Eq) #}++{#enum igraph_spincomm_update_t as SpincommUpdate {underscoreToCase}+ deriving (Show, Eq) #}++{#enum igraph_spinglass_implementation_t as SpinglassImplementation {underscoreToCase}+ deriving (Show, Eq) #}++{#enum igraph_attribute_elemtype_t as AttributeElemtype {underscoreToCase}+ deriving (Show, Eq) #}++{#enum igraph_subgraph_implementation_t as SubgraphImplementation {underscoreToCase}+ deriving (Show, Read, Eq) #}++{#enum igraph_pagerank_algo_t as PagerankAlgo {underscoreToCase}+ deriving (Show, Read, Eq) #}++{#enum igraph_erdos_renyi_t as ErdosRenyi {underscoreToCase}+ deriving (Show, Read, Eq) #}
+ src/IGraph/Internal/Data.chs view
@@ -0,0 +1,149 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module IGraph.Internal.Data where++import Control.Monad+import qualified Data.ByteString.Char8 as B+import Foreign+import Foreign.C.Types+import Foreign.C.String+import System.IO.Unsafe (unsafePerformIO)+import Data.List (transpose)+import Data.List.Split (chunksOf)++#include "cbits/haskelligraph.c"++{#pointer *igraph_vector_t as VectorPtr foreign finalizer igraph_vector_destroy newtype#}++-- Construtors and destructors++{#fun igraph_vector_init as igraphVectorNew { +, `Int' } -> `VectorPtr' #}++listToVector :: [Double] -> IO VectorPtr+listToVector xs = do+ vec <- igraphVectorNew n+ forM_ (zip [0..] xs) $ \(i,x) -> igraphVectorSet vec i x+ return vec+ where+ n = length xs++vectorPtrToList :: VectorPtr -> IO [Double]+vectorPtrToList vptr = do+ n <- igraphVectorSize vptr+ allocaArray n $ \ptr -> do+ igraphVectorCopyTo vptr ptr+ liftM (map realToFrac) $ peekArray n ptr++-- Initializing elements++{#fun igraph_vector_null as ^ { `VectorPtr' } -> `()' #}++{#fun igraph_vector_fill as ^ { `VectorPtr', `Double' } -> `()' #}+++-- Accessing elements++{#fun pure igraph_vector_e as ^ { `VectorPtr', `Int' } -> `Double' #}++{#fun igraph_vector_set as ^ { `VectorPtr', `Int', `Double' } -> `()' #}++{#fun pure igraph_vector_tail as ^ { `VectorPtr' } -> `Double' #}+++-- Copying vectors++{#fun igraph_vector_copy_to as ^ { `VectorPtr', id `Ptr CDouble' } -> `()' #}++-- Vector properties+{#fun igraph_vector_size as ^ { `VectorPtr' } -> `Int' #}+++{#pointer *igraph_vector_ptr_t as VectorPPtr foreign finalizer igraph_vector_ptr_destroy_all newtype#}++{#fun igraph_vector_ptr_init as igraphVectorPtrNew { +, `Int' } -> `VectorPPtr' #}++{#fun igraph_vector_ptr_e as ^ { `VectorPPtr', `Int' } -> `Ptr ()' #}+{#fun igraph_vector_ptr_set as ^ { `VectorPPtr', `Int', id `Ptr ()' } -> `()' #}+{#fun igraph_vector_ptr_size as ^ { `VectorPPtr' } -> `Int' #}++listToVectorP :: [Ptr ()] -> IO VectorPPtr+listToVectorP xs = do+ vptr <- igraphVectorPtrNew n+ forM_ (zip [0..] xs) $ \(i,x) -> igraphVectorPtrSet vptr i x+ return vptr+ where+ n = length xs++vectorPPtrToList :: VectorPPtr -> IO [[Double]]+vectorPPtrToList vpptr = do+ n <- igraphVectorPtrSize vpptr+ forM [0..n-1] $ \i -> do+ vptr <- igraphVectorPtrE vpptr i+ fptr <- newForeignPtr_ $ castPtr vptr+ vectorPtrToList $ VectorPtr fptr+++{#pointer *igraph_strvector_t as StrVectorPtr foreign finalizer igraph_strvector_destroy newtype#}++{#fun igraph_strvector_init as igraphStrvectorNew { +, `Int' } -> `StrVectorPtr' #}++{#fun igraph_strvector_get_ as igraphStrvectorGet' { `StrVectorPtr', `Int' } -> `Ptr CString' id #}++igraphStrvectorGet :: StrVectorPtr -> Int -> String+igraphStrvectorGet vec i = unsafePerformIO $ do+ ptr <- igraphStrvectorGet' vec i+ peek ptr >>= peekCString++{#fun igraph_strvector_set as ^ { `StrVectorPtr', `Int', id `CString'} -> `()' #}+{#fun igraph_strvector_set2 as ^ { `StrVectorPtr', `Int', id `CString', `Int'} -> `()' #}++listToStrVector :: [B.ByteString] -> IO StrVectorPtr+listToStrVector xs = do+ vec <- igraphStrvectorNew n+ forM_ (zip [0..] xs) $ \(i,x) -> B.useAsCString x (igraphStrvectorSet vec i)+ return vec+ where+ n = length xs+++{#pointer *igraph_matrix_t as MatrixPtr foreign finalizer igraph_matrix_destroy newtype#}++{#fun igraph_matrix_init as igraphMatrixNew { +, `Int', `Int' } -> `MatrixPtr' #}++{#fun igraph_matrix_null as ^ { `MatrixPtr' } -> `()' #}++{#fun igraph_matrix_fill as ^ { `MatrixPtr', `Double' } -> `()' #}++{#fun igraph_matrix_e as ^ { `MatrixPtr', `Int', `Int' } -> `Double' #}++{#fun igraph_matrix_set as ^ { `MatrixPtr', `Int', `Int', `Double' } -> `()' #}++{#fun igraph_matrix_copy_to as ^ { `MatrixPtr', id `Ptr CDouble' } -> `()' #}++{#fun igraph_matrix_nrow as ^ { `MatrixPtr' } -> `Int' #}++{#fun igraph_matrix_ncol as ^ { `MatrixPtr' } -> `Int' #}++-- row lists to matrix+listsToMatrixPtr :: [[Double]] -> IO MatrixPtr+listsToMatrixPtr xs = do+ mptr <- igraphMatrixNew r c+ forM_ (zip [0..] xs) $ \(i, row) ->+ forM_ (zip [0..] row) $ \(j,v) ->+ igraphMatrixSet mptr i j v+ return mptr+ where+ r = length xs+ c = maximum $ map length xs++-- to row lists+matrixPtrToLists :: MatrixPtr -> IO [[Double]]+matrixPtrToLists = liftM transpose . matrixPtrToColumnLists++matrixPtrToColumnLists :: MatrixPtr -> IO [[Double]]+matrixPtrToColumnLists mptr = do+ r <- igraphMatrixNrow mptr+ c <- igraphMatrixNcol mptr+ xs <- allocaArray (r*c) $ \ptr -> do+ igraphMatrixCopyTo mptr ptr+ peekArray (r*c) ptr+ return $ chunksOf r $ map realToFrac xs
+ src/IGraph/Internal/Graph.chs view
@@ -0,0 +1,56 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module IGraph.Internal.Graph where++import Control.Monad+import Foreign+import Foreign.C.Types+import System.IO.Unsafe (unsafePerformIO)++{#import IGraph.Internal.Initialization #}+{#import IGraph.Internal.Data #}+{#import IGraph.Internal.Constants #}++#include "cbits/haskelligraph.c"++{#pointer *igraph_t as IGraphPtr foreign finalizer igraph_destroy newtype#}++-- | create a igraph object and attach a finalizer+igraphNew :: Int -> Bool -> HasInit -> IO IGraphPtr+igraphNew n directed _ = igraphNew' n directed++-- Graph Constructors and Destructors++{#fun igraph_empty as igraphNew' { +, `Int', `Bool' } -> `IGraphPtr' #}++{#fun igraph_copy as ^ { +, `IGraphPtr' } -> `IGraphPtr' #}++-- Basic Query Operations++{#fun pure igraph_vcount as ^ { `IGraphPtr' } -> `Int' #}++{#fun pure igraph_ecount as ^ { `IGraphPtr' } -> `Int' #}++{#fun pure igraph_get_eid_ as igraphGetEid { `IGraphPtr', `Int', `Int', `Bool', `Bool' } -> `Int' #}++{#fun igraph_edge as igraphEdge' { `IGraphPtr', `Int', id `Ptr CInt', id `Ptr CInt' } -> `Int' #}+igraphEdge :: IGraphPtr -> Int -> IO (Int, Int)+igraphEdge g i = alloca $ \fr -> alloca $ \to -> do+ igraphEdge' g i fr to+ fr' <- peek fr+ to' <- peek to+ return (fromIntegral fr', fromIntegral to')++-- Adding and Deleting Vertices and Edges++{# fun igraph_add_vertices as ^ { `IGraphPtr', `Int', id `Ptr ()' } -> `()' #}++{# fun igraph_add_edge as ^ { `IGraphPtr', `Int', `Int' } -> `()' #}++{# fun igraph_add_edges as ^ { `IGraphPtr', `VectorPtr', id `Ptr ()' } -> `()' #}+++-- generators++{#fun igraph_full as ^ { +, `Int', `Bool', `Bool' } -> `IGraphPtr' #}++{#fun igraph_erdos_renyi_game as ^ {+, `ErdosRenyi', `Int', `Double', `Bool', `Bool'} -> `IGraphPtr' #}
+ src/IGraph/Internal/Initialization.chs view
@@ -0,0 +1,12 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module IGraph.Internal.Initialization where++#include "cbits/haskelligraph.c"++data HasInit++igraphInit :: IO HasInit+igraphInit = do haskelligraphInit+ return undefined++{#fun haskelligraph_init as ^ {} -> `()' #}
+ src/IGraph/Internal/Isomorphism.chs view
@@ -0,0 +1,16 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module IGraph.Internal.Isomorphism where++import Foreign+import Foreign.C.Types++{#import IGraph.Internal.Graph #}+{#import IGraph.Internal.Data #}++#include "igraph/igraph.h"++{#fun igraph_get_subisomorphisms_vf2 as ^ { `IGraphPtr', `IGraphPtr',+ id `Ptr ()', id `Ptr ()', id `Ptr ()', id `Ptr ()', `VectorPPtr',+ 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' #}
+ src/IGraph/Internal/Layout.chs view
@@ -0,0 +1,38 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module IGraph.Internal.Layout 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.Data #}++#include "igraph/igraph.h"++{#fun igraph_layout_kamada_kawai as ^ { `IGraphPtr'+, `MatrixPtr'+, `Int'+, `Double'+, `Double'+, `Double'+, `Double'+, `Bool'+, id `Ptr VectorPtr'+, id `Ptr VectorPtr'+, id `Ptr VectorPtr'+, id `Ptr VectorPtr'+} -> `Int' #}++{# fun igraph_layout_lgl as ^ { `IGraphPtr'+, `MatrixPtr'+, `Int'+, `Double'+, `Double'+, `Double'+, `Double'+, `Double'+, `Int'+} -> `Int' #}
+ src/IGraph/Internal/Selector.chs view
@@ -0,0 +1,127 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module IGraph.Internal.Selector where++import Control.Monad+import Foreign+import Foreign.C.Types+import System.IO.Unsafe (unsafePerformIO)++{#import IGraph.Internal.Constants #}+{#import IGraph.Internal.Graph #}+{#import IGraph.Internal.Data #}++#include "igraph/igraph.h"++{#pointer *igraph_vs_t as IGraphVsPtr foreign finalizer igraph_vs_destroy newtype #}++{#fun igraph_vs_all as ^ { + } -> `IGraphVsPtr' #}++{#fun igraph_vs_adj as ^ { +, `Int', `Neimode' } -> `IGraphVsPtr' #}++{#fun igraph_vs_vector as ^ { +, `VectorPtr' } -> `IGraphVsPtr' #}+++-- Vertex iterator++{#pointer *igraph_vit_t as IGraphVitPtr foreign finalizer igraph_vit_destroy newtype #}++#c+igraph_vit_t* igraph_vit_new(const igraph_t *graph, igraph_vs_t vs) {+ igraph_vit_t* vit = (igraph_vit_t*) malloc (sizeof (igraph_vit_t));+ igraph_vit_create(graph, vs, vit);+ return vit;+}++igraph_bool_t igraph_vit_end(igraph_vit_t *vit) {+ return IGRAPH_VIT_END(*vit);+}++void igraph_vit_next(igraph_vit_t *vit) {+ IGRAPH_VIT_NEXT(*vit);+}++igraph_integer_t igraph_vit_get(igraph_vit_t *vit) {+ return IGRAPH_VIT_GET(*vit);+}+#endc++{#fun igraph_vit_new as ^ { `IGraphPtr', %`IGraphVsPtr' } -> `IGraphVitPtr' #}++{#fun igraph_vit_end as ^ { `IGraphVitPtr' } -> `Bool' #}++{#fun igraph_vit_next as ^ { `IGraphVitPtr' } -> `()' #}++{#fun igraph_vit_get as ^ { `IGraphVitPtr' } -> `Int' #}++vitToList :: IGraphVitPtr -> IO [Int]+vitToList vit = do+ isEnd <- igraphVitEnd vit+ if isEnd+ then return []+ else do+ cur <- igraphVitGet vit+ igraphVitNext vit+ acc <- vitToList vit+ return $ cur : acc+++-- Edge Selector++{#pointer *igraph_es_t as IGraphEsPtr foreign finalizer igraph_es_destroy newtype #}++{#fun igraph_es_all as ^ { +, `EdgeOrderType' } -> `IGraphEsPtr' #}++{# fun igraph_es_vector as ^ { +, `VectorPtr' } -> `IGraphEsPtr' #}+++-- Edge iterator++{#pointer *igraph_eit_t as IGraphEitPtr foreign finalizer igraph_eit_destroy newtype #}++#c+igraph_eit_t* igraph_eit_new(const igraph_t *graph, igraph_es_t es) {+ igraph_eit_t* eit = (igraph_eit_t*) malloc (sizeof (igraph_eit_t));+ igraph_eit_create(graph, es, eit);+ return eit;+}++igraph_bool_t igraph_eit_end(igraph_eit_t *eit) {+ return IGRAPH_EIT_END(*eit);+}++void igraph_eit_next(igraph_eit_t *eit) {+ IGRAPH_EIT_NEXT(*eit);+}++igraph_integer_t igraph_eit_get(igraph_eit_t *eit) {+ return IGRAPH_EIT_GET(*eit);+}+#endc++{#fun igraph_eit_new as ^ { `IGraphPtr', %`IGraphEsPtr' } -> `IGraphEitPtr' #}++{#fun igraph_eit_end as ^ { `IGraphEitPtr' } -> `Bool' #}++{#fun igraph_eit_next as ^ { `IGraphEitPtr' } -> `()' #}++{#fun igraph_eit_get as ^ { `IGraphEitPtr' } -> `Int' #}++eitToList :: IGraphEitPtr -> IO [Int]+eitToList eit = do+ isEnd <- igraphEitEnd eit+ if isEnd+ then return []+ else do+ cur <- igraphEitGet eit+ igraphEitNext eit+ acc <- eitToList eit+ return $ cur : acc++-- delete vertices++{# fun igraph_delete_vertices as ^ { `IGraphPtr', %`IGraphVsPtr' } -> `Int' #}+++-- delete edges++{# fun igraph_delete_edges as ^ { `IGraphPtr', %`IGraphEsPtr' } -> `Int' #}
+ src/IGraph/Internal/Structure.chs view
@@ -0,0 +1,61 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module IGraph.Internal.Structure where++import Foreign+import Foreign.C.Types++{#import IGraph.Internal.Graph #}+{#import IGraph.Internal.Selector #}+{#import IGraph.Internal.Constants #}+{#import IGraph.Internal.Data #}+{#import IGraph.Internal.Arpack #}++#include "igraph/igraph.h"++{#fun igraph_induced_subgraph as ^ { `IGraphPtr'+ , id `Ptr (IGraphPtr)'+ , %`IGraphVsPtr'+ , `SubgraphImplementation' } -> `Int' #}++{#fun igraph_closeness as ^ { `IGraphPtr'+ , `VectorPtr'+ , %`IGraphVsPtr'+ , `Neimode'+ , `VectorPtr'+ , `Bool' } -> `Int' #}++{#fun igraph_betweenness as ^ { `IGraphPtr'+ , `VectorPtr'+ , %`IGraphVsPtr'+ , `Bool'+ , `VectorPtr'+ , `Bool' } -> `Int' #}++{#fun igraph_eigenvector_centrality as ^ { `IGraphPtr'+ , `VectorPtr'+ , id `Ptr CDouble'+ , `Bool'+ , `Bool'+ , `VectorPtr'+ , `ArpackOptPtr' } -> `Int' #}++{#fun igraph_pagerank as ^ { `IGraphPtr'+ , `PagerankAlgo'+ , `VectorPtr'+ , id `Ptr CDouble'+ , %`IGraphVsPtr'+ , `Bool'+ , `Double'+ , `VectorPtr'+ , id `Ptr ()' } -> `Int' #}++{#fun igraph_personalized_pagerank as ^ { `IGraphPtr'+ , `PagerankAlgo'+ , `VectorPtr'+ , id `Ptr CDouble'+ , %`IGraphVsPtr'+ , `Bool'+ , `Double'+ , `VectorPtr'+ , `VectorPtr'+ , id `Ptr ()' } -> `Int' #}
+ src/IGraph/Isomorphism.hs view
@@ -0,0 +1,23 @@+module IGraph.Isomorphism (getSubisomorphisms) where++import Foreign+import Foreign.C.Types+import System.IO.Unsafe (unsafePerformIO)++import IGraph+import IGraph.Internal.Data+import IGraph.Internal.Isomorphism++getSubisomorphisms :: Graph d+ => LGraph d v1 e1 -- ^ graph to be searched in+ -> LGraph d v2 e2 -- ^ smaller graph+ -> [[Int]]+getSubisomorphisms g1 g2 = unsafePerformIO $ do+ vpptr <- igraphVectorPtrNew 0+ igraphGetSubisomorphismsVf2 gptr1 gptr2 nullPtr nullPtr nullPtr nullPtr vpptr+ nullFunPtr nullFunPtr nullPtr+ (map.map) truncate <$> vectorPPtrToList vpptr+ where+ gptr1 = _graph g1+ gptr2 = _graph g2+{-# INLINE getSubisomorphisms #-}
+ src/IGraph/Layout.hs view
@@ -0,0 +1,86 @@+module IGraph.Layout+ ( getLayout+ , LayoutMethod(..)+ , defaultKamadaKawai+ , defaultLGL+ ) where++import Control.Applicative ((<$>))+import Data.Default.Class+import Data.Maybe (isJust)+import Foreign (nullPtr)+import System.IO.Unsafe (unsafePerformIO)++import IGraph+import IGraph.Internal.Clique+import IGraph.Internal.Data+import IGraph.Internal.Layout++data LayoutMethod = KamadaKawai+ { kk_seed :: !(Maybe [(Double, Double)])+ , kk_nIter :: !Int+ , kk_sigma :: (Int -> Double) -- ^ The base standard deviation of position+ -- change proposals+ , kk_startTemp :: !Double -- ^ The initial temperature for the annealing+ , kk_coolFact :: !Double -- ^ The cooling factor for the simulated annealing+ , kk_const :: (Int -> Double) -- ^ The Kamada-Kawai vertex attraction constant+ }+ | LGL -- ^ the Large Graph Layout algorithm+ { lgl_nIter :: !Int+ , 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.+ , lgl_area :: (Int -> Double) -- ^ This parameter gives the area of the square+ -- on which the vertices will be placed. A reasonable+ -- default value is the number of vertices squared.+ , lgl_coolexp :: !Double -- ^ The cooling exponent. A reasonable default value is 1.5.+ , lgl_repulserad :: (Int -> Double) -- ^ Determines the radius at which vertex-vertex repulsion cancels out attraction of adjacent vertices. A reasonable default value is area times the number of vertices.+ , lgl_cellsize :: (Int -> Double)+ }++defaultKamadaKawai :: LayoutMethod+defaultKamadaKawai = KamadaKawai+ { kk_seed = Nothing+ , kk_nIter = 1000+ , kk_sigma = \x -> fromIntegral x / 4+ , kk_startTemp = 10+ , kk_coolFact = 0.99+ , kk_const = \x -> fromIntegral $ x^2+ }++defaultLGL :: LayoutMethod+defaultLGL = LGL+ { lgl_nIter = 150+ , lgl_maxdelta = \x -> fromIntegral x+ , lgl_area = area+ , lgl_coolexp = 1.5+ , lgl_repulserad = \x -> fromIntegral x * area x+ , lgl_cellsize = \x -> area x ** 0.25+ }+ where+ area x = fromIntegral $ x^2++getLayout :: Graph d => LGraph d v e -> LayoutMethod -> IO [(Double, Double)]+getLayout gr method = do+ case method of+ KamadaKawai seed niter sigma initemp coolexp kkconst -> do+ mptr <- case seed of+ Nothing -> igraphMatrixNew 0 0+ Just xs -> if length xs /= nNodes gr+ then error "Seed error: incorrect size"+ else listsToMatrixPtr $ (\(x,y) -> [x,y]) $ unzip xs++ igraphLayoutKamadaKawai gptr mptr niter (sigma n) initemp coolexp+ (kkconst n) (isJust seed) nullPtr nullPtr nullPtr nullPtr+ [x, y] <- matrixPtrToColumnLists mptr+ return $ zip x y++ LGL niter delta area coolexp repulserad cellsize -> do+ mptr <- igraphMatrixNew 0 0+ igraphLayoutLgl gptr mptr niter (delta n) (area n) coolexp+ (repulserad n) (cellsize n) (-1)+ [x, y] <- matrixPtrToColumnLists mptr+ return $ zip x y+ where+ n = nNodes gr+ gptr = _graph gr
+ src/IGraph/Motif.hs view
@@ -0,0 +1,45 @@+module IGraph.Motif+ (triad) where++import IGraph++-- | Every triple of vertices in a directed graph+-- 003: A, B, C, the empty graph.+-- 012: A->B, C, a graph with a single directed edge.+-- 102: A<->B, C, a graph with a mutual connection between two vertices.+-- 021D: A<-B->C, the binary out-tree.+-- 021U: A->B<-C, the binary in-tree.+-- 021C: A->B->C, the directed line.+-- 111D: A<->B<-C.+-- 111U: A<->B->C.+-- 030T: A->B<-C, A->C.+-- 030C: A<-B<-C, A->C.+-- 201: A<->B<->C.+-- 120D: A<-B->C, A<->C.+-- 120U: A->B<-C, A<->C.+-- 120C: A->B->C, A<->C.+-- 210: A->B<->C, A<->C.+-- 300: A<->B<->C, A<->C, the complete graph.+triad :: [LGraph D () ()]+triad = map make xs+ where+ xs = [ []+ , [(0,1)]+ , [(0,1), (1,0)]+ , [(1,0), (1,2)]+ , [(0,1), (2,1)]+ , [(0,1), (1,2)]+ , [(0,1), (1,0), (2,1)]+ , [(0,1), (1,0), (1,2)]+ , [(0,1), (2,1), (0,2)]+ , [(1,0), (2,1), (0,2)]+ , [(0,1), (1,0), (0,2), (2,0)]+ , [(1,0), (1,2), (0,2), (2,0)]+ , [(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)]+ ]++make :: [(Int, Int)] -> LGraph D () ()+make xs = mkGraph (replicate (length xs) ()) $ zip xs $ repeat ()
+ src/IGraph/Mutable.hs view
@@ -0,0 +1,112 @@+{-# LANGUAGE MultiParamTypeClasses #-}+module IGraph.Mutable where++import Foreign+import Control.Monad.Primitive++import IGraph.Internal.Graph+import IGraph.Internal.Selector+import IGraph.Internal.Data+import IGraph.Internal.Attribute+import IGraph.Internal.Initialization++-- constants+vertexAttr :: String+vertexAttr = "vertex_attribute"++edgeAttr :: String+edgeAttr = "edge_attribute"++type LEdge a = (Int, Int, a)++-- | Mutable labeled graph+newtype MLGraph m d v e = MLGraph IGraphPtr++class MGraph d where+ new :: PrimMonad m => Int -> m (MLGraph (PrimState m) d v e)++ addNodes :: PrimMonad m => Int -> MLGraph(PrimState m) d v e -> m ()+ addNodes n (MLGraph g) = unsafePrimToPrim $ igraphAddVertices g n nullPtr++ addLNodes :: (Show v, PrimMonad m)+ => Int -- ^ the number of new vertices add to the graph+ -> [v] -- ^ vertices' labels+ -> MLGraph (PrimState m) d v e -> m ()+ addLNodes n labels (MLGraph g)+ | n /= length labels = error "addLVertices: incorrect number of labels"+ | otherwise = unsafePrimToPrim $ do+ let attr = makeAttributeRecord vertexAttr labels+ alloca $ \ptr -> do+ poke ptr attr+ vptr <- listToVectorP [castPtr ptr]+ withVectorPPtr vptr $ \p -> igraphAddVertices g n $ castPtr p++ delNodes :: PrimMonad m => [Int] -> MLGraph (PrimState m) d v e -> m ()+ delNodes ns (MLGraph g) = unsafePrimToPrim $ do+ vptr <- listToVector $ map fromIntegral ns+ vsptr <- igraphVsVector vptr+ igraphDeleteVertices g vsptr+ return ()++ addEdges :: PrimMonad m => [(Int, Int)] -> MLGraph (PrimState m) d v e -> m ()++ addLEdges :: (PrimMonad m, Show e) => [LEdge e] -> MLGraph (PrimState m) d v e -> m ()++ delEdges :: PrimMonad m => [(Int, Int)] -> MLGraph (PrimState m) d v e -> m ()++data U = U+data D = D++instance MGraph U where+ new n = unsafePrimToPrim $ igraphInit >>= igraphNew n False >>= return . MLGraph++ addEdges es (MLGraph g) = unsafePrimToPrim $ do+ vec <- listToVector xs+ igraphAddEdges g vec nullPtr+ where+ xs = concatMap ( \(a,b) -> [fromIntegral a, fromIntegral b] ) es++ addLEdges es (MLGraph g) = unsafePrimToPrim $ do+ vec <- listToVector $ concat xs+ let attr = makeAttributeRecord edgeAttr vs+ alloca $ \ptr -> do+ poke ptr attr+ vptr <- listToVectorP [castPtr ptr]+ withVectorPPtr vptr $ \p -> igraphAddEdges g vec $ castPtr p+ where+ (xs, vs) = unzip $ map ( \(a,b,v) -> ([fromIntegral a, fromIntegral b], v) ) es++ delEdges es (MLGraph g) = unsafePrimToPrim $ do+ vptr <- listToVector $ map fromIntegral eids+ esptr <- igraphEsVector vptr+ igraphDeleteEdges g esptr+ return ()+ where+ eids = flip map es $ \(fr, to) -> igraphGetEid g fr to False True++instance MGraph D where+ new n = unsafePrimToPrim $ igraphInit >>= igraphNew n True >>= return . MLGraph++ addEdges es (MLGraph g) = unsafePrimToPrim $ do+ vec <- listToVector xs+ igraphAddEdges g vec nullPtr+ where+ xs = concatMap ( \(a,b) -> [fromIntegral a, fromIntegral b] ) es++ addLEdges es (MLGraph g) = unsafePrimToPrim $ do+ vec <- listToVector $ concat xs+ let attr = makeAttributeRecord edgeAttr vs+ alloca $ \ptr -> do+ poke ptr attr+ vptr <- listToVectorP [castPtr ptr]+ withVectorPPtr vptr $ \p -> igraphAddEdges g vec $ castPtr p+ where+ (xs, vs) = unzip $ map ( \(a,b,v) -> ([fromIntegral a, fromIntegral b], v) ) es++ delEdges es (MLGraph g) = unsafePrimToPrim $ do+ vptr <- listToVector $ map fromIntegral eids+ esptr <- igraphEsVector vptr+ igraphDeleteEdges g esptr+ return ()+ where+ eids = flip map es $ \(fr, to) -> igraphGetEid g fr to True True
+ src/IGraph/Read.hs view
@@ -0,0 +1,46 @@+module IGraph.Read+ ( readAdjMatrix+ , fromAdjMatrix+ , readAdjMatrixWeighted+ ) where++import qualified Data.ByteString.Char8 as B+import Data.ByteString.Lex.Fractional (readSigned, readExponential)+import Data.Maybe (fromJust)++import IGraph++readDouble :: B.ByteString -> Double+readDouble = fst . fromJust . readSigned readExponential+{-# INLINE readDouble #-}++readAdjMatrix :: Graph d => FilePath -> IO (LGraph d B.ByteString ())+readAdjMatrix = fmap fromAdjMatrix . B.readFile++fromAdjMatrix :: Graph d => B.ByteString -> LGraph d B.ByteString ()+fromAdjMatrix bs =+ let (header:xs) = B.lines bs+ mat = map (map readDouble . B.words) xs+ es = fst $ unzip $ filter f $ zip [ (i,j) | i <- [0..nrow-1], j <- [0..nrow-1] ] $ concat mat+ nrow = length mat+ ncol = length $ head mat+ in if nrow /= ncol+ then error "fromAdjMatrix: nrow != ncol"+ else mkGraph (B.words header) $ zip es $ repeat ()+ where+ f ((i,j),v) = i < j && v /= 0+{-# INLINE fromAdjMatrix #-}++readAdjMatrixWeighted :: Graph d => FilePath -> IO (LGraph d B.ByteString Double)+readAdjMatrixWeighted fl = do+ c <- B.readFile fl+ let (header:xs) = B.lines c+ mat = map (map readDouble . B.words) xs+ (es, ws) = unzip $ filter f $ zip [ (i,j) | i <- [0..nrow-1], j <- [0..nrow-1] ] $ concat mat+ nrow = length mat+ ncol = length $ head mat+ if nrow /= ncol+ then error "nrow != ncol"+ else return $ mkGraph (B.words header) $ zip es ws+ where+ f ((i,j),v) = i < j && v /= 0
+ src/IGraph/Structure.hs view
@@ -0,0 +1,115 @@+module IGraph.Structure+ ( inducedSubgraph+ , closeness+ , betweenness+ , eigenvectorCentrality+ , pagerank+ , personalizedPagerank+ ) where++import Control.Monad+import Foreign+import Foreign.C.Types+import System.IO.Unsafe (unsafePerformIO)+import qualified Data.HashMap.Strict as M+import Data.Hashable (Hashable)++import IGraph+import IGraph.Mutable+import IGraph.Internal.Graph+import IGraph.Internal.Data+import IGraph.Internal.Selector+import IGraph.Internal.Structure+import IGraph.Internal.Arpack+import IGraph.Internal.Constants+import IGraph.Internal.Attribute++inducedSubgraph :: (Hashable v, Eq v, Read v) => LGraph d v e -> [Int] -> LGraph d v e+inducedSubgraph gr vs = unsafePerformIO $ do+ vs' <- listToVector $ map fromIntegral vs+ vsptr <- igraphVsVector vs'+ mallocForeignPtrBytes 160 >>= \gptr -> withForeignPtr gptr $ \p -> do+ igraphInducedSubgraph (_graph gr) p vsptr IgraphSubgraphCreateFromScratch+ let g' = IGraphPtr gptr+ labToId = M.fromListWith (++) $ zip labels $ map return [0..nV-1]+ nV = igraphVcount g'+ labels = map (read . igraphCattributeVAS g' vertexAttr) [0 .. nV-1]+ return $ LGraph g' labToId++-- | closeness centrality+closeness :: [Int] -- ^ vertices+ -> LGraph d v e+ -> Maybe [Double] -- ^ optional edge weights+ -> Neimode+ -> Bool -- ^ whether to normalize+ -> [Double]+closeness vs gr ws mode normal = unsafePerformIO $ do+ vs' <- listToVector $ map fromIntegral vs+ vsptr <- igraphVsVector vs'+ vptr <- igraphVectorNew 0+ ws' <- case ws of+ Just w -> listToVector w+ _ -> liftM VectorPtr $ newForeignPtr_ $ castPtr nullPtr+ igraphCloseness (_graph gr) vptr vsptr mode ws' normal+ vectorPtrToList vptr++-- | betweenness centrality+betweenness :: [Int]+ -> LGraph d v e+ -> Maybe [Double]+ -> [Double]+betweenness vs gr ws = unsafePerformIO $ do+ vs' <- listToVector $ map fromIntegral vs+ vsptr <- igraphVsVector vs'+ vptr <- igraphVectorNew 0+ ws' <- case ws of+ Just w -> listToVector w+ _ -> liftM VectorPtr $ newForeignPtr_ $ castPtr nullPtr+ igraphBetweenness (_graph gr) vptr vsptr True ws' False+ vectorPtrToList vptr++-- | eigenvector centrality+eigenvectorCentrality :: LGraph d v e+ -> Maybe [Double]+ -> [Double]+eigenvectorCentrality gr ws = unsafePerformIO $ do+ vptr <- igraphVectorNew 0+ ws' <- case ws of+ Just w -> listToVector w+ _ -> liftM VectorPtr $ newForeignPtr_ $ castPtr nullPtr+ arparck <- igraphArpackNew+ igraphEigenvectorCentrality (_graph gr) vptr nullPtr True True ws' arparck+ vectorPtrToList vptr++-- | Google's PageRank+pagerank :: Graph d+ => LGraph d v e+ -> Maybe [Double] -- ^ edge weights+ -> Double -- ^ damping factor, usually around 0.85+ -> [Double]+pagerank gr ws d = unsafePerformIO $ alloca $ \p -> do+ vptr <- igraphVectorNew 0+ vsptr <- igraphVsAll+ ws' <- case ws of+ Just w -> listToVector w+ _ -> liftM VectorPtr $ newForeignPtr_ $ castPtr nullPtr+ igraphPagerank (_graph gr) IgraphPagerankAlgoPrpack vptr p vsptr+ (isDirected gr) d ws' nullPtr+ vectorPtrToList vptr++personalizedPagerank :: Graph d+ => LGraph d v e+ -> [Double] -- ^ reset probability+ -> Maybe [Double]+ -> Double+ -> [Double]+personalizedPagerank gr reset ws d = unsafePerformIO $ alloca $ \p -> do+ vptr <- igraphVectorNew 0+ vsptr <- igraphVsAll+ ws' <- case ws of+ Just w -> listToVector w+ _ -> liftM VectorPtr $ newForeignPtr_ $ castPtr nullPtr+ reset' <- listToVector reset+ igraphPersonalizedPagerank (_graph gr) IgraphPagerankAlgoPrpack vptr p vsptr+ (isDirected gr) d reset' ws' nullPtr+ vectorPtrToList vptr
+ tests/Test/Basic.hs view
@@ -0,0 +1,42 @@+module Test.Basic+ ( tests+ ) where++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++tests :: TestTree+tests = testGroup "Basic tests"+ [ graphCreation+ , graphEdit+ ]++graphCreation :: TestTree+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 "" $ edgeList @=? (sort $ edges gr)+ ]+ where+ edgeList = sort $ unsafePerformIO $ randEdges 1000 100+ gr = mkGraph (100,Nothing) (edgeList, Nothing) :: LGraph D () ()+ simple = mkGraph (3,Nothing) ([(0,1),(1,2),(2,0)],Nothing) :: LGraph D () ()++graphEdit :: TestTree+graphEdit = testGroup "Graph editing"+ [ testCase "" $ [(1,2)] @=? (sort $ edges simple') ]+ where+ simple = mkGraph (3,Nothing) ([(0,1),(1,2),(2,0)],Nothing) :: LGraph U () ()+ simple' = runST $ do+ g <- thaw simple+ delEdges [(0,1),(0,2)] g+ freeze g
+ tests/Test/Structure.hs view
@@ -0,0 +1,33 @@+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++tests :: TestTree+tests = testGroup "Structure property tests"+ [ subGraphs+ ]++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 ori :: LGraph D String ()+ ns' = map (head . getNodes gr) ns+ gr' = inducedSubgraph gr ns'+ result = map (nodeLab gr' *** nodeLab gr') $ edges gr'
+ tests/Test/Utils.hs view
@@ -0,0 +1,13 @@+module Test.Utils where++import Control.Monad+import System.Random+import Data.List++randEdges :: Int -- ^ number of edges to generate+ -> Int -- ^ number of nodes in the graph+ -> IO [(Int, Int)]+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
+ tests/test.hs view
@@ -0,0 +1,9 @@+import qualified Test.Basic as Basic+import qualified Test.Structure as Structure+import Test.Tasty++main :: IO ()+main = defaultMain $ testGroup "Haskell-igraph Tests"+ [ Basic.tests+ , Structure.tests+ ]