add label-id map

cbits/haskelligraph.c

@@ -17,20 +17,6 @@ char** igraph_strvector_get_(igraph_strvector_t* s, long int i)
   return x;
 }
 
-igraph_matrix_t* igraph_matrix_new(long int nrow, long int ncol)
-{
-  igraph_matrix_t* matrix = (igraph_matrix_t*) malloc (sizeof (igraph_matrix_t));
-  igraph_matrix_init(matrix, nrow, ncol);
-  return matrix;
-}
-
-igraph_t* igraph_new(igraph_integer_t n, igraph_bool_t directed)
-{
-  igraph_t* graph = (igraph_t*) malloc (sizeof (igraph_t));
-  igraph_empty(graph, n, directed);
-  return graph;
-}
-
 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)
 {
@@ -39,36 +25,11 @@ igraph_integer_t igraph_get_eid_(igraph_t* graph, igraph_integer_t pfrom, igraph
   return eid;
 }
 
-igraph_t* igraph_full_(igraph_integer_t n, igraph_bool_t directed, igraph_bool_t loops)
-{
-  igraph_t* graph = (igraph_t*) malloc (sizeof (igraph_t));
-  igraph_full(graph, n, directed, loops);
-  return graph;
-}
-
 void haskelligraph_init()
 {
   /* attach attribute table */
   igraph_i_set_attribute_table(&igraph_cattribute_table);
 }
 
-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;
-}
-
-igraph_vs_t* igraph_vs_new() {
-  igraph_vs_t* vs = (igraph_vs_t*) malloc (sizeof (igraph_vs_t));
-  return vs;
-}
 
 #endif

haskell-igraph.cabal

@@ -13,7 +13,7 @@ maintainer:          kai@kzhang.org
 category:            Math
 build-type:          Simple
 extra-source-files:  cbits
-cabal-version:       >=1.10
+cabal-version:       >=1.22
 
 library
   exposed-modules:     
@@ -25,7 +25,6 @@ library
     IGraph.Internal.Attribute
     IGraph.Internal.Selector
     IGraph.Internal.Structure
-    IGraph.Internal.Generator
     IGraph.Internal.Clique
     IGraph.Internal.Community
     IGraph
@@ -41,6 +40,8 @@ library
     , bytestring >=0.9
     , bytestring-lexing
     , primitive
+    , unordered-containers
+    , hashable
 
   extra-libraries:     igraph
   hs-source-dirs:      src

src/IGraph.hs

@@ -5,28 +5,34 @@ module IGraph where
 
 import Control.Monad.ST (runST)
 import Control.Monad.Primitive
+import qualified Data.HashMap.Strict as M
+import Data.Hashable (Hashable)
 import Data.Maybe
+import System.IO.Unsafe (unsafePerformIO)
 
 import IGraph.Mutable
 import IGraph.Internal.Graph
+import IGraph.Internal.Constants
 import IGraph.Internal.Attribute
+import IGraph.Internal.Selector
 
 type family Mutable (gr :: * -> * -> * -> *) :: * -> * -> * -> * -> *
 type instance Mutable LGraph = MLGraph
 
 -- | graph with labeled nodes and edges
 data LGraph d v e = LGraph
-    { _graph :: IGraphPtr }
+    { _graph :: IGraphPtr
+    , _nodeLabelToId :: M.HashMap v [Int] }
 
 class MGraph (Mutable gr) d => Graph gr d where
-    nVertices :: gr d v e -> Int
+    nNodes :: gr d v e -> Int
     nEdges :: gr d v e -> Int
 
-    mkGraph :: (Show v, Show e) => (Int, Maybe [v]) -> ([(Int, Int)], Maybe [e]) -> gr d v e
+    mkGraph :: (Hashable v, Read v, Eq v, Show v, Show e) => (Int, Maybe [v]) -> ([(Int, Int)], Maybe [e]) -> gr d v e
     mkGraph (n, vattr) (es,eattr) = runST $ do
         g <- new 0
