save current work

cbits/igraph.c

@@ -42,6 +42,14 @@ igraph_t* igraph_new(igraph_integer_t n, igraph_bool_t 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)
+{
+  igraph_integer_t eid;
+  igraph_get_eid(graph, &eid, pfrom, pto, directed, error);
+  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));
@@ -54,3 +62,17 @@ 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;
+}

haskell-igraph.cabal

@@ -17,22 +17,29 @@ cabal-version:       >=1.10
 
 library
   exposed-modules:     
-    IGraph
+    IGraph.Internal.Arpack
     IGraph.Internal.Initialization
     IGraph.Internal.Data
     IGraph.Internal.Graph
     IGraph.Internal.Attribute
     IGraph.Internal.Generator
+    IGraph.Internal.Clique
+    IGraph.Internal.Community
+    IGraph
+    IGraph.Clique
+    IGraph.Community
+    IGraph.Read
   -- other-modules:       
   -- other-extensions:    
   build-depends:
       base >=4.0 && <5.0
     , bytestring >=0.9
     , cereal
+    , bytestring-lexing
 
   extra-libraries:     igraph
   hs-source-dirs:      src
   default-language:    Haskell2010
-  build-tools:         c2hs
+  build-tools:         c2hs >=0.25.0
   C-Sources:
     cbits/igraph.c

