add centrality meatures

cbits/igraph.c → cbits/haskelligraph.c

+#ifndef HASKELL_IGRAPH
+#define HASKELL_IGRAPH
+
 #include <igraph/igraph.h>
 
 igraph_vector_t* igraph_vector_new(long int size)
@@ -81,3 +84,5 @@ igraph_vs_t* igraph_vs_new() {
   igraph_vs_t* vs = (igraph_vs_t*) malloc (sizeof (igraph_vs_t));
   return vs;
 }
+
+#endif

haskell-igraph.cabal

@@ -39,7 +39,6 @@ library
   build-depends:
       base >=4.0 && <5.0
     , bytestring >=0.9
-    , cereal
     , bytestring-lexing
     , primitive
 
@@ -48,4 +47,4 @@ library
   default-language:    Haskell2010
   build-tools:         c2hs >=0.25.0
   C-Sources:
-    cbits/igraph.c
+    cbits/haskelligraph.c

src/IGraph.hs

@@ -19,6 +19,9 @@ data LGraph d v e = LGraph
     { _graph :: IGraphPtr }
 
 class MGraph (Mutable gr) d => Graph gr d where
+    nVertices :: 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 (n, vattr) (es,eattr) = runST $ do
         g <- new 0
@@ -37,16 +40,24 @@ class MGraph (Mutable gr) d => Graph gr d where
 
     edgeLab :: Read e => (Int, Int) -> gr d v e -> e
 
+    edgeLabByEid :: Read e => Int -> gr d v e -> e
+
     unsafeFreeze :: 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
+
+    nEdges (LGraph g) = igraphEcount g
+
     vertexLab i (LGraph g) = read $ igraphCattributeVAS g vertexAttr i
 
     edgeLab (fr,to) (LGraph g) = read $ igraphCattributeEAS g edgeAttr $ igraphGetEid g fr to True True
 
+    edgeLabByEid i (LGraph g) = read $ igraphCattributeEAS g edgeAttr i
+
     unsafeFreeze (MLGraph g) = return $ LGraph g
 
     unsafeThaw (LGraph g) = return $ MLGraph g

src/IGraph/Community.hs

@@ -18,16 +18,16 @@ import IGraph.Internal.Community
 import IGraph.Internal.Arpack
 
 communityLeadingEigenvector :: LGraph U v e
-                            -> (LGraph U v e -> Maybe [Double])  -- ^ extract weights
+                            -> Maybe [Double]  -- ^ extract weights
                             -> Int  -- ^ number of steps
                             -> [[Int]]
-communityLeadingEigenvector g@(LGraph gr) fn step = unsafePerformIO $ do
+communityLeadingEigenvector g@(LGraph gr) ws step = unsafePerformIO $ do
     arparck <- igraphArpackNew
     vec <- igraphVectorNew 0
-    withArpackOptPtr arparck $ \ap -> withVectorPtr vec $ \vptr -> case fn g of
+    withArpackOptPtr arparck $ \ap -> withVectorPtr vec $ \vptr -> case ws of
         Just xs -> do
-            ws <- listToVector xs
-            withVectorPtr ws $ \wptr ->
+            ws' <- listToVector xs
+            withVectorPtr ws' $ \wptr ->
                 igraphCommunityLeadingEigenvector gr wptr nullPtr vptr step ap nullPtr
                                                   False nullPtr nullPtr nullPtr nullFunPtr nullPtr  
 

src/IGraph/Internal/Arpack.chs

@@ -5,8 +5,7 @@ import Control.Monad
 import Foreign
 import Foreign.C.Types
 