-        let addV | isNothing vattr = addVertices n g
-                 | otherwise = addLVertices n (fromJust vattr) g
+        let addV | isNothing vattr = addNodes n g
+                 | otherwise = addLNodes n (fromJust vattr) g
             addE | isNothing eattr = addEdges es g
                  | otherwise = addLEdges (zip' es (fromJust eattr)) g
         addV
@@ -36,28 +42,51 @@ class MGraph (Mutable gr) d => Graph gr d where
         zip' a b | length a /= length b = error "incorrect length"
                  | otherwise = zipWith (\(x,y) z -> (x,y,z)) a b
 
-    vertexLab :: Read v => Int -> gr d v e -> v
+    nodeLab :: Read v => gr d v e -> Int -> v
 
-    edgeLab :: Read e => (Int, Int) -> gr d v e -> e
+    edgeLab :: Read e => gr d v e -> (Int, Int) -> e
 
-    edgeLabByEid :: Read e => Int -> gr d v e -> e
+    edgeLabByEid :: Read e => gr d v e -> Int -> e
 
-    unsafeFreeze :: PrimMonad m => Mutable gr (PrimState m) d v e -> m (gr d v e)
+    unsafeFreeze :: (Hashable v, Eq v, Read v, PrimMonad m) => Mutable gr (PrimState m) d v e -> m (gr d v e)
 
     unsafeThaw :: PrimMonad m => gr d v e -> m (Mutable gr (PrimState m) d v e)
 
 
 instance Graph LGraph U where
-    nVertices (LGraph g) = igraphVcount g
+    nNodes (LGraph g _) = igraphVcount g
 
-    nEdges (LGraph g) = igraphEcount g
+    nEdges (LGraph g _) = igraphEcount g
 
-    vertexLab i (LGraph g) = read $ igraphCattributeVAS g vertexAttr i
+    nodeLab (LGraph g _) i = read $ igraphCattributeVAS g vertexAttr i
 
-    edgeLab (fr,to) (LGraph g) = read $ igraphCattributeEAS g edgeAttr $ igraphGetEid g fr to True True
+    edgeLab (LGraph g _) (fr,to) = read $ igraphCattributeEAS g edgeAttr $ igraphGetEid g fr to True True
 
-    edgeLabByEid i (LGraph g) = read $ igraphCattributeEAS g edgeAttr i
+    edgeLabByEid (LGraph g _) i = read $ igraphCattributeEAS g edgeAttr i
 
-    unsafeFreeze (MLGraph g) = return $ LGraph g
+    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]
+
+    unsafeThaw (LGraph g _) = return $ MLGraph g
+
+
+neighbors :: LGraph d v e -> Int -> [Int]
+neighbors gr i = unsafePerformIO $ do
+    vs <- igraphVsNew
+    igraphVsAdj vs i IgraphAll
+    vit <- igraphVitNew (_graph gr) vs
+    loop vit
+  where
+    loop x = do
+        isEnd <- igraphVitEnd x
+        if isEnd
+           then return []
+           else do
+               cur <- igraphVitGet x
+               igraphVitNext x
+               acc <- loop x
+               return $ cur : acc
 
-    unsafeThaw (LGraph g) = return $ MLGraph g

src/IGraph/Clique.hs

@@ -14,16 +14,16 @@ cliques :: (Int, Int)  -- ^ Minimum and maximum size of the cliques to be return
                        -- No bound will be used if negative or zero
         -> LGraph d v e
         -> [[Int]]     -- ^ cliques represented by node ids
-cliques (lo, hi) (LGraph g) = unsafePerformIO $ do
+cliques (lo, hi) gr = unsafePerformIO $ do
     vpptr <- igraphVectorPtrNew 0
-    _ <- igraphCliques g vpptr lo hi
+    _ <- igraphCliques (_graph gr) vpptr lo hi
     (map.map) truncate <$> vectorPPtrToList vpptr
 
 maximalCliques :: (Int, Int)  -- ^ Minimum and maximum size of the cliques to be returned.
                               -- No bound will be used if negative or zero
                -> LGraph d v e
                -> [[Int]]     -- ^ cliques represented by node ids
