Extend ToGraph (#106)

* Add comments * Add conversion to adjacency map data types * Minor revision * Extend ToGraph, add isAcyclic See #105 * Fix Haddock warnings * Minor revision * Update the testsuite * Update change log * Add reachability analysis * Fix typo * Fix another typo * Update change log * Optimise edgeCount, drop unnecessary redefinitions in ToGraph Graph instance * Switch to naming consistent with ToGraph * Simplify edgeSet, fix GHC 7.8.4 compile error * Minor revision * Use stars
snowleopard · Aug 9, 2018 · 837bd15 · 837bd15
1 parent 91eb3b4
commit 837bd15
Show file tree

Hide file tree

Showing 15 changed files with 538 additions and 299 deletions.
diff --git a/CHANGES.md b/CHANGES.md
@@ -2,6 +2,9 @@
 
 ## 0.2
 
+* #106: Extend `ToGraph` with algorithms based on adjacency maps.
+* #106: Add `isAcyclic` and `reachable`.
+* #106: Rename `isTopSort` to `isTopSortOf`.
 * #102: Switch the master branch to GHC 8.4.3. Add a CI instance for GHC 8.6.1.
 * #101: Drop `-O2` from the `ghc-options` section of the Cabal file.
 * #100: Rename `fromAdjacencyList` to `stars`.

diff --git a/src/Algebra/Graph.hs b/src/Algebra/Graph.hs
@@ -33,7 +33,8 @@ module Algebra.Graph (
 
     -- * Graph properties
     isEmpty, size, hasVertex, hasEdge, vertexCount, edgeCount, vertexList,
-    edgeList, vertexSet, vertexIntSet, edgeSet, adjacencyList,
+    edgeList, vertexSet, vertexIntSet, edgeSet, adjacencyList, adjacencyMap,
+    adjacencyIntMap,
 
     -- * Standard families of graphs
     path, circuit, clique, biclique, star, stars, starTranspose, tree, forest,
@@ -46,8 +47,8 @@ module Algebra.Graph (
     -- * Graph composition
     box,
 
-    -- * Conversion to graphs
-    adjacencyMap, adjacencyIntMap, Context (..), context
+    -- * Context
+    Context (..), context
   ) where
 
 import Prelude ()
@@ -465,7 +466,7 @@ hasEdge s t g = hit g == Edge
 -- vertexCount ('vertex' x) == 1
 -- vertexCount            == 'length' . 'vertexList'
 -- @
-{-# INLINE[1] vertexCount #-}
+{-# INLINE [1] vertexCount #-}
 {-# RULES "vertexCount/Int" vertexCount = vertexIntCount #-}
 vertexCount :: Ord a => Graph a -> Int
 vertexCount = Set.size . vertexSet
@@ -484,9 +485,14 @@ vertexIntCount = IntSet.size . vertexIntSet
 -- edgeCount ('edge' x y) == 1
 -- edgeCount            == 'length' . 'edgeList'
 -- @
-{-# SPECIALISE edgeCount :: Graph Int -> Int #-}
+{-# INLINE [1] edgeCount #-}
+{-# RULES "edgeCount/Int" edgeCount = edgeCountInt #-}
 edgeCount :: Ord a => Graph a -> Int
-edgeCount = length . edgeList
+edgeCount = AM.edgeCount . toAdjacencyMap
+
+-- | Like 'edgeCount' but specialised for graphs with vertices of type 'Int'.
+edgeCountInt :: Graph Int -> Int
+edgeCountInt = AIM.edgeCount . toAdjacencyIntMap
 
 -- | The sorted list of vertices of a given graph.
 -- Complexity: /O(s * log(n))/ time and /O(n)/ memory.
@@ -496,10 +502,10 @@ edgeCount = length . edgeList
 -- vertexList ('vertex' x) == [x]
 -- vertexList . 'vertices' == 'Data.List.nub' . 'Data.List.sort'
 -- @
+{-# INLINE [1] vertexList #-}
+{-# RULES "vertexList/Int" vertexList = vertexIntList #-}
 vertexList :: Ord a => Graph a -> [a]
 vertexList = Set.toAscList . vertexSet
-{-# INLINE[1] vertexList #-}
-{-# RULES "vertexList/Int" vertexList = vertexIntList #-}
 
 -- | Like 'vertexList' but specialised for graphs with vertices of type 'Int'.
 vertexIntList :: Graph Int -> [Int]
@@ -517,14 +523,14 @@ vertexIntList = IntSet.toList . vertexIntSet
 -- edgeList . 'edges'        == 'Data.List.nub' . 'Data.List.sort'
 -- edgeList . 'transpose'    == 'Data.List.sort' . map 'Data.Tuple.swap' . edgeList
 -- @
-edgeList :: Ord a => Graph a -> [(a, a)]
-edgeList = AM.edgeList . fromGraphAM
-{-# INLINE[1] edgeList #-}
+{-# INLINE [1] edgeList #-}
 {-# RULES "edgeList/Int" edgeList = edgeIntList #-}
+edgeList :: Ord a => Graph a -> [(a, a)]
+edgeList = AM.edgeList . toAdjacencyMap
 
 -- | Like 'edgeList' but specialised for graphs with vertices of type 'Int'.
-edgeIntList :: Graph Int -> [(Int,Int)]
-edgeIntList = AIM.edgeList . fromGraphAIM
+edgeIntList :: Graph Int -> [(Int, Int)]
+edgeIntList = AIM.edgeList . toAdjacencyIntMap
 
 -- | The set of vertices of a given graph.
 -- Complexity: /O(s * log(n))/ time and /O(n)/ memory.
@@ -561,13 +567,13 @@ vertexIntSet = foldg IntSet.empty IntSet.singleton IntSet.union IntSet.union
 -- edgeSet . 'edges'    == Set.'Set.fromList'
 -- @
 edgeSet :: Ord a => Graph a -> Set.Set (a, a)
-edgeSet = AM.edgeSet . fromGraphAM
-{-# INLINE[1] edgeSet #-}
+edgeSet = AM.edgeSet . toAdjacencyMap
+{-# INLINE [1] edgeSet #-}
 {-# RULES "edgeSet/Int" edgeSet = edgeIntSet #-}
 
--- | Like 'edgeIntSet' but specialised for graphs with vertices of type 'Int'.
+-- | Like 'edgeSet' but specialised for graphs with vertices of type 'Int'.
 edgeIntSet :: Graph Int -> Set.Set (Int,Int)
-edgeIntSet = AIM.edgeSet . fromGraphAIM
+edgeIntSet = AIM.edgeSet . toAdjacencyIntMap
 
 -- | The sorted /adjacency list/ of a graph.
 -- Complexity: /O(n + m)/ time and /O(m)/ memory.
@@ -579,32 +585,31 @@ edgeIntSet = AIM.edgeSet . fromGraphAIM
 -- adjacencyList ('star' 2 [3,1]) == [(1, []), (2, [1,3]), (3, [])]
 -- 'stars' . adjacencyList        == id
 -- @
-{-# SPECIALISE adjacencyList :: Graph Int -> [(Int,[Int])] #-}
+{-# SPECIALISE adjacencyList :: Graph Int -> [(Int, [Int])] #-}
 adjacencyList :: Ord a => Graph a -> [(a, [a])]
-adjacencyList = AM.adjacencyList . fromGraphAM
+adjacencyList = AM.adjacencyList . toAdjacencyMap
 
 -- | The /adjacency map/ of a graph: each vertex is associated with a set of its
 -- direct successors.
 -- Complexity: /O(s + m * log(m))/ time. Note that the number of edges /m/ of a
 -- graph can be quadratic with respect to the expression size /s/.
 adjacencyMap :: Ord a => Graph a -> Map a (Set a)
-adjacencyMap = AM.adjacencyMap . fromGraphAM
+adjacencyMap = AM.adjacencyMap . toAdjacencyMap
 
 -- TODO: This is a very inefficient implementation. Find a way to construct an
 -- adjacency map directly, without building intermediate representations for all
 -- subgraphs.
--- TODO: This should go to FromGraph type class.
 -- | Convert a graph to 'AM.AdjacencyMap'.
-fromGraphAM :: Ord a => Graph a -> AM.AdjacencyMap a
-fromGraphAM = foldg AM.empty AM.vertex AM.overlay AM.connect
+toAdjacencyMap :: Ord a => Graph a -> AM.AdjacencyMap a
+toAdjacencyMap = foldg AM.empty AM.vertex AM.overlay AM.connect
 
 -- | Like 'adjacencyMap' but specialised for graphs with vertices of type 'Int'.
 adjacencyIntMap :: Graph Int -> IntMap IntSet
-adjacencyIntMap = AIM.adjacencyIntMap . fromGraphAIM
+adjacencyIntMap = AIM.adjacencyIntMap . toAdjacencyIntMap
 
--- | Like 'fromGraphAM' but specialised for graphs with vertices of type 'Int'.
-fromGraphAIM :: Graph Int -> AIM.AdjacencyIntMap
-fromGraphAIM = foldg AIM.empty AIM.vertex AIM.overlay AIM.connect
+-- | Like @toAdjacencyMap@ but specialised for graphs with vertices of type 'Int'.
+toAdjacencyIntMap :: Graph Int -> AIM.AdjacencyIntMap
+toAdjacencyIntMap = foldg AIM.empty AIM.vertex AIM.overlay AIM.connect
 
 -- | The /path/ on a list of vertices.
 -- Complexity: /O(L)/ time, memory and size, where /L/ is the length of the

diff --git a/src/Algebra/Graph/AdjacencyIntMap.hs b/src/Algebra/Graph/AdjacencyIntMap.hs
@@ -13,7 +13,7 @@
 -- This module defines the 'AdjacencyIntMap' data type, as well as associated
 -- operations and algorithms. 'AdjacencyIntMap' is an instance of the 'C.Graph'
 -- type class, which can be used for polymorphic graph construction
--- and manipulation. See "Algebra.Graph.adjacencyIntMap" for graphs with
+-- and manipulation. See "Algebra.Graph.AdjacencyMap" for graphs with
 -- non-@Int@ vertices.
 -----------------------------------------------------------------------------
 module Algebra.Graph.AdjacencyIntMap (
@@ -34,22 +34,25 @@ module Algebra.Graph.AdjacencyIntMap (
     path, circuit, clique, biclique, star, stars, starTranspose, tree, forest,
 
     -- * Graph transformation
-    removeVertex, removeEdge, replaceVertex, mergeVertices, transpose, gmap, induce,
+    removeVertex, removeEdge, replaceVertex, mergeVertices, transpose, gmap,
+    induce,
 
     -- * Algorithms
-    dfsForest, dfsForestFrom, dfs, topSort, isTopSort
+    dfsForest, dfsForestFrom, dfs, reachable, topSort, isTopSort
   ) where
 
+import Data.Foldable (foldMap)
 import Data.IntSet (IntSet)
+import Data.Monoid
 import Data.Set (Set)
 import Data.Tree
 
 import Algebra.Graph.AdjacencyIntMap.Internal
 
-import qualified Data.Graph.Typed    as Typed
-import qualified Data.IntMap.Strict  as IntMap
-import qualified Data.IntSet         as IntSet
-import qualified Data.Set            as Set
+import qualified Data.Graph.Typed   as Typed
+import qualified Data.IntMap.Strict as IntMap
+import qualified Data.IntSet        as IntSet
+import qualified Data.Set           as Set
 
 -- | Construct the graph comprising /a single edge/.
 -- Complexity: /O(1)/ time, memory.
@@ -84,7 +87,7 @@ vertices = AM . IntMap.fromList . map (\x -> (x, IntSet.empty))
 --
 -- @
 -- edges []          == 'empty'
--- edges [(x, y)]    == 'edge' x y
+-- edges [(x,y)]     == 'edge' x y
 -- 'edgeCount' . edges == 'length' . 'Data.List.nub'
 -- 'edgeList' . edges  == 'Data.List.nub' . 'Data.List.sort'
 -- @
@@ -192,7 +195,7 @@ vertexCount = IntMap.size . adjacencyIntMap
 -- edgeCount            == 'length' . 'edgeList'
 -- @
 edgeCount :: AdjacencyIntMap -> Int
-edgeCount = IntMap.foldr (\es r -> (IntSet.size es + r)) 0 . adjacencyIntMap
+edgeCount = getSum . foldMap (Sum . IntSet.size) . adjacencyIntMap
 
 -- | The sorted list of vertices of a given graph.
 -- Complexity: /O(n)/ time and memory.
@@ -241,9 +244,7 @@ vertexIntSet = IntMap.keysSet . adjacencyIntMap
 -- edgeSet . 'edges'    == Set.'Set.fromList'
 -- @
 edgeSet :: AdjacencyIntMap -> Set (Int, Int)
-edgeSet = IntMap.foldrWithKey combine Set.empty . adjacencyIntMap
-  where
-    combine u es = Set.union (Set.fromAscList [ (u, v) | v <- IntSet.toAscList es ])
+edgeSet = Set.fromAscList . edgeList
 
 -- | The sorted /adjacency list/ of a graph.
 -- Complexity: /O(n + m)/ time and /O(m)/ memory.
@@ -258,7 +259,7 @@ edgeSet = IntMap.foldrWithKey combine Set.empty . adjacencyIntMap
 adjacencyList :: AdjacencyIntMap -> [(Int, [Int])]
 adjacencyList = map (fmap IntSet.toAscList) . IntMap.toAscList . adjacencyIntMap
 
--- | The /preset/ (here 'preIntSet') of an element @x@ is the set of its
+-- | The /preset/ (here @preIntSet@) of an element @x@ is the set of its
 -- /direct predecessors/.
 -- Complexity: /O(n * log(n))/ time and /O(n)/ memory.
 --
@@ -273,7 +274,7 @@ preIntSet x = IntSet.fromAscList . map fst . filter p  . IntMap.toAscList . adja
   where
     p (_, set) = x `IntSet.member` set
 
--- | The /postset/ (here 'postIntSet') of a vertex is the set of its
+-- | The /postset/ (here @postIntSet@) of a vertex is the set of its
 -- /direct successors/.
 --
 -- @
@@ -575,6 +576,24 @@ dfsForestFrom vs = Typed.dfsForestFrom vs . Typed.fromAdjacencyIntMap
 dfs :: [Int] -> AdjacencyIntMap -> [Int]
 dfs vs = concatMap flatten . dfsForestFrom vs
 
+-- | Compute the list of vertices that are /reachable/ from a given source
+-- vertex in a graph. The vertices in the resulting list appear in the
+-- /depth-first order/.
+--
+-- @
+-- reachable x $ 'empty'                       == []
+-- reachable 1 $ 'vertex' 1                    == [1]
+-- reachable 1 $ 'vertex' 2                    == []
+-- reachable 1 $ 'edge' 1 1                    == [1]
+-- reachable 1 $ 'edge' 1 2                    == [1,2]
+-- reachable 4 $ 'path'    [1..8]              == [4..8]
+-- reachable 4 $ 'circuit' [1..8]              == [4..8] ++ [1..3]
+-- reachable 8 $ 'clique'  [8,7..1]            == [8] ++ [1..7]
+-- 'isSubgraphOf' ('vertices' $ reachable x y) y == True
+-- @
+reachable :: Int -> AdjacencyIntMap -> [Int]
+reachable x = dfs [x]
+
 -- | Compute the /topological sort/ of a graph or return @Nothing@ if the graph
 -- is cyclic.
 --

diff --git a/src/Algebra/Graph/AdjacencyIntMap/Internal.hs b/src/Algebra/Graph/AdjacencyIntMap/Internal.hs
@@ -87,7 +87,14 @@ will denote the number of vertices and edges in the graph, respectively.
 -}
 newtype AdjacencyIntMap = AM {
     -- | The /adjacency map/ of the graph: each vertex is associated with a set
-    -- of its direct successors.
+    -- of its direct successors. Complexity: /O(1)/ time and memory.
+    --
+    -- @
+    -- adjacencyIntMap 'empty'      == IntMap.'IntMap.empty'
+    -- adjacencyIntMap ('vertex' x) == IntMap.'IntMap.singleton' x IntSet.'IntSet.empty'
+    -- adjacencyIntMap ('Algebra.Graph.AdjacencyIntMap.edge' 1 1) == IntMap.'IntMap.singleton' 1 (IntSet.'IntSet.singleton' 1)
+    -- adjacencyIntMap ('Algebra.Graph.AdjacencyIntMap.edge' 1 2) == IntMap.'IntMap.fromList' [(1,IntSet.'IntSet.singleton' 2), (2,IntSet.'IntSet.empty')]
+    -- @
     adjacencyIntMap :: IntMap IntSet } deriving Eq
 
 instance Show AdjacencyIntMap where