-#include "igraph/igraph.h"
-#include "cbits/igraph.c"
+#include "cbits/haskelligraph.c"
 
 {#pointer *igraph_arpack_options_t as ArpackOptPtr foreign finalizer igraph_arpack_destroy newtype#}
 

src/IGraph/Internal/Attribute.chs

@@ -12,8 +12,7 @@ import System.IO.Unsafe (unsafePerformIO)
 {#import IGraph.Internal.Graph #}
 {#import IGraph.Internal.Data #}
 
-#include "igraph/igraph.h"
-#include "cbits/igraph.c"
+#include "cbits/haskelligraph.c"
 
 makeAttributeRecord :: Show a => String -> [a] -> AttributeRecord
 makeAttributeRecord name xs = unsafePerformIO $ do

src/IGraph/Internal/Clique.chs

@@ -7,8 +7,7 @@ import Foreign.C.Types
 {#import IGraph.Internal.Graph #}
 {#import IGraph.Internal.Data #}
 
-#include "igraph/igraph.h"
-#include "cbits/igraph.c"
+#include "cbits/haskelligraph.c"
 
 {#fun igraph_cliques as ^ { `IGraphPtr', `VectorPPtr', `Int', `Int' } -> `Int' #}
 

src/IGraph/Internal/Community.chs

@@ -8,8 +8,7 @@ import Foreign.C.Types
 {#import IGraph.Internal.Graph #}
 {#import IGraph.Internal.Data #}
 
-#include "igraph/igraph.h"
-#include "cbits/igraph.c"
+#include "cbits/haskelligraph.c"
 
 {#fun igraph_community_leading_eigenvector as ^ { `IGraphPtr'
                                                 , id `Ptr VectorPtr'

src/IGraph/Internal/Constants.chs

@@ -3,7 +3,6 @@ module IGraph.Internal.Constants where
 
 import Foreign
 
-#include "igraph/igraph.h"
-#include "cbits/igraph.c"
+#include "cbits/haskelligraph.c"
 
-{#enum igraph_neimode_t as IGraphNeimode {underscoreToCase} deriving (Show, Eq) #}
+{#enum igraph_neimode_t as Neimode {underscoreToCase} deriving (Show, Eq) #}

src/IGraph/Internal/Data.chs

@@ -8,8 +8,7 @@ import Foreign.C.Types
 import Foreign.C.String
 import System.IO.Unsafe (unsafePerformIO)
 
-#include "igraph/igraph.h"
-#include "cbits/igraph.c"
+#include "cbits/haskelligraph.c"
 
 {#pointer *igraph_vector_t as VectorPtr foreign finalizer igraph_vector_destroy newtype#}
 

src/IGraph/Internal/Generator.chs

@@ -7,8 +7,7 @@ import Foreign.C.Types
 
 {#import IGraph.Internal.Graph #}
 
-#include "igraph/igraph.h"
-#include "cbits/igraph.c"
+#include "cbits/haskelligraph.c"
 
 -- Deterministic Graph Generators
 

src/IGraph/Internal/Graph.chs

@@ -9,8 +9,7 @@ import System.IO.Unsafe (unsafePerformIO)
 {#import IGraph.Internal.Initialization #}
 {#import IGraph.Internal.Data #}
 
-#include "igraph/igraph.h"
-#include "cbits/igraph.c"
+#include "cbits/haskelligraph.c"
 
 {#pointer *igraph_t as IGraphPtr foreign finalizer igraph_destroy newtype#}
 

src/IGraph/Internal/Initialization.chs

 {-# LANGUAGE ForeignFunctionInterface #-}
 module IGraph.Internal.Initialization where
 
-#include "igraph/igraph.h"
-#include "cbits/igraph.c"
+#include "cbits/haskelligraph.c"
 
 data HasInit
 

src/IGraph/Internal/Selector.chs

@@ -9,8 +9,7 @@ import System.IO.Unsafe (unsafePerformIO)
 {#import IGraph.Internal.Constants #}
 {#import IGraph.Internal.Data #}
 
-#include "igraph/igraph.h"
-#include "cbits/igraph.c"
+#include "cbits/haskelligraph.c"
 
 {#pointer *igraph_vs_t as IGraphVsPtr foreign finalizer igraph_vs_destroy newtype #}
 
@@ -18,6 +17,6 @@ import System.IO.Unsafe (unsafePerformIO)
 
 {#fun igraph_vs_all as ^ { `IGraphVsPtr' } -> `Int' #}
 
-{#fun igraph_vs_adj as ^ { `IGraphVsPtr', `Int', `IGraphNeimode' } -> `Int' #}
+{#fun igraph_vs_adj as ^ { `IGraphVsPtr', `Int', `Neimode' } -> `Int' #}
 
 {#fun igraph_vs_vector as ^ { `IGraphVsPtr', `VectorPtr' } -> `Int' #}

src/IGraph/Internal/Structure.chs

@@ -11,26 +11,25 @@ import Foreign.C.Types
 {#import IGraph.Internal.Arpack #}
 
 #include "igraph/igraph.h"
-#include "cbits/igraph.c"
 
 {#fun igraph_closeness as ^ { `IGraphPtr'
                             , `VectorPtr'
                             , %`IGraphVsPtr'
-                            , `IGraphNeimode'
+                            , `Neimode'
                             , `VectorPtr'
                             , `Bool' } -> `Int' #}
 
 {#fun igraph_betweenness as ^ { `IGraphPtr'
-                              , id `Ptr VectorPtr'
+                              , `VectorPtr'
                               , %`IGraphVsPtr'
                               , `Bool' 
-                              , id `Ptr VectorPtr'
+                              , `VectorPtr'
                               , `Bool' } -> `Int' #}
 
 {#fun igraph_eigenvector_centrality as ^ { `IGraphPtr'
-                                         , id `Ptr VectorPtr'
+                                         , `VectorPtr'
                                          , id `Ptr CDouble'
                                          , `Bool'
                                          , `Bool'
-                                         , id `Ptr VectorPtr'
+                                         , `VectorPtr'
                                          , `ArpackOptPtr' } -> `Int' #}

src/IGraph/Read.hs

@@ -10,7 +10,7 @@ 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
+        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
@@ -19,3 +19,17 @@ readAdjMatrix fl = do
        else return $ mkGraph (nrow, Just $ B.words header) (es, Nothing)
   where
     f ((i,j),v) = i /= j && v /= 0
+
+readAdjMatrixWeighted :: Graph gr d => FilePath -> IO (gr d B.ByteString Double)
+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
+        nrow = length mat
+        ncol = length $ head mat
+    if nrow /= ncol
+       then error "nrow != ncol"
+       else return $ mkGraph (nrow, Just $ B.words header) (es, Just ws)
+  where
+    f ((i,j),v) = i /= j && v /= 0

src/IGraph/Structure.hs

@@ -15,10 +15,11 @@ import IGraph.Internal.Structure
 import IGraph.Internal.Arpack
 import IGraph.Internal.Constants
 
+-- | closeness centrality
 closeness :: [Int]  -- ^ vertices
           -> LGraph d v e
           -> Maybe [Double]  -- ^ optional edge weights
-          -> IGraphNeimode
+          -> Neimode
           -> Bool   -- ^ whether to normalize
           -> [Double]
 closeness vs (LGraph g) ws mode normal = unsafePerformIO $ do
@@ -31,3 +32,32 @@ closeness vs (LGraph g) ws mode normal = unsafePerformIO $ do
         _ -> liftM VectorPtr $ newForeignPtr_ $ castPtr nullPtr
     igraphCloseness g vptr vsptr mode ws' normal
     vectorPtrToList vptr
+
+-- | betweenness centrality
+betweenness :: [Int]
+            -> LGraph d v e
+            -> Maybe [Double]
+            -> [Double]
+betweenness vs (LGraph g) ws = unsafePerformIO $ do
+    vsptr <- igraphVsNew
+    vs' <- listToVector $ map fromIntegral vs
+    igraphVsVector vsptr vs'
+    vptr <- igraphVectorNew 0
+    ws' <- case ws of
+        Just w -> listToVector w
+        _ -> liftM VectorPtr $ newForeignPtr_ $ castPtr nullPtr
+    igraphBetweenness g vptr vsptr True ws' False
+    vectorPtrToList vptr
+
+-- | eigenvector centrality
+eigenvectorCentrality :: LGraph d v e
+                      -> Maybe [Double]
+                      -> [Double]
+eigenvectorCentrality (LGraph g) 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
+    vectorPtrToList vptr

test.hs

@@ -7,17 +7,17 @@ import IGraph.Mutable
 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 IGraph.Structure
+import IGraph.Internal.Constants
 
 import System.Environment
 
 main = do
     [fl] <- getArgs
-    g <- readAdjMatrix fl :: IO (LGraph U B.ByteString ())
+    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 (const Nothing) 1000
+    print $ (map.map) (flip vertexLab g) $ communityLeadingEigenvector g (Just ws) 1000
+    print $ closeness [1,2] g Nothing IgraphAll True