-maximalCliques (lo, hi) (LGraph g) = unsafePerformIO $ do
+maximalCliques (lo, hi) gr = unsafePerformIO $ do
     vpptr <- igraphVectorPtrNew 0
-    _ <- igraphMaximalCliques g vpptr lo hi
+    _ <- igraphMaximalCliques (_graph gr) vpptr lo hi
     (map.map) truncate <$> vectorPPtrToList vpptr

src/IGraph/Community.hs

@@ -21,13 +21,13 @@ communityLeadingEigenvector :: LGraph U v e
                             -> Maybe [Double]  -- ^ extract weights
                             -> Int  -- ^ number of steps
                             -> [[Int]]
-communityLeadingEigenvector g@(LGraph gr) ws step = unsafePerformIO $ do
+communityLeadingEigenvector gr ws step = unsafePerformIO $ do
     ap <- igraphArpackNew
     vptr <- igraphVectorNew 0
     wptr <- case ws of
         Just w -> listToVector w
         _ -> liftM VectorPtr $ newForeignPtr_ $ castPtr nullPtr
-    igraphCommunityLeadingEigenvector gr wptr nullPtr vptr step ap nullPtr
+    igraphCommunityLeadingEigenvector (_graph gr) wptr nullPtr vptr step ap nullPtr
                                       False nullPtr nullPtr nullPtr nullFunPtr nullPtr  
     xs <- vectorPtrToList vptr
     return $ map f $ groupBy ((==) `on` snd) $ sortBy (comparing snd) $ zip [0..] xs

src/IGraph/Internal/Arpack.chs