src/IGraph.hs

 {-# LANGUAGE MultiParamTypeClasses #-}
 module IGraph where
 
-import qualified Data.ByteString.Char8 as B
 import Foreign hiding (new)
+import Data.Maybe
 
 import IGraph.Internal.Graph
 import IGraph.Internal.Initialization
@@ -10,9 +10,18 @@ import IGraph.Internal.Data
 import IGraph.Internal.Attribute
 import System.IO.Unsafe (unsafePerformIO)
 
+-- constants
+vertexAttr :: String
+vertexAttr = "vertex_attribute"
+
+edgeAttr :: String
+edgeAttr = "edge_attribute"
+
 data U
 data D
 
+type LEdge a = (Int, Int, a)
+
 -- | graph with labeled nodes and edges
 data LGraph d v e = LGraph
     { _graph :: IGraphPtr }
@@ -23,24 +32,67 @@ class Graph gr d where
 
     new :: Int -> gr d v e
 
-    addEdge :: (Int, Int) -> gr d v e -> IO ()
+    mkGraph :: (Show v, Show e) => (Int, Maybe [v]) -> ([(Int, Int)], Maybe [e]) -> gr d v e
+    mkGraph (n, vattr) (es,eattr) = unsafePerformIO $ do
+        let g = empty
+            addV | isNothing vattr = addVertices n g
+                 | otherwise = addLVertices n (fromJust vattr) g
+            addE | isNothing eattr = addEdges es g
+                 | otherwise = addLEdges (zip' es (fromJust eattr)) g
+        addV
+        addE
+        return g
+      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
+
+    edgeLab :: Read e => (Int, Int) -> gr d v e -> e
+
+    addVertices :: Int -> gr d v e -> IO ()
 
-    addLEdges :: Show e => String -> [(Int, Int, e)] -> gr d v e -> IO ()
+    addLVertices :: Show v
+                 => Int  -- ^ the number of new vertices add to the graph
+                 -> [v]  -- ^ vertices' labels
+                 -> gr d v e -> IO ()
+
+    addEdges :: [(Int, Int)] -> gr d v e -> IO ()
+
+    addLEdges :: Show e => [LEdge e] -> gr d v e -> IO ()
 
 
 instance Graph LGraph U where
     new n = unsafePerformIO $ igraphInit >>= igraphNew n False >>= return . LGraph
 
-    addEdge (fr,to) (LGraph g) = igraphAddEdge g fr to
+    vertexLab i (LGraph g) = read $ igraphCattributeVAS g vertexAttr i
+
+    edgeLab (fr,to) (LGraph g) = read $ igraphCattributeEAS g edgeAttr $ igraphGetEid g fr to True True
+
+    addVertices n (LGraph g) = igraphAddVertices g n nullPtr
+
+    addLVertices n labels (LGraph g)
+        | n /= length labels = error "addLVertices: incorrect number of labels"
+        | otherwise = do
+            let attr = makeAttributeRecord vertexAttr labels
+            alloca $ \ptr -> do
+                poke ptr attr
+                vptr <- listToVectorP [castPtr ptr]
+                igraphAddVertices g n (castPtr vptr)
+
+    addEdges es (LGraph g) = do
+        vec <- listToVector xs
+        igraphAddEdges g vec nullPtr
+      where
+        xs = concatMap ( \(a,b) -> [fromIntegral a, fromIntegral b] ) es
 
-    addLEdges name es (LGraph g) = do
+    addLEdges es (LGraph g) = do
         vec <- listToVector $ concat xs
-        let attr = makeAttributeRecord name vs
+        let attr = makeAttributeRecord edgeAttr vs
         alloca $ \ptr -> do
             poke ptr attr
             vptr <- listToVectorP [castPtr ptr]
             igraphAddEdges g vec (castPtr vptr)
-        return ()
       where
         (xs, vs) = unzip $ map ( \(a,b,v) -> ([fromIntegral a, fromIntegral b], v) ) es
 

src/IGraph/Clique.hs

+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 :: (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
+cliques (lo, hi) (LGraph g) = unsafePerformIO $ allocaVectorP $ \vpptr -> do
+    _ <- igraphCliques g 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 $ allocaVectorP $ \vpptr -> do
+    _ <- igraphMaximalCliques g vpptr lo hi
+    (map.map) truncate <$> vectorPPtrToList vpptr

src/IGraph/Community.hs

+module IGraph.Community
+    ( communityLeadingEigenvector
+    ) 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 IGraph
+import IGraph.Internal.Data
+import IGraph.Internal.Community
+import IGraph.Internal.Arpack
+
+communityLeadingEigenvector :: LGraph d v e
+                            -> (LGraph d v e -> Maybe [Double])  -- ^ extract weights
+                            -> Int  -- ^ number of steps
+                            -> [[Int]]
+communityLeadingEigenvector g@(LGraph gr) fn step = unsafePerformIO $ do
+    arparck <- igraphArpackNew
+    vec <- igraphVectorNew 0
+    withArpackOptPtr arparck $ \ap -> withVectorPtr vec $ \vptr -> case fn g of
+        Just xs -> do
+            ws <- listToVector xs
+            withVectorPtr ws $ \wptr ->
+                igraphCommunityLeadingEigenvector gr wptr nullPtr vptr step ap nullPtr
+                                                  False nullPtr nullPtr nullPtr nullFunPtr nullPtr  
+
+        _ -> igraphCommunityLeadingEigenvector gr nullPtr nullPtr vptr step ap nullPtr
+                                                  False nullPtr nullPtr nullPtr nullFunPtr nullPtr  
+    xs <- vectorPtrToList vec
+    return $ map f $ groupBy ((==) `on` snd) $ sortBy (comparing snd) $ zip [0..] xs
+  where
+    f = fst . unzip

src/IGraph/Internal/Arpack.chs

+{-# LANGUAGE ForeignFunctionInterface #-}
+module IGraph.Internal.Arpack where
+
+import Control.Monad
+import Foreign
+import Foreign.C.Types
+
+#include "igraph/igraph.h"
+#include "cbits/igraph.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

@@ -42,10 +42,10 @@ instance Storable AttributeRecord where
 
 {#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 c_test as ^ {} -> `Ptr AttributeRecord' castPtr #}

src/IGraph/Internal/Clique.chs

+{-# LANGUAGE ForeignFunctionInterface #-}
+module IGraph.Internal.Clique where
+
+import Foreign
+import Foreign.C.Types
+
+{#import IGraph.Internal.Graph #}
+{#import IGraph.Internal.Data #}
+
+#include "igraph/igraph.h"
+#include "cbits/igraph.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

+{-# 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 #}
+
+#include "igraph/igraph.h"
+#include "cbits/igraph.c"
+
+{#fun igraph_community_leading_eigenvector as ^ { `IGraphPtr'
+                                                , id `Ptr VectorPtr'
+                                                , id `Ptr MatrixPtr'
+                                                , id `Ptr VectorPtr'
+                                                , `Int'
+                                                , id `Ptr ArpackOptPtr'
+                                                , id `Ptr CDouble'
+                                                , `Bool'
+                                                , id `Ptr VectorPtr'
+                                                , `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/Data.chs

 {-# LANGUAGE ForeignFunctionInterface #-}
 module IGraph.Internal.Data where
 
+import Control.Monad
 import qualified Data.ByteString.Char8 as B
-import Control.Monad (forM_)
 import Foreign
 import Foreign.C.Types
 import Foreign.C.String
@@ -11,15 +11,12 @@ import System.IO.Unsafe (unsafePerformIO)
 #include "igraph/igraph.h"
 #include "cbits/igraph.c"
 
-data Vector
-{#pointer *igraph_vector_t as VectorPtr -> Vector #}
+{#pointer *igraph_vector_t as VectorPtr foreign finalizer igraph_vector_destroy newtype#}
 
 -- Construtors and destructors
 
 {#fun igraph_vector_new as ^ { `Int' } -> `VectorPtr' #}
 
-{#fun igraph_vector_destroy as ^ { `VectorPtr' } -> `()' #}
-
 listToVector :: [Double] -> IO VectorPtr
 listToVector xs = do
     vec <- igraphVectorNew n
@@ -28,6 +25,12 @@ listToVector xs = do
   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
 
@@ -45,6 +48,14 @@ listToVector xs = do
 {#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' #}
+
+
 data VectorP
 {#pointer *igraph_vector_ptr_t as VectorPPtr -> VectorP #}
 
@@ -53,7 +64,9 @@ data VectorP
 {#fun igraph_vector_ptr_destroy as ^ { `VectorPPtr' } -> `()' #}
 {#fun igraph_vector_ptr_destroy_all as ^ { `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
@@ -63,6 +76,21 @@ listToVectorP xs = do
   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
+
+allocaVectorP :: (VectorPPtr -> IO b) -> IO b
+allocaVectorP fn = do
+    vptr <- igraphVectorPtrNew 0
+    r <- fn vptr
+    igraphVectorPtrDestroyAll vptr
+    return r
+
 data StrVector
 {#pointer *igraph_strvector_t as StrVectorPtr -> StrVector #}
 
@@ -89,13 +117,10 @@ listToStrVector xs = do
     n = length xs
 
 
-data Matrix
-{#pointer *igraph_matrix_t as MatrixPtr -> Matrix #}
+{#pointer *igraph_matrix_t as MatrixPtr foreign finalizer igraph_matrix_destroy newtype#}
 
 {#fun igraph_matrix_new as ^ { `Int', `Int' } -> `MatrixPtr' #}
 
-{#fun igraph_matrix_destroy as ^ { `MatrixPtr' } -> `()' #}
-
 {#fun igraph_matrix_null as ^ { `MatrixPtr' } -> `()' #}
 
 {#fun igraph_matrix_fill as ^ { `MatrixPtr', `Double' } -> `()' #}

src/IGraph/Internal/Generator.chs

 {-# LANGUAGE ForeignFunctionInterface #-}
 module IGraph.Internal.Generator where
 
+import Control.Monad
 import Foreign
 import Foreign.C.Types
 

src/IGraph/Internal/Graph.chs

 {-# 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.Initialization #}
+{#import IGraph.Internal.Data #}
 
 #include "igraph/igraph.h"
 #include "cbits/igraph.c"
 
-data IGraph
-{#pointer *igraph_t as IGraphPtr -> IGraph #}
-
--- Graph Constructors and Destructors
+{#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
 
-{#fun igraph_new as igraphNew' { `Int', `Bool' } -> `IGraphPtr' #}
+-- Graph Constructors and Destructors
 
-{#fun igraph_destroy as ^ { `IGraphPtr' } -> `()' #}
+{#fun igraph_new as igraphNew' { `Int', `Bool' } -> `IGraphPtr' #}
 
 -- Basic Query Operations
 
@@ -28,8 +28,12 @@ igraphNew n directed _ = igraphNew' n directed
 
 {#fun pure igraph_ecount as ^ { `IGraphPtr' } -> `Int' #}
 
+{#fun pure igraph_get_eid_ as igraphGetEid { `IGraphPtr', `Int', `Int', `Bool', `Bool' } -> `Int' #}
+
 -- 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 ()' } -> `()' #}

src/IGraph/Read.hs

+module IGraph.Read where
+
+import qualified Data.ByteString.Char8 as B
+import Data.ByteString.Lex.Double (readDouble)
+import Data.Maybe
+
+import IGraph
+
+readAdjMatrix :: Graph gr d => FilePath -> IO (gr d B.ByteString ())
+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
+        nrow = length mat
+        ncol = length $ head mat
+    if nrow /= ncol
+       then error "nrow != ncol"
+       else return $ mkGraph (nrow, Just $ B.words header) (es, Nothing)
+  where
+    f ((i,j),v) = i /= j && v /= 0

test.hs

@@ -3,14 +3,20 @@ import Control.Monad
 import Data.Serialize
 import qualified Data.ByteString.Internal as B
 import IGraph
+import IGraph.Read
+import IGraph.Clique
+import IGraph.Community
 import IGraph.Internal.Graph
 import IGraph.Internal.Generator
 import IGraph.Internal.Attribute
 import IGraph.Internal.Initialization
 import Foreign.Ptr
 
+import System.Environment
+
 main = do
-    let g = new 5 :: LGraph U String Double
-    addLEdges "weight" [(1,2,1.1234),(3,4,pi)] g
-    let s = igraphCattributeEAS (_graph g) "weight" 1
-    print $ (read s :: Double)
+    [fl] <- getArgs
+    g <- readAdjMatrix fl :: IO (LGraph U B.ByteString ())
+    print $ (map.map) (flip vertexLab g) $ maximalCliques (0,0) g
+    print $ (map.map) (flip vertexLab g) $ communityLeadingEigenvector g (const Nothing) 1000
+