Merge pull request #4 from jmazon/master

Implemented some more functions

src/IGraph/Algorithms/Centrality.chs

@@ -4,6 +4,8 @@ module IGraph.Algorithms.Centrality
     , betweenness
     , eigenvectorCentrality
     , pagerank
+    , hubScore
+    , authorityScore
     ) where
 
 import           Control.Monad
@@ -17,6 +19,7 @@ import Foreign
 import Foreign.C.Types
 
 import           IGraph
+import IGraph.Internal.C2HS
 {#import IGraph.Internal #}
 {#import IGraph.Internal.Constants #}
 
@@ -141,3 +144,43 @@ pagerank gr d getNodeW getEdgeW
     , castPtr `Ptr Vector'
     , id `Ptr ()'
     } -> `CInt' void- #}
+
+-- | Kleinberg's hub scores.
+hubScore :: Graph d v e
+         -> Bool -- ^ scale result such that \(\left|max\ centrality\right|=1\)
+         -> ([Double],Double) -- ^ (eigenvector,eigenvalue)
+hubScore graph scale = unsafePerformIO $
+  allocaVector $ \vector ->
+  alloca $ \value ->
+  allocaArpackOpt $ \options -> do
+    igraphHubScore (_graph graph) vector value scale nullPtr options
+    liftM2 (,) (toList vector) (peekFloatConv value)
+{-# INLINE igraphHubScore #-}
+{#fun igraph_hub_score as ^
+    { `IGraph'
+    , castPtr `Ptr Vector'
+    , castPtr `Ptr CDouble'
+    , `Bool'
+    , castPtr `Ptr Vector'
+    , castPtr `Ptr ArpackOpt'
+    } -> `CInt' void- #}
+
+-- | Kleinberg's authority scores.
+authorityScore :: Graph d v e
+               -> Bool -- ^ scale result such that \(\left|max\ centrality\right|=1\)
+               -> ([Double],Double) -- ^ (eigenvector,eigenvalue)
+authorityScore graph scale = unsafePerformIO $
+  allocaVector $ \vector ->
+  alloca $ \value ->
+  allocaArpackOpt $ \options -> do
+    igraphAuthorityScore (_graph graph) vector value scale nullPtr options
+    liftM2 (,) (toList vector) (peekFloatConv value)
+{-# INLINE igraphAuthorityScore #-}
+{#fun igraph_authority_score as ^
+    { `IGraph'
+    , castPtr `Ptr Vector'
+    , castPtr `Ptr CDouble'
+    , `Bool'
+    , castPtr `Ptr Vector'
+    , castPtr `Ptr ArpackOpt'
+    } -> `CInt' void- #}

src/IGraph/Algorithms/Structure.chs

@@ -3,13 +3,26 @@
 module IGraph.Algorithms.Structure
     ( -- * Shortest Path Related Functions
       shortestPath
+    , averagePathLength
+    , diameter
+    , eccentricity
+    , radius
+      -- * Graph Components
     , inducedSubgraph
     , isConnected
     , isStronglyConnected
     , decompose
+    , articulationPoints
+    , bridges
+      -- * Topological Sorting, Directed Acyclic Graphs
     , isDag
     , topSort
     , topSortUnsafe
+      -- * Other Operations
+    , density
+    , reciprocity
+      -- * Auxiliary types
+    , Neimode(IgraphOut,IgraphIn,IgraphAll) -- not IgraphTotal
     ) where
 
 import           Control.Monad
@@ -64,6 +77,78 @@ shortestPath gr s t getEdgeW = unsafePerformIO $ allocaVector $ \path -> do
     , `Neimode'
     } -> `CInt' void- #}
 
+-- | Calculates the average shortest path length between all vertex pairs.
+averagePathLength :: Graph d v e
+                  -> EdgeType -- ^ whether to consider directed paths
+                  -> Bool     -- ^ if unconnected,
+                              -- include only connected pairs (True)
+                              -- or return number if vertices (False)
+                  -> Double
+averagePathLength graph directed unconn =
+  cFloatConv $ igraphAveragePathLength (_graph graph) directed unconn
+{-# INLINE igraphAveragePathLength #-}
+{#fun pure igraph_average_path_length as ^
+    { `IGraph'
+    , alloca- `CDouble' peek*
+    , dirToBool `EdgeType'
+    , `Bool'
+    } -> `CInt' void- #}
+
+-- | Calculates the diameter of a graph (longest geodesic).
+diameter :: Graph d v e
+         -> EdgeType -- ^ whether to consider directed paths
+         -> Bool     -- ^ if unconnected,
+                     -- return largest component diameter (True)
+                     -- or number of vertices (False)
+         -> (Int,[Node])
+diameter graph directed unconn = unsafePerformIO $
+  alloca $ \pres ->
+  allocaVector $ \path -> do
+    igraphDiameter (_graph graph) pres nullPtr nullPtr path directed unconn
+    liftM2 (,) (peekIntConv pres) (toNodes path)
+{-# INLINE igraphDiameter #-}
+{#fun igraph_diameter as ^
+    { `IGraph'
+    , castPtr `Ptr CInt'
+    , castPtr `Ptr CInt'
+    , castPtr `Ptr CInt'
+    , castPtr `Ptr Vector'
+    , dirToBool `EdgeType'
+    , `Bool'
+    } -> `CInt' void- #}
+
+-- | Eccentricity of some vertices.
+eccentricity :: Graph d v e
+             -> Neimode -- ^ 'IgraphOut' to follow edges' direction,
+                        -- 'IgraphIn' to reverse it, 'IgraphAll' to ignore
+             -> [Node]  -- ^ vertices for which to calculate eccentricity
+             -> [Double]
+eccentricity graph mode vids = unsafePerformIO $
+  allocaVector $ \res ->
+  withVerticesList vids $ \vs -> do
+    igraphEccentricity (_graph graph) res vs mode
+    toList res
+{-# INLINE igraphEccentricity #-}
+{#fun igraph_eccentricity as ^
+    { `IGraph'
+    , castPtr `Ptr Vector'
+    , castPtr %`Ptr VertexSelector'
+    , `Neimode'
+    } -> `CInt' void- #}
+
+-- | Radius of a graph.
+radius :: Graph d v e
+       -> Neimode -- ^ 'IgraphOut' to follow edges' direction,
+                  -- 'IgraphIn' to reverse it, 'IgraphAll' to ignore
+       -> Double
+radius graph mode = cFloatConv $ igraphRadius (_graph graph) mode
+{-# INLINE igraphRadius #-}
+{#fun pure igraph_radius as ^
+    { `IGraph'
+    , alloca- `CDouble' peek*
+    , `Neimode'
+    } -> `CInt' void- #}
+
 -- | Creates a subgraph induced by the specified vertices. This function collects
 -- the specified vertices and all edges between them to a new graph.
 inducedSubgraph :: (Ord v, Serialize v)
@@ -113,6 +198,27 @@ decompose gr = unsafePerformIO $ allocaVectorPtr $ \ptr -> do
     , `Int'
     } -> `CInt' void- #}
 
+-- | Find the articulation points in a graph.
+articulationPoints :: Graph d v e -> [Node]
+articulationPoints gr = unsafePerformIO $ allocaVector $ \res -> do
+  igraphArticulationPoints (_graph gr) res
+  toNodes res
+{-#INLINE igraphArticulationPoints #-}
+{#fun igraph_articulation_points as ^
+    { `IGraph'
+    , castPtr `Ptr Vector'
+    } -> `CInt' void- #}
+
+-- ^ Find all bridges in a graph.
+bridges :: Graph d v e -> [Edge]
+bridges gr = unsafePerformIO $ allocaVector $ \res -> do
+  igraphBridges (_graph gr) res
+  map (getEdgeByEid gr) <$> toNodes res
+{-# INLINE igraphBridges #-}
+{#fun igraph_bridges as ^
+    { `IGraph'
+    , castPtr `Ptr Vector'
+    } -> `CInt' void- #}
 
 -- | Checks whether a graph is a directed acyclic graph (DAG) or not.
 isDag :: Graph d v e -> Bool
@@ -144,3 +250,36 @@ topSortUnsafe gr = unsafePerformIO $ allocaVectorN n $ \res -> do
     , castPtr `Ptr Vector'
     , `Neimode'
     } -> `CInt' void- #}
+
+-- | Calculate the density of a graph.
+density :: Graph d v e
+        -> Bool -- ^ whether to include loops
+        -> Double -- ^ the ratio of edges to possible edges
+density gr loops = unsafePerformIO $ alloca $ \res -> do
+  igraphDensity (_graph gr) res loops
+  peek res
+{-# INLINE igraphDensity #-}
+{#fun igraph_density as ^
+    { `IGraph'
+    , castPtr `Ptr Double'
+    , `Bool'
+    } -> `CInt' void -#}
+
+-- | Calculates the reciprocity of a directed graph.
+reciprocity :: Graph d v e
+            -> Bool -- ^ whether to ignore loop edges
+            -> Double -- ^ the proportion of mutual connections
+reciprocity gr ignore_loops = unsafePerformIO $ alloca $ \res -> do
+  igraphReciprocity (_graph gr) res ignore_loops IgraphReciprocityDefault
+  peek res
+{#fun igraph_reciprocity as ^
+    { `IGraph'
+    , castPtr `Ptr Double'
+    , `Bool'
+    , `Reciprocity'
+    } -> `CInt' void -#}
+
+-- Marshaller for those "treat edges as directed" booleans.
+dirToBool :: Num n => EdgeType -> n
+dirToBool D = cFromBool True
+dirToBool U = cFromBool False

src/IGraph/Internal.chs

@@ -8,6 +8,7 @@ module IGraph.Internal
     , withList
     , withListMaybe
     , toList
+    , toNodes
     , igraphVectorNull
     , igraphVectorFill
     , igraphVectorE
@@ -193,6 +194,10 @@ toList vec = do
         map realToFrac <$> peekArray n ptr
 {-# INLINE toList #-}
 
+toNodes :: Ptr Vector -> IO [Node]
+toNodes = fmap (map truncate) . toList
+{-# INLINE toNodes #-}
+
 {#fun igraph_vector_copy_to as ^ { castPtr `Ptr Vector', id `Ptr CDouble' } -> `()' #}
 
 -- Initializing elements

src/IGraph/Internal/Constants.chs

@@ -41,3 +41,6 @@ module IGraph.Internal.Constants where
 
 {#enum igraph_degseq_t as Degseq {underscoreToCase}
     deriving (Show, Read, Eq) #}
+
+{#enum igraph_reciprocity_t as Reciprocity {underscoreToCase}
+    deriving (Show, Read, Eq) #}

tests/Test/Algorithms.hs

 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeApplications #-}
 module Test.Algorithms
     ( tests
     ) where
@@ -20,9 +21,18 @@ tests = testGroup "Algorithms"
     [ graphIsomorphism
     , motifTest
     , cliqueTest
+    , averagePathTest
+    , diameterTest
+    , eccentricityTest
+    , radiusTest
     , subGraphs
     , decomposeTest
+    , articulationTest
+    , bridgeTest
     , pagerankTest
+    , kleinbergTest
+    , densityTest
+    , reciprocityTest
     ]
 
 graphIsomorphism :: TestTree
@@ -55,6 +65,37 @@ cliqueTest = testGroup "Clique"
         [2,3,4], [2,4,5] ]
     c4 = [[1, 2, 3, 4], [1, 2, 4, 5]]
 
+averagePathTest :: TestTree
+averagePathTest = testGroup "Average path lengths"
+    [ testCase "clique" $ averagePathLength (full @'U 10 False) U True @?= 1
+    , testCase "star" $ averagePathLength (star 10) U True @?~ 1.8
+    , testCase "ring" $ averagePathLength (ring 11) U True @?= 3
+    ]
+
+diameterTest :: TestTree
+diameterTest = testGroup "Diameters"
+    [ testCase "clique" $ fst (diameter (full @'U 10 False) U True)  @?= 1
+    , testCase "star"   $ fst (diameter (star 10)          D False) @?= 2
+    , testCase "ring"   $ fst (diameter (ring 10)          U False) @?= 5
+    ]
+
+eccentricityTest :: TestTree
+eccentricityTest = testGroup "Eccentricity"
+    [ testCase "clique" $
+        eccentricity (full @'U 10 False) IgraphAll [0..9] @?= replicate 10 1
+    , testCase "star" $
+        eccentricity (star 10) IgraphAll [0..9] @?= (1 : replicate 9 2)
+    , testCase "ring" $
+        eccentricity (ring 10) IgraphAll [0..9] @?= replicate 10 5
+    ]
+
+radiusTest :: TestTree
+radiusTest = testGroup "Radius"
+    [ testCase "clique" $ radius (full @'U 10 False) IgraphAll @?= 1
+    , testCase "star" $ radius (star 10) IgraphAll @?= 1
+    , testCase "ring" $ radius (ring 10) IgraphAll @?= 5
+    ]
+
 subGraphs :: TestTree
 subGraphs = testGroup "generate induced subgraphs"
     [ testCase "" $ test case1 ]
@@ -87,6 +128,18 @@ decomposeTest = testGroup "Decompose"
 		 , (8,9), (9,10) ]
     gr = mkGraph (replicate 11 ()) $ zip es $ repeat () :: Graph 'U () ()
 
+articulationTest :: TestTree
+articulationTest = testCase "Articulation points" $
+  articulationPoints (star 3) @?= [0]
+
+bridgeTest :: TestTree
+bridgeTest = testCase "Bridges" $ edgeLab g <$> bridges g @?= ["bridge"]
+  where g = fromLabeledEdges @'U
+            [ (("a","b"),"ab") , (("b","c"),"bc") , (("c","a"),"ca")
+            , (("i","j"),"ij") , (("j","k"),"jk") , (("k","i"),"ki")
+            , (("a","i"),"bridge")
+            ]
+
 {-
 communityTest :: TestTree
 communityTest = testGroup "Community"
@@ -110,3 +163,28 @@ pagerankTest = testGroup "PageRank"
     ranks = [0.47,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05]
     ranks' = map ((/100) . fromIntegral . round. (*100)) $
         pagerank gr 0.85 Nothing Nothing
+
+kleinbergTest :: TestTree
+kleinbergTest = testGroup "Kleinberg"
+    [ testCase "Hub score" $
+        fst (hubScore (full @'U 16 False) True) @?= replicate 16 1
+    , testCase "Authority score" $
+        fst (authorityScore (ring 4) False) @?= replicate 4 0.5
+    ]
+
+densityTest :: TestTree
+densityTest = testGroup "Density"
+    [ testCase "clique" $ density (full @'U 16 False) False @?= 1
+    , testCase "ring" $ density (ring 9) False @?= 1/4
+    ]
+
+reciprocityTest :: TestTree
+reciprocityTest = testGroup "Reciprocity"
+    [ testCase "clique" $ reciprocity (full @'D 10 False) False @?= 1
+    , testCase "ring" $ reciprocity g False @?= 0
+    ]
+  where g = fromLabeledEdges @'D [(("a","b"),()),(("b","c"),()),(("c","a"),())]
+
+-- approximate equality helper
+(@?~) :: (Ord n,Fractional n) => n -> n -> Assertion
+a @?~ b = assertBool "" $ abs (b-a) < 1/65536