@@ -9,4 +9,20 @@ import Foreign.C.Types
 
 {#pointer *igraph_arpack_options_t as ArpackOptPtr foreign finalizer igraph_arpack_destroy newtype#}
 
+#c
+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;
+}
+#endc
+
 {#fun igraph_arpack_new as ^ { } -> `ArpackOptPtr' #}

src/IGraph/Internal/Data.chs

@@ -107,7 +107,7 @@ listToStrVector xs = do
 
 {#pointer *igraph_matrix_t as MatrixPtr foreign finalizer igraph_matrix_destroy newtype#}
 
-{#fun igraph_matrix_new as ^ { `Int', `Int' } -> `MatrixPtr' #}
+{#fun igraph_matrix_init as igraphMatrixNew { +, `Int', `Int' } -> `MatrixPtr' #}
 
 {#fun igraph_matrix_null as ^ { `MatrixPtr' } -> `()' #}
 

src/IGraph/Internal/Generator.chs

-{-# LANGUAGE ForeignFunctionInterface #-}
-module IGraph.Internal.Generator where
-
-import Control.Monad
-import Foreign
-import Foreign.C.Types
-
-{#import IGraph.Internal.Graph #}
-
-#include "cbits/haskelligraph.c"
-
--- Deterministic Graph Generators
-
-{#fun igraph_full_ as igraphFull { `Int', `Bool', `Bool' } -> `IGraphPtr' #}

src/IGraph/Internal/Graph.chs

@@ -19,7 +19,7 @@ igraphNew n directed _ = igraphNew' n directed
 
 -- Graph Constructors and Destructors
 
-{#fun igraph_new as igraphNew' { `Int', `Bool' } -> `IGraphPtr' #}
+{#fun igraph_empty as igraphNew' { +, `Int', `Bool' } -> `IGraphPtr' #}
 
 -- Basic Query Operations
 
@@ -36,3 +36,6 @@ igraphNew n directed _ = igraphNew' n directed
 {# fun igraph_add_edge as ^ { `IGraphPtr', `Int', `Int' } -> `()' #}
 
 {# fun igraph_add_edges as ^ { `IGraphPtr', `VectorPtr', id `Ptr ()' } -> `()' #}
+
+
+{#fun igraph_full as ^ { +, `Int', `Bool', `Bool' } -> `IGraphPtr' #}

src/IGraph/Internal/Selector.chs

@@ -7,12 +7,20 @@ import Foreign.C.Types
 import System.IO.Unsafe (unsafePerformIO)
 
 {#import IGraph.Internal.Constants #}
+{#import IGraph.Internal.Graph #}
 {#import IGraph.Internal.Data #}
 
-#include "cbits/haskelligraph.c"
+#include "igraph/igraph.h"
 
 {#pointer *igraph_vs_t as IGraphVsPtr foreign finalizer igraph_vs_destroy newtype #}
 
+#c
+igraph_vs_t* igraph_vs_new() {
+  igraph_vs_t* vs = (igraph_vs_t*) malloc (sizeof (igraph_vs_t));
+  return vs;
+}
+#endc
+
 {#fun igraph_vs_new as ^ { } -> `IGraphVsPtr' #}
 
 {#fun igraph_vs_all as ^ { `IGraphVsPtr' } -> `Int' #}
@@ -20,3 +28,36 @@ import System.IO.Unsafe (unsafePerformIO)
 {#fun igraph_vs_adj as ^ { `IGraphVsPtr', `Int', `Neimode' } -> `Int' #}
 
 {#fun igraph_vs_vector as ^ { `IGraphVsPtr', `VectorPtr' } -> `Int' #}
+
+
+-- 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' #}

src/IGraph/Mutable.hs

@@ -21,9 +21,9 @@ type LEdge a = (Int, Int, a)
 class MGraph gr d where
     new :: PrimMonad m => Int -> m (gr (PrimState m) d v e)
 
-    addVertices :: PrimMonad m => Int -> gr (PrimState m) d v e -> m ()
+    addNodes :: PrimMonad m => Int -> gr (PrimState m) d v e -> m ()
 
-    addLVertices :: (Show v, PrimMonad m)
+    addLNodes :: (Show v, PrimMonad m)
                  => Int  -- ^ the number of new vertices add to the graph
                  -> [v]  -- ^ vertices' labels
                  -> gr (PrimState m) d v e -> m ()
@@ -41,9 +41,9 @@ data D
 instance MGraph MLGraph U where
     new n = unsafePrimToPrim $ igraphInit >>= igraphNew n False >>= return . MLGraph
 
-    addVertices n (MLGraph g) = unsafePrimToPrim $ igraphAddVertices g n nullPtr
+    addNodes n (MLGraph g) = unsafePrimToPrim $ igraphAddVertices g n nullPtr
 
-    addLVertices n labels (MLGraph g)
+    addLNodes n labels (MLGraph g)
         | n /= length labels = error "addLVertices: incorrect number of labels"
         | otherwise = unsafePrimToPrim $ do
             let attr = makeAttributeRecord vertexAttr labels

src/IGraph/Read.hs

@@ -11,7 +11,7 @@ readAdjMatrix fl = do
     c <- B.readFile fl
     let (header:xs) = B.lines c
         mat = map (map (fst . fromJust . readDouble) . B.words) xs
-        es = fst $ unzip $ filter f $ zip [ (i,j) | i <- [0..nrow-1], j <- [0..nrow-1] ] $ concat mat
+        es = fst $ unzip $ filter f $ zip [ (i,j) | i <- [0..nrow-1], j <- [i..nrow-1] ] $ concat mat
         nrow = length mat
         ncol = length $ head mat
     if nrow /= ncol
@@ -25,7 +25,7 @@ readAdjMatrixWeighted fl = do
     c <- B.readFile fl
     let (header:xs) = B.lines c
         mat = map (map (fst . fromJust . readDouble) . B.words) xs
-        (es, ws) = unzip $ filter f $ zip [ (i,j) | i <- [0..nrow-1], j <- [0..nrow-1] ] $ concat mat
+        (es, ws) = unzip $ filter f $ zip [ (i,j) | i <- [0..nrow-1], j <- [i..nrow-1] ] $ concat mat
         nrow = length mat
         ncol = length $ head mat
     if nrow /= ncol

src/IGraph/Structure.hs

@@ -22,7 +22,7 @@ closeness :: [Int]  -- ^ vertices
           -> Neimode
           -> Bool   -- ^ whether to normalize
           -> [Double]
-closeness vs (LGraph g) ws mode normal = unsafePerformIO $ do
+closeness vs gr ws mode normal = unsafePerformIO $ do
     vsptr <- igraphVsNew
     vs' <- listToVector $ map fromIntegral vs
     igraphVsVector vsptr vs'
@@ -30,7 +30,7 @@ closeness vs (LGraph g) ws mode normal = unsafePerformIO $ do
     ws' <- case ws of
         Just w -> listToVector w
         _ -> liftM VectorPtr $ newForeignPtr_ $ castPtr nullPtr
-    igraphCloseness g vptr vsptr mode ws' normal
+    igraphCloseness (_graph gr) vptr vsptr mode ws' normal
     vectorPtrToList vptr
 
 -- | betweenness centrality
@@ -38,7 +38,7 @@ betweenness :: [Int]
             -> LGraph d v e
             -> Maybe [Double]
             -> [Double]
-betweenness vs (LGraph g) ws = unsafePerformIO $ do
+betweenness vs gr ws = unsafePerformIO $ do
     vsptr <- igraphVsNew
     vs' <- listToVector $ map fromIntegral vs
     igraphVsVector vsptr vs'
@@ -46,18 +46,18 @@ betweenness vs (LGraph g) ws = unsafePerformIO $ do
     ws' <- case ws of
         Just w -> listToVector w
         _ -> liftM VectorPtr $ newForeignPtr_ $ castPtr nullPtr
-    igraphBetweenness g vptr vsptr True ws' False
+    igraphBetweenness (_graph gr) vptr vsptr True ws' False
     vectorPtrToList vptr
 
 -- | eigenvector centrality
 eigenvectorCentrality :: LGraph d v e
                       -> Maybe [Double]
                       -> [Double]
-eigenvectorCentrality (LGraph g) ws = unsafePerformIO $ do
+eigenvectorCentrality gr ws = unsafePerformIO $ do
     vptr <- igraphVectorNew 0
     ws' <- case ws of
         Just w -> listToVector w
         _ -> liftM VectorPtr $ newForeignPtr_ $ castPtr nullPtr
     arparck <- igraphArpackNew
-    igraphEigenvectorCentrality g vptr nullPtr True True ws' arparck
+    igraphEigenvectorCentrality (_graph gr) vptr nullPtr True True ws' arparck
     vectorPtrToList vptr

test.hs

+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE FlexibleContexts #-}
 import Foreign hiding (new)
 import Control.Monad
 import Data.Serialize
-import qualified Data.ByteString.Internal as B
+import qualified Data.ByteString.Char8 as B
+import qualified Data.HashMap.Strict as M
 import IGraph
 import IGraph.Mutable
 import IGraph.Read
@@ -15,9 +18,15 @@ import System.Environment
 
 main = do
     [fl] <- getArgs
-    g <- readAdjMatrixWeighted fl :: IO (LGraph U B.ByteString Double)
-    let ws = map (abs . flip edgeLabByEid g) [0 .. nEdges g - 1]
-    print $ (map.map) (flip vertexLab g) $ maximalCliques (0,0) g
-    print $ (map.map) (flip vertexLab g) $ communityLeadingEigenvector g (Just ws) 1000
-    print $ closeness [1,2] g Nothing IgraphAll True
-
+    g <- readAdjMatrix fl :: IO (LGraph U B.ByteString ())
+    let n = nNodes g
+        r = map (f g) [0..n-1]
+    mapM_ h r
+  where
+    f g i = let name = nodeLab g i
+                xs = map (nodeLab g) $ neighbors g i
+            in (name, B.intercalate "," xs)
+    h (a,b) = do
+        B.putStr a
+        B.putStr "\t"
+        B.putStrLn b