more modules

cbits/Structure.chs.c

 #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,

haskell-igraph.cabal

@@ -17,6 +17,10 @@ build-type:          Simple
 extra-source-files:  cbits/haskelligraph.c
 cabal-version:       >=1.22
 
+Flag graphics
+  Description: Enable graphics output
+  Default:     False
+
 library
   exposed-modules:
     IGraph.Internal.Initialization
@@ -25,6 +29,7 @@ library
     IGraph.Internal.Data
     IGraph.Internal.Graph
     IGraph.Internal.Attribute
+    IGraph.Internal.Isomorphism
     IGraph.Internal.Selector
     IGraph.Internal.Structure
     IGraph.Internal.Clique
@@ -34,12 +39,20 @@ library
     IGraph.Mutable
     IGraph.Clique
     IGraph.Structure
+    IGraph.Isomorphism
     IGraph.Community
     IGraph.Read
+    IGraph.Motif
     IGraph.Layout
+    IGraph.Generators
     IGraph.Exporter.GEXF
-  -- other-modules:
-  -- other-extensions:
+
+  if flag(graphics)
+    exposed-modules: IGraph.Exporter.Graphics
+
+  if flag(graphics)
+    build-depends: diagrams-lib, diagrams-svg
+
   build-depends:
       base >=4.0 && <5.0
     , bytestring >=0.9

src/IGraph.hs

@@ -48,6 +48,7 @@ data LGraph d v e = LGraph
 
 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
@@ -107,9 +108,11 @@ class MGraph d => Graph d where
 
 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)
         => (Node, Maybe [v]) -> ([Edge], Maybe [e]) -> LGraph d v e

src/IGraph/Exporter/Graphics.hs

+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GADTs #-}
+module IGraph.Exporter.Graphics
+    ( renderGraph
+    , graphToDiagram
+    ) where
+
+import Diagrams.Prelude
+import Diagrams.Backend.SVG.CmdLine
+
+import IGraph
+import IGraph.Exporter.GEXF
+
+renderGraph :: FilePath -> Double -> Double -> LGraph d NodeAttr EdgeAttr -> IO ()
+readerGraph out gr = renderSVG out (Dims w h) $ graphToDiagram gr
+
+graphToDiagram :: Graph d => LGraph d NodeAttr EdgeAttr -> Diagram B
+graphToDiagram gr = position (map drawNode (nodes gr)) <> mconcat (map drawEdge (edges gr))
+  where
+    drawNode x = ( _positionX nattr ^& _positionY nattr
+                 , circle (_size nattr) # lwO 0 # fcA (_nodeColour nattr) )
+      where
+        nattr = nodeLab gr x
+    drawEdge (from, to) =
+        fromVertices [ _positionX nattr1 ^& _positionY nattr1
+                     , _positionX nattr2 ^& _positionY nattr2 ]
+      where
+        eattr = edgeLab gr (from, to)
+        nattr1 = nodeLab gr from
+        nattr2 = nodeLab gr to
+{-# INLINE graphToDiagram #-}

src/IGraph/Generators.hs

+module IGraph.Generators
+    ( 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/Constants.chs

@@ -25,3 +25,6 @@ import Foreign
 
 {#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/Graph.chs

@@ -49,4 +49,8 @@ igraphEdge g i = alloca $ \fr -> alloca $ \to -> do
 {# 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/Isomorphism.chs

+{-# 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/Structure.chs

@@ -48,3 +48,14 @@ import Foreign.C.Types
                            , `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

+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

@@ -37,8 +37,8 @@ instance Default LayoutOpt where
 
 data LayoutMethod = KamadaKawai
 
-getLayout :: Graph d => LGraph d v e -> LayoutOpt -> [(Double, Double)]
-getLayout gr opt = unsafePerformIO $ do
+getLayout :: Graph d => LGraph d v e -> LayoutOpt -> IO [(Double, Double)]
+getLayout gr opt = do
     mptr <- mat
 
     case _method opt of

src/IGraph/Motif.hs

+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 (length xs, Nothing) (xs, Nothing)

src/IGraph/Structure.hs

@@ -4,6 +4,7 @@ module IGraph.Structure
     , betweenness
     , eigenvectorCentrality
     , pagerank
+    , personalizedPagerank
     ) where
 
 import Control.Monad
@@ -95,3 +96,20 @@ pagerank gr ws d = unsafePerformIO $ alloca $ \p -> do
     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

src/test.hs

 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE FlexibleContexts #-}
-import Foreign hiding (new)
-import Control.Monad
-import Data.Serialize
 import qualified Data.ByteString.Char8 as B
-import qualified Data.HashMap.Strict as M
 import IGraph
-import IGraph.Read
-import Text.XML.HXT.Core
-import IGraph.Export.GEXF
+import IGraph.Generators
+import IGraph.Layout
 import System.Environment
+import Data.Default
 
 main = do
---    [fl] <- getArgs
---    g <- readAdjMatrix fl :: IO (LGraph U B.ByteString Double)
-    let t = genXMLTree undefined :: IOStateArrow s XmlTree XmlTree
-    [x] <- runX $ root [] [t] >>> writeDocumentToString [withXmlPi yes, withIndent yes]
-    putStrLn x
+    gr <- erdosRenyiGame GNM 100 50 U False
+    coord <- getLayout gr def

stack.yaml

@@ -2,7 +2,7 @@ flags: {}
 packages:
 - '.'
 extra-deps: []
-resolver: lts-5.4
+resolver: lts-5.5
 
 extra-lib-dirs:
     - "/home/kai/opt/lib"