algebraic-graphs 0.6.1 → 0.7

raw patch · 25 files changed

+696/−654 lines, 25 filesdep ~QuickCheckdep ~deepseqdep ~inspection-testingPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: QuickCheck, deepseq, inspection-testing

API changes (from Hackage documentation)

Files

• CHANGES.md +5/−0
• algebraic-graphs.cabal +3/−3
• src/Algebra/Graph.hs +5/−5
• src/Algebra/Graph/AdjacencyIntMap.hs +1/−1
• src/Algebra/Graph/AdjacencyIntMap/Algorithm.hs +128/−120
• src/Algebra/Graph/AdjacencyMap.hs +1/−1
• src/Algebra/Graph/AdjacencyMap/Algorithm.hs +117/−109
• src/Algebra/Graph/Labelled.hs +18/−4
• src/Algebra/Graph/Labelled/AdjacencyMap.hs +30/−3
• src/Algebra/Graph/Labelled/Example/Automaton.hs +9/−6
• src/Algebra/Graph/NonEmpty.hs +5/−5
• src/Algebra/Graph/NonEmpty/AdjacencyMap.hs +1/−1
• src/Algebra/Graph/Relation.hs +30/−4
• src/Algebra/Graph/Relation/Symmetric.hs +30/−5
• src/Algebra/Graph/ToGraph.hs +29/−107
• src/Algebra/Graph/Undirected.hs +13/−13
• src/Data/Graph/Typed.hs +38/−37
• test/Algebra/Graph/Test/API.hs +5/−5
• test/Algebra/Graph/Test/Generic.hs +154/−156
• test/Algebra/Graph/Test/Graph.hs +5/−5
• test/Algebra/Graph/Test/Labelled/AdjacencyMap.hs +2/−2
• test/Algebra/Graph/Test/Labelled/Graph.hs +2/−2
• test/Algebra/Graph/Test/NonEmpty/AdjacencyMap.hs +2/−2
• test/Algebra/Graph/Test/NonEmpty/Graph.hs +6/−6
• test/Data/Graph/Test/Typed.hs +57/−52

@@ -1,5 +1,10 @@ # Change log +## 0.7++* #294: Change the argument order of `bfs*`, `dfs*` and `reachable` algorithms.+* #293: Fix the `ToGraph` instance of symmetric relations.+ ## 0.6.1  * Drop dependency on `mtl`.

@@ -1,6 +1,6 @@ cabal-version: 2.2 name:          algebraic-graphs-version:       0.6.1+version:       0.7 synopsis:      A library for algebraic graph construction and transformation license:       MIT license-file:  LICENSE@@ -132,7 +132,7 @@                         Algebra.Graph.ToGraph,                         Data.Graph.Typed -test-suite test-alga+test-suite main     import:             common-settings     hs-source-dirs:     test     type:               exitcode-stdio-1.0@@ -161,7 +161,7 @@                         Data.Graph.Test.Typed     build-depends:      algebraic-graphs,                         extra              >= 1.4     && < 2,-                        inspection-testing >= 0.4.6.0 && < 0.5,+                        inspection-testing >= 0.4.2.2 && < 0.6,                         QuickCheck         >= 2.14    && < 2.15     other-extensions:   ConstrainedClassMethods                         TemplateHaskell

@@ -1291,15 +1291,15 @@  -- | /Sparsify/ a graph by adding intermediate 'Left' @Int@ vertices between the -- original vertices (wrapping the latter in 'Right') such that the resulting--- graph is /sparse/, i.e. contains only O(s) edges, but preserves the+-- graph is /sparse/, i.e. contains only /O(s)/ edges, but preserves the -- reachability relation between the original vertices. Sparsification is useful -- when working with dense graphs, as it can reduce the number of edges from--- O(n^2) down to O(n) by replacing cliques, bicliques and similar densely+-- /O(n^2)/ down to /O(n)/ by replacing cliques, bicliques and similar densely -- connected structures by sparse subgraphs built out of intermediate vertices.--- Complexity: O(s) time, memory and size.+-- Complexity: /O(s)/ time, memory and size. -- -- @--- 'Data.List.sort' . 'Algebra.Graph.ToGraph.reachable' x       == 'Data.List.sort' . 'Data.Either.rights' . 'Algebra.Graph.ToGraph.reachable' ('Data.Either.Right' x) . sparsify+-- 'Data.List.sort' . 'Algebra.Graph.ToGraph.reachable' x       == 'Data.List.sort' . 'Data.Either.rights' . 'Algebra.Graph.ToGraph.reachable' (sparsify x) . 'Data.Either.Right' -- 'vertexCount' (sparsify x) <= 'vertexCount' x + 'size' x + 1 -- 'edgeCount'   (sparsify x) <= 3 * 'size' x -- 'size'        (sparsify x) <= 3 * 'size' x@@ -1329,7 +1329,7 @@ -- contain a quadratic /O(s^2)/ number of edges. -- -- @--- 'Data.List.sort' . 'Algebra.Graph.ToGraph.reachable' k                 == 'Data.List.sort' . 'filter' (<= n) . 'flip' 'Data.Graph.reachable' k . sparsifyKL n+-- 'Data.List.sort' . 'Algebra.Graph.ToGraph.reachable' x                 == 'Data.List.sort' . 'filter' (<= n) . 'Data.Graph.reachable' (sparsifyKL n x) -- 'length' ('Data.Graph.vertices' $ sparsifyKL n x) <= 'vertexCount' x + 'size' x + 1 -- 'length' ('Data.Graph.edges'    $ sparsifyKL n x) <= 3 * 'size' x -- @

@@ -814,7 +814,7 @@ -- closure                  == 'reflexiveClosure' . 'transitiveClosure' -- closure                  == 'transitiveClosure' . 'reflexiveClosure' -- closure . closure        == closure--- 'postIntSet' x (closure y) == IntSet.'IntSet.fromList' ('Algebra.Graph.ToGraph.reachable' x y)+-- 'postIntSet' x (closure y) == IntSet.'IntSet.fromList' ('Algebra.Graph.ToGraph.reachable' y x) -- @ closure :: AdjacencyIntMap -> AdjacencyIntMap closure = reflexiveClosure . transitiveClosure

@@ -44,82 +44,98 @@ import qualified Data.IntSet        as IntSet  -- | Compute the /breadth-first search/ forest of a graph, such that adjacent--- vertices are explored in increasing order according to their 'Ord' instance.--- The search is seeded by a list of vertices that will become the roots of the--- resulting forest. Duplicates in the list will have their first occurrence--- expanded and subsequent ones ignored. The seed vertices that do not belong to--- the graph are also ignored.+-- vertices are explored in the increasing order. The search is seeded by a list+-- of vertices that will become the roots of the resulting forest. Duplicates in+-- the list will have their first occurrence explored and subsequent ones+-- ignored. The seed vertices that do not belong to the graph are also ignored. ----- Complexity: /O((L+m)*log n)/ time and /O(n)/ space, where /L/ is the number--- of seed vertices.+-- Complexity: /O((L + m) * log n)/ time and /O(n)/ space, where /L/ is the+-- number of seed vertices. -- -- @--- 'forest' (bfsForest [1,2] $ 'edge' 1 2)      == 'vertices' [1,2]--- 'forest' (bfsForest [2]   $ 'edge' 1 2)      == 'vertex' 2--- 'forest' (bfsForest [3]   $ 'edge' 1 2)      == 'empty'--- 'forest' (bfsForest [2,1] $ 'edge' 1 2)      == 'vertices' [1,2]--- 'isSubgraphOf' ('forest' $ bfsForest vs x) x == True--- bfsForest ('vertexList' g) g               == 'map' (\v -> Node v []) ('nub' $ 'vertexList' g)--- bfsForest [] x                           == []--- bfsForest [1,4] (3 * (1 + 4) * (1 + 5))  == [ Node { rootLabel = 1+-- 'forest' $ bfsForest ('edge' 1 2) [0]        == 'empty'+-- 'forest' $ bfsForest ('edge' 1 2) [1]        == 'edge' 1 2+-- 'forest' $ bfsForest ('edge' 1 2) [2]        == 'vertex' 2+-- 'forest' $ bfsForest ('edge' 1 2) [0,1,2]    == 'vertices' [1,2]+-- 'forest' $ bfsForest ('edge' 1 2) [2,1,0]    == 'vertices' [1,2]+-- 'forest' $ bfsForest ('edge' 1 1) [1]        == 'vertex' 1+-- 'isSubgraphOf' ('forest' $ bfsForest x vs) x == True+-- bfsForest x ('vertexList' x)               == 'map' (\\v -> Node v []) ('Data.List.nub' $ 'vertexList' x)+-- bfsForest x []                           == []+-- bfsForest 'empty' vs                       == []+-- bfsForest (3 * (1 + 4) * (1 + 5)) [1,4]  == [ Node { rootLabel = 1 --                                                    , subForest = [ Node { rootLabel = 5 --                                                                         , subForest = [] }]} --                                             , Node { rootLabel = 4 --                                                    , subForest = [] }]--- 'forest' (bfsForest [3] ('circuit' [1..5] + 'circuit' [5,4..1])) == 'path' [3,2,1] + 'path' [3,4,5]+-- 'forest' $ bfsForest ('circuit' [1..5] + 'circuit' [5,4..1]) [3] == 'path' [3,2,1] + 'path' [3,4,5] -- -- @-bfsForest :: [Int] -> AdjacencyIntMap -> Forest Int-bfsForest vs g = evalState (explore [ v | v <- vs, hasVertex v g ]) IntSet.empty where-  explore = unfoldForestM_BF walk <=< filterM discovered-  walk v = (v,) <$> adjacentM v-  adjacentM v = filterM discovered $ IntSet.toList (postIntSet v g)-  discovered v = do new <- gets (not . IntSet.member v)-                    when new $ modify' (IntSet.insert v)-                    return new+bfsForest :: AdjacencyIntMap -> [Int] -> Forest Int+bfsForest g vs= evalState (explore [ v | v <- vs, hasVertex v g ]) IntSet.empty+  where+    explore = filterM discovered >=> unfoldForestM_BF walk+    walk v = (v,) <$> adjacentM v+    adjacentM v = filterM discovered $ IntSet.toList (postIntSet v g)+    discovered v = do new <- gets (not . IntSet.member v)+                      when new $ modify' (IntSet.insert v)+                      return new  -- | A version of 'bfsForest' where the resulting forest is converted to a level--- structure. Adjacent vertices are explored in the increasing order according--- to their 'Ord' instance. Flattening the result via @'concat'@ @.@ @'bfs'@ @vs@--- gives an enumeration of vertices reachable from @vs@ in the BFS order.+-- structure. Adjacent vertices are explored in the increasing order. Flattening+-- the result via @'concat'@ @.@ @'bfs'@ @x@ gives an enumeration of reachable+-- vertices in the breadth-first search order. ----- Complexity: /O((L+m)*min(n,W))/ time and /O(n)/ space, where /L/ is the+-- Complexity: /O((L + m) * min(n,W))/ time and /O(n)/ space, where /L/ is the -- number of seed vertices. -- -- @--- bfs vs 'empty'                                         == []--- bfs [] g                                             == []--- bfs [1]   ('edge' 1 1)                                 == [[1]]--- bfs [1]   ('edge' 1 2)                                 == [[1],[2]]--- bfs [2]   ('edge' 1 2)                                 == [[2]]--- bfs [1,2] ('edge' 1 2)                                 == [[1,2]]--- bfs [2,1] ('edge' 1 2)                                 == [[2,1]]--- bfs [3]   ('edge' 1 2)                                 == []--- bfs [1,2] ( (1*2) + (3*4) + (5*6) )                  == [[1,2]]--- bfs [1,3] ( (1*2) + (3*4) + (5*6) )                  == [[1,3],[2,4]]--- bfs [3] (3 * (1 + 4) * (1 + 5))                      == [[3],[1,4,5]]--- bfs [2] ('circuit' [1..5] + 'circuit' [5,4..1])          == [[2],[1,3],[5,4]]--- 'concat' (bfs [3] $ 'circuit' [1..5] + 'circuit' [5,4..1]) == [3,2,4,1,5]--- bfs vs == 'map' 'concat' . 'List.transpose' . 'map' 'levels' . 'bfsForest' vs+-- bfs ('edge' 1 2) [0]                == []+-- bfs ('edge' 1 2) [1]                == [[1], [2]]+-- bfs ('edge' 1 2) [2]                == [[2]]+-- bfs ('edge' 1 2) [1,2]              == [[1,2]]+-- bfs ('edge' 1 2) [2,1]              == [[2,1]]+-- bfs ('edge' 1 1) [1]                == [[1]]+-- bfs 'empty' vs                      == []+-- bfs x []                          == []+-- bfs (1 * 2 + 3 * 4 + 5 * 6) [1,2] == [[1,2]]+-- bfs (1 * 2 + 3 * 4 + 5 * 6) [1,3] == [[1,3], [2,4]]+-- bfs (3 * (1 + 4) * (1 + 5)) [3]   == [[3], [1,4,5]]+--+-- bfs ('circuit' [1..5] + 'circuit' [5,4..1]) [3]          == [[2], [1,3], [5,4]]+-- 'concat' $ bfs ('circuit' [1..5] + 'circuit' [5,4..1]) [3] == [3,2,4,1,5]+-- 'map' 'concat' . 'List.transpose' . 'map' 'levels' . 'bfsForest' x    == bfs x -- @-bfs :: [Int] -> AdjacencyIntMap -> [[Int]]-bfs vs = map concat . List.transpose . map levels . bfsForest vs+bfs :: AdjacencyIntMap -> [Int] -> [[Int]]+bfs g = map concat . List.transpose . map levels . bfsForest g +dfsForestFromImpl :: AdjacencyIntMap -> [Int] -> Forest Int+dfsForestFromImpl g vs = evalState (explore vs) IntSet.empty+  where+    explore (v:vs) = discovered v >>= \case+      True -> (:) <$> walk v <*> explore vs+      False -> explore vs+    explore [] = return []+    walk v = Node v <$> explore (adjacent v)+    adjacent v = IntSet.toList (postIntSet v g)+    discovered v = do new <- gets (not . IntSet.member v)+                      when new $ modify' (IntSet.insert v)+                      return new+ -- | Compute the /depth-first search/ forest of a graph, where adjacent vertices--- are explored in the increasing order according to their 'Ord' instance.+-- are explored in the increasing order. ----- Complexity: /O((n+m)*min(n,W))/ time and /O(n)/ space.+-- Complexity: /O((n + m) * min(n,W))/ time and /O(n)/ space. -- -- @--- dfsForest 'empty'                       == []--- 'forest' (dfsForest $ 'edge' 1 1)         == 'vertex' 1--- 'forest' (dfsForest $ 'edge' 1 2)         == 'edge' 1 2--- 'forest' (dfsForest $ 'edge' 2 1)         == 'vertices' [1,2]+-- 'forest' $ dfsForest 'empty'              == 'empty'+-- 'forest' $ dfsForest ('edge' 1 1)         == 'vertex' 1+-- 'forest' $ dfsForest ('edge' 1 2)         == 'edge' 1 2+-- 'forest' $ dfsForest ('edge' 2 1)         == 'vertices' [1,2] -- 'isSubgraphOf' ('forest' $ dfsForest x) x == True -- 'isDfsForestOf' (dfsForest x) x         == True -- dfsForest . 'forest' . dfsForest        == dfsForest -- dfsForest ('vertices' vs)               == 'map' (\\v -> Node v []) ('Data.List.nub' $ 'Data.List.sort' vs)--- 'dfsForestFrom' ('vertexList' x) x        == dfsForest x -- dfsForest $ 3 * (1 + 4) * (1 + 5)     == [ Node { rootLabel = 1 --                                                 , subForest = [ Node { rootLabel = 5 --                                                                      , subForest = [] }]}@@ -129,92 +145,84 @@ -- 'forest' (dfsForest $ 'circuit' [1..5] + 'circuit' [5,4..1]) == 'path' [1,2,3,4,5] -- @ dfsForest :: AdjacencyIntMap -> Forest Int-dfsForest g = dfsForestFrom' (vertexList g) g+dfsForest g = dfsForestFromImpl g (vertexList g)  -- | Compute the /depth-first search/ forest of a graph starting from the given--- seed vertices, where adjacent vertices are explored in the increasing order--- according to their 'Ord' instance. Note that the resulting forest does not--- necessarily span the whole graph, as some vertices may be unreachable. The--- seed vertices which do not belong to the graph are ignored.+-- seed vertices, where adjacent vertices are explored in the increasing order.+-- Note that the resulting forest does not necessarily span the whole graph, as+-- some vertices may be unreachable. The seed vertices which do not belong to+-- the graph are ignored. ----- Complexity: /O((L+m)*log n)/ time and /O(n)/ space, where /L/ be the number--- of seed vertices.+-- Complexity: /O((L + m) * log n)/ time and /O(n)/ space, where /L/ is the+-- number of seed vertices. -- -- @--- dfsForestFrom vs 'empty'                           == []--- 'forest' (dfsForestFrom [1]   $ 'edge' 1 1)          == 'vertex' 1--- 'forest' (dfsForestFrom [1]   $ 'edge' 1 2)          == 'edge' 1 2--- 'forest' (dfsForestFrom [2]   $ 'edge' 1 2)          == 'vertex' 2--- 'forest' (dfsForestFrom [3]   $ 'edge' 1 2)          == 'empty'--- 'forest' (dfsForestFrom [2,1] $ 'edge' 1 2)          == 'vertices' [1,2]--- 'isSubgraphOf' ('forest' $ dfsForestFrom vs x) x     == True--- 'isDfsForestOf' (dfsForestFrom ('vertexList' x) x) x == True--- dfsForestFrom ('vertexList' x) x                   == 'dfsForest' x--- dfsForestFrom vs             ('vertices' vs)       == 'map' (\\v -> Node v []) ('Data.List.nub' vs)--- dfsForestFrom []             x                   == []--- dfsForestFrom [1,4] $ 3 * (1 + 4) * (1 + 5)      == [ Node { rootLabel = 1+-- 'forest' $ dfsForestFrom 'empty'      vs             == 'empty'+-- 'forest' $ dfsForestFrom ('edge' 1 1) [1]            == 'vertex' 1+-- 'forest' $ dfsForestFrom ('edge' 1 2) [0]            == 'empty'+-- 'forest' $ dfsForestFrom ('edge' 1 2) [1]            == 'edge' 1 2+-- 'forest' $ dfsForestFrom ('edge' 1 2) [2]            == 'vertex' 2+-- 'forest' $ dfsForestFrom ('edge' 1 2) [1,2]          == 'edge' 1 2+-- 'forest' $ dfsForestFrom ('edge' 1 2) [2,1]          == 'vertices' [1,2]+-- 'isSubgraphOf' ('forest' $ dfsForestFrom x vs) x     == True+-- 'isDfsForestOf' (dfsForestFrom x ('vertexList' x)) x == True+-- dfsForestFrom x ('vertexList' x)                   == 'dfsForest' x+-- dfsForestFrom x []                               == []+-- dfsForestFrom (3 * (1 + 4) * (1 + 5)) [1,4]      == [ Node { rootLabel = 1 --                                                            , subForest = [ Node { rootLabel = 5 --                                                                                 , subForest = [] } --                                                     , Node { rootLabel = 4 --                                                            , subForest = [] }]--- 'forest' (dfsForestFrom [3] $ 'circuit' [1..5] + 'circuit' [5,4..1]) == 'path' [3,2,1,5,4]+-- 'forest' $ dfsForestFrom ('circuit' [1..5] + 'circuit' [5,4..1]) [3] == 'path' [3,2,1,5,4] -- @-dfsForestFrom :: [Int] -> AdjacencyIntMap -> Forest Int-dfsForestFrom vs g = dfsForestFrom' [ v | v <- vs, hasVertex v g ] g+dfsForestFrom :: AdjacencyIntMap -> [Int] -> Forest Int+dfsForestFrom g vs = dfsForestFromImpl g [ v | v <- vs, hasVertex v g ] -dfsForestFrom' :: [Int] -> AdjacencyIntMap -> Forest Int-dfsForestFrom' vs g = evalState (explore vs) IntSet.empty where-  explore (v:vs) = discovered v >>= \case-    True -> (:) <$> walk v <*> explore vs-    False -> explore vs-  explore [] = return []-  walk v = Node v <$> explore (adjacent v)-  adjacent v = IntSet.toList (postIntSet v g)-  discovered v = do new <- gets (not . IntSet.member v)-                    when new $ modify' (IntSet.insert v)-                    return new  -- | Return the list vertices visited by the /depth-first search/ in a graph, -- starting from the given seed vertices. Adjacent vertices are explored in the--- increasing order according to their 'Ord' instance.+-- increasing order. ----- Complexity: /O((L+m)*log n)/ time and /O(n)/ space, where /L/ is the number--- of seed vertices.+-- Complexity: /O((L + m) * log n)/ time and /O(n)/ space, where /L/ is the+-- number of seed vertices. -- -- @--- dfs vs    $ 'empty'                    == []--- dfs [1]   $ 'edge' 1 1                 == [1]--- dfs [1]   $ 'edge' 1 2                 == [1,2]--- dfs [2]   $ 'edge' 1 2                 == [2]--- dfs [3]   $ 'edge' 1 2                 == []--- dfs [1,2] $ 'edge' 1 2                 == [1,2]--- dfs [2,1] $ 'edge' 1 2                 == [2,1]--- dfs []    $ x                        == []--- dfs [1,4] $ 3 * (1 + 4) * (1 + 5)    == [1,5,4]--- 'isSubgraphOf' ('vertices' $ dfs vs x) x == True--- dfs [3] $ 'circuit' [1..5] + 'circuit' [5,4..1] == [3,2,1,5,4]+-- dfs 'empty'      vs    == []+-- dfs ('edge' 1 1) [1]   == [1]+-- dfs ('edge' 1 2) [0]   == []+-- dfs ('edge' 1 2) [1]   == [1,2]+-- dfs ('edge' 1 2) [2]   == [2]+-- dfs ('edge' 1 2) [1,2] == [1,2]+-- dfs ('edge' 1 2) [2,1] == [2,1]+-- dfs x          []    == []+--+-- 'Data.List.and' [ 'hasVertex' v x | v <- dfs x vs ]       == True+-- dfs (3 * (1 + 4) * (1 + 5)) [1,4]           == [1,5,4]+-- dfs ('circuit' [1..5] + 'circuit' [5,4..1]) [3] == [3,2,1,5,4] -- @-dfs :: [Int] -> AdjacencyIntMap -> [Int]-dfs vs = dfsForestFrom vs >=> flatten+dfs :: AdjacencyIntMap -> [Int] -> [Int]+dfs x = concatMap flatten . dfsForestFrom x --- | Return 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/.+-- | Return the list of vertices /reachable/ from a source vertex in a graph.+-- The vertices in the resulting list appear in the /depth-first search order/. ----- Complexity: /O(m*log n)/ time and /O(n)/ space.+-- Complexity: /O(m * log n)/ time and /O(n)/ space. -- -- @--- 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 'empty'              x == []+-- reachable ('vertex' 1)         1 == [1]+-- reachable ('edge' 1 1)         1 == [1]+-- reachable ('edge' 1 2)         0 == []+-- reachable ('edge' 1 2)         1 == [1,2]+-- reachable ('edge' 1 2)         2 == [2]+-- reachable ('path'    [1..8]  ) 4 == [4..8]+-- reachable ('circuit' [1..8]  ) 4 == [4..8] ++ [1..3]+-- reachable ('clique'  [8,7..1]) 8 == [8] ++ [1..7]+--+-- 'Data.List.and' [ 'hasVertex' v x | v <- reachable x y ] == True -- @-reachable :: Int -> AdjacencyIntMap -> [Int]-reachable x = dfs [x]+reachable :: AdjacencyIntMap -> Int -> [Int]+reachable x y = dfs x [y]  type Cycle = NonEmpty type Result = Either (Cycle Int) [Int]@@ -223,8 +231,8 @@            , entry  :: IntMap.IntMap NodeState            , order  :: [Int] } -topSort' :: AdjacencyIntMap -> StateT S (Cont Result) Result-topSort' g = liftCallCC' callCC $ \cyclic ->+topSortImpl :: AdjacencyIntMap -> StateT S (Cont Result) Result+topSortImpl g = liftCallCC' callCC $ \cyclic ->   do let vertices = map fst $ IntMap.toDescList $ adjacencyIntMap g          adjacent = IntSet.toDescList . flip postIntSet g          dfsRoot x = nodeState x >>= \case@@ -262,7 +270,7 @@ -- a cycle, where the connected components are ordered by their largest vertex -- with respect to @Ord a@. ----- Complexity: /O((n+m)*min(n,W))/ time and /O(n)/ space.+-- Complexity: /O((n + m) * min(n,W))/ time and /O(n)/ space. -- -- @ -- topSort (1 * 2 + 3 * 1)                    == Right [3,1,2]@@ -272,18 +280,18 @@ -- topSort ('path' [5,4..1] + 'edge' 2 4)         == Left (4 ':|' [3,2]) -- topSort ('circuit' [1..3])                   == Left (3 ':|' [1,2]) -- topSort ('circuit' [1..3] + 'circuit' [3,2,1]) == Left (3 ':|' [2])--- topSort (1*2 + 2*1 + 3*4 + 4*3 + 5*1)      == Left (1 ':|' [2])+-- topSort (1 * 2 + (5 + 2) * 1 + 3 * 4 * 3)  == Left (1 ':|' [2]) -- fmap ('flip' 'isTopSortOf' x) (topSort x)      /= Right False -- topSort . 'vertices'                         == Right . 'nub' . 'sort' -- @ topSort :: AdjacencyIntMap -> Either (Cycle Int) [Int]-topSort g = runCont (evalStateT (topSort' g) initialState) id+topSort g = runCont (evalStateT (topSortImpl g) initialState) id   where     initialState = S IntMap.empty IntMap.empty []  -- | Check if a given graph is /acyclic/. ----- Complexity: /O((n+m)*min(n,W))/ time and /O(n)/ space.+-- Complexity: /O((n + m) * min(n,W))/ time and /O(n)/ space. -- -- @ -- isAcyclic (1 * 2 + 3 * 1) == True

@@ -853,7 +853,7 @@ -- closure                 == 'reflexiveClosure' . 'transitiveClosure' -- closure                 == 'transitiveClosure' . 'reflexiveClosure' -- closure . closure       == closure--- 'postSet' x (closure y)   == Set.'Set.fromList' ('Algebra.Graph.ToGraph.reachable' x y)+-- 'postSet' x (closure y)   == Set.'Set.fromList' ('Algebra.Graph.ToGraph.reachable' y x) -- @ closure :: Ord a => AdjacencyMap a -> AdjacencyMap a closure = reflexiveClosure . transitiveClosure

@@ -48,79 +48,96 @@ -- vertices are explored in increasing order according to their 'Ord' instance. -- The search is seeded by a list of vertices that will become the roots of the -- resulting forest. Duplicates in the list will have their first occurrence--- expanded and subsequent ones ignored. The seed vertices that do not belong to+-- explored and subsequent ones ignored. The seed vertices that do not belong to -- the graph are also ignored. ----- Complexity: /O((L+m)*log n)/ time and /O(n)/ space, where /L/ is the number--- of seed vertices.+-- Complexity: /O((L + m) * log n)/ time and /O(n)/ space, where /L/ is the+-- number of seed vertices. -- -- @--- 'forest' (bfsForest [1,2] $ 'edge' 1 2)      == 'vertices' [1,2]--- 'forest' (bfsForest [2]   $ 'edge' 1 2)      == 'vertex' 2--- 'forest' (bfsForest [3]   $ 'edge' 1 2)      == 'empty'--- 'forest' (bfsForest [2,1] $ 'edge' 1 2)      == 'vertices' [1,2]--- 'isSubgraphOf' ('forest' $ bfsForest vs x) x == True--- bfsForest ('vertexList' g) g               == 'map' (\v -> Node v []) ('nub' $ 'vertexList' g)--- bfsForest [] x                           == []--- bfsForest [1,4] (3 * (1 + 4) * (1 + 5))  == [ Node { rootLabel = 1+-- 'forest' $ bfsForest ('edge' 1 2) [0]        == 'empty'+-- 'forest' $ bfsForest ('edge' 1 2) [1]        == 'edge' 1 2+-- 'forest' $ bfsForest ('edge' 1 2) [2]        == 'vertex' 2+-- 'forest' $ bfsForest ('edge' 1 2) [0,1,2]    == 'vertices' [1,2]+-- 'forest' $ bfsForest ('edge' 1 2) [2,1,0]    == 'vertices' [1,2]+-- 'forest' $ bfsForest ('edge' 1 1) [1]        == 'vertex' 1+-- 'isSubgraphOf' ('forest' $ bfsForest x vs) x == True+-- bfsForest x ('vertexList' x)               == 'map' (\\v -> Node v []) ('Data.List.nub' $ 'vertexList' x)+-- bfsForest x []                           == []+-- bfsForest 'empty' vs                       == []+-- bfsForest (3 * (1 + 4) * (1 + 5)) [1,4]  == [ Node { rootLabel = 1 --                                                    , subForest = [ Node { rootLabel = 5 --                                                                         , subForest = [] }]} --                                             , Node { rootLabel = 4 --                                                    , subForest = [] }]--- 'forest' (bfsForest [3] ('circuit' [1..5] + 'circuit' [5,4..1])) == 'path' [3,2,1] + 'path' [3,4,5]+-- 'forest' $ bfsForest ('circuit' [1..5] + 'circuit' [5,4..1]) [3] == 'path' [3,2,1] + 'path' [3,4,5] -- -- @-bfsForest :: Ord a => [a] -> AdjacencyMap a -> Forest a-bfsForest vs g = evalState (explore [ v | v <- vs, hasVertex v g ]) Set.empty where-  explore = unfoldForestM_BF walk <=< filterM discovered-  walk v = (v,) <$> adjacentM v-  adjacentM v = filterM discovered $ Set.toList (postSet v g)-  discovered v = do new <- gets (not . Set.member v)-                    when new $ modify' (Set.insert v)-                    return new+bfsForest :: Ord a => AdjacencyMap a -> [a] -> Forest a+bfsForest x vs = evalState (explore [ v | v <- vs, hasVertex v x ]) Set.empty+  where+    explore = filterM discovered >=> unfoldForestM_BF walk+    walk v = (v,) <$> adjacentM v+    adjacentM v = filterM discovered $ Set.toList (postSet v x)+    discovered v = do new <- gets (not . Set.member v)+                      when new $ modify' (Set.insert v)+                      return new  -- | A version of 'bfsForest' where the resulting forest is converted to a level -- structure. Adjacent vertices are explored in the increasing order according--- to their 'Ord' instance. Flattening the result via @'concat'@ @.@ @'bfs'@ @vs@--- gives an enumeration of vertices reachable from @vs@ in the BFS order.+-- to their 'Ord' instance. Flattening the result via @'concat'@ @.@ @'bfs'@ @x@+-- gives an enumeration of reachable vertices in the breadth-first search order. ----- Complexity: /O((L+m)*min(n,W))/ time and /O(n)/ space, where /L/ is the+-- Complexity: /O((L + m) * min(n,W))/ time and /O(n)/ space, where /L/ is the -- number of seed vertices. -- -- @--- bfs vs 'empty'                                         == []--- bfs [] g                                             == []--- bfs [1]   ('edge' 1 1)                                 == [[1]]--- bfs [1]   ('edge' 1 2)                                 == [[1],[2]]--- bfs [2]   ('edge' 1 2)                                 == [[2]]--- bfs [1,2] ('edge' 1 2)                                 == [[1,2]]--- bfs [2,1] ('edge' 1 2)                                 == [[2,1]]--- bfs [3]   ('edge' 1 2)                                 == []--- bfs [1,2] ( (1*2) + (3*4) + (5*6) )                  == [[1,2]]--- bfs [1,3] ( (1*2) + (3*4) + (5*6) )                  == [[1,3],[2,4]]--- bfs [3] (3 * (1 + 4) * (1 + 5))                      == [[3],[1,4,5]]--- bfs [2] ('circuit' [1..5] + 'circuit' [5,4..1])          == [[2],[1,3],[5,4]]--- 'concat' (bfs [3] $ 'circuit' [1..5] + 'circuit' [5,4..1]) == [3,2,4,1,5]--- bfs vs == 'map' 'concat' . 'List.transpose' . 'map' 'levels' . 'bfsForest' vs+-- bfs ('edge' 1 2) [0]                == []+-- bfs ('edge' 1 2) [1]                == [[1], [2]]+-- bfs ('edge' 1 2) [2]                == [[2]]+-- bfs ('edge' 1 2) [1,2]              == [[1,2]]+-- bfs ('edge' 1 2) [2,1]              == [[2,1]]+-- bfs ('edge' 1 1) [1]                == [[1]]+-- bfs 'empty' vs                      == []+-- bfs x []                          == []+-- bfs (1 * 2 + 3 * 4 + 5 * 6) [1,2] == [[1,2]]+-- bfs (1 * 2 + 3 * 4 + 5 * 6) [1,3] == [[1,3], [2,4]]+-- bfs (3 * (1 + 4) * (1 + 5)) [3]   == [[3], [1,4,5]]+--+-- bfs ('circuit' [1..5] + 'circuit' [5,4..1]) [3]          == [[2], [1,3], [5,4]]+-- 'concat' $ bfs ('circuit' [1..5] + 'circuit' [5,4..1]) [3] == [3,2,4,1,5]+-- 'map' 'concat' . 'List.transpose' . 'map' 'levels' . 'bfsForest' x    == bfs x -- @-bfs :: Ord a => [a] -> AdjacencyMap a -> [[a]]-bfs vs = map concat . List.transpose . map levels . bfsForest vs+bfs :: Ord a => AdjacencyMap a -> [a] -> [[a]]+bfs x = map concat . List.transpose . map levels . bfsForest x +dfsForestFromImpl :: Ord a => AdjacencyMap a -> [a] -> Forest a+dfsForestFromImpl g vs = evalState (explore vs) Set.empty+  where+    explore (v:vs) = discovered v >>= \case+      True -> (:) <$> walk v <*> explore vs+      False -> explore vs+    explore [] = return []+    walk v = Node v <$> explore (adjacent v)+    adjacent v = Set.toList (postSet v g)+    discovered v = do new <- gets (not . Set.member v)+                      when new $ modify' (Set.insert v)+                      return new+ -- | Compute the /depth-first search/ forest of a graph, where adjacent vertices -- are explored in the increasing order according to their 'Ord' instance. ----- Complexity: /O((n+m)*min(n,W))/ time and /O(n)/ space.+-- Complexity: /O((n + m) * min(n,W))/ time and /O(n)/ space. -- -- @--- dfsForest 'empty'                       == []--- 'forest' (dfsForest $ 'edge' 1 1)         == 'vertex' 1--- 'forest' (dfsForest $ 'edge' 1 2)         == 'edge' 1 2--- 'forest' (dfsForest $ 'edge' 2 1)         == 'vertices' [1,2]+-- 'forest' $ dfsForest 'empty'              == 'empty'+-- 'forest' $ dfsForest ('edge' 1 1)         == 'vertex' 1+-- 'forest' $ dfsForest ('edge' 1 2)         == 'edge' 1 2+-- 'forest' $ dfsForest ('edge' 2 1)         == 'vertices' [1,2] -- 'isSubgraphOf' ('forest' $ dfsForest x) x == True -- 'isDfsForestOf' (dfsForest x) x         == True -- dfsForest . 'forest' . dfsForest        == dfsForest -- dfsForest ('vertices' vs)               == 'map' (\\v -> Node v []) ('Data.List.nub' $ 'Data.List.sort' vs)--- 'dfsForestFrom' ('vertexList' x) x        == dfsForest x -- dfsForest $ 3 * (1 + 4) * (1 + 5)     == [ Node { rootLabel = 1 --                                                 , subForest = [ Node { rootLabel = 5 --                                                                      , subForest = [] }]}@@ -130,7 +147,7 @@ -- 'forest' (dfsForest $ 'circuit' [1..5] + 'circuit' [5,4..1]) == 'path' [1,2,3,4,5] -- @ dfsForest :: Ord a => AdjacencyMap a -> Forest a-dfsForest g = dfsForestFrom' (vertexList g) g+dfsForest g = dfsForestFromImpl g (vertexList g)  -- | Compute the /depth-first search/ forest of a graph starting from the given -- seed vertices, where adjacent vertices are explored in the increasing order@@ -138,84 +155,75 @@ -- necessarily span the whole graph, as some vertices may be unreachable. The -- seed vertices which do not belong to the graph are ignored. ----- Complexity: /O((L+m)*log n)/ time and /O(n)/ space, where /L/ be the number--- of seed vertices.+-- Complexity: /O((L + m) * log n)/ time and /O(n)/ space, where /L/ is the+-- number of seed vertices. -- -- @--- dfsForestFrom vs 'empty'                           == []--- 'forest' (dfsForestFrom [1]   $ 'edge' 1 1)          == 'vertex' 1--- 'forest' (dfsForestFrom [1]   $ 'edge' 1 2)          == 'edge' 1 2--- 'forest' (dfsForestFrom [2]   $ 'edge' 1 2)          == 'vertex' 2--- 'forest' (dfsForestFrom [3]   $ 'edge' 1 2)          == 'empty'--- 'forest' (dfsForestFrom [2,1] $ 'edge' 1 2)          == 'vertices' [1,2]--- 'isSubgraphOf' ('forest' $ dfsForestFrom vs x) x     == True--- 'isDfsForestOf' (dfsForestFrom ('vertexList' x) x) x == True--- dfsForestFrom ('vertexList' x) x                   == 'dfsForest' x--- dfsForestFrom vs             ('vertices' vs)       == 'map' (\\v -> Node v []) ('Data.List.nub' vs)--- dfsForestFrom []             x                   == []--- dfsForestFrom [1,4] $ 3 * (1 + 4) * (1 + 5)      == [ Node { rootLabel = 1+-- 'forest' $ dfsForestFrom 'empty'      vs             == 'empty'+-- 'forest' $ dfsForestFrom ('edge' 1 1) [1]            == 'vertex' 1+-- 'forest' $ dfsForestFrom ('edge' 1 2) [0]            == 'empty'+-- 'forest' $ dfsForestFrom ('edge' 1 2) [1]            == 'edge' 1 2+-- 'forest' $ dfsForestFrom ('edge' 1 2) [2]            == 'vertex' 2+-- 'forest' $ dfsForestFrom ('edge' 1 2) [1,2]          == 'edge' 1 2+-- 'forest' $ dfsForestFrom ('edge' 1 2) [2,1]          == 'vertices' [1,2]+-- 'isSubgraphOf' ('forest' $ dfsForestFrom x vs) x     == True+-- 'isDfsForestOf' (dfsForestFrom x ('vertexList' x)) x == True+-- dfsForestFrom x ('vertexList' x)                   == 'dfsForest' x+-- dfsForestFrom x []                               == []+-- dfsForestFrom (3 * (1 + 4) * (1 + 5)) [1,4]      == [ Node { rootLabel = 1 --                                                            , subForest = [ Node { rootLabel = 5 --                                                                                 , subForest = [] } --                                                     , Node { rootLabel = 4 --                                                            , subForest = [] }]---  'forest' (dfsForestFrom [3] $ 'circuit' [1..5] + 'circuit' [5,4..1]) == 'path' [3,2,1,5,4]+-- 'forest' $ dfsForestFrom ('circuit' [1..5] + 'circuit' [5,4..1]) [3] == 'path' [3,2,1,5,4] -- @-dfsForestFrom :: Ord a => [a] -> AdjacencyMap a -> Forest a-dfsForestFrom vs g = dfsForestFrom' [ v | v <- vs, hasVertex v g ] g--dfsForestFrom' :: Ord a => [a] -> AdjacencyMap a -> Forest a-dfsForestFrom' vs g = evalState (explore vs) Set.empty where-  explore (v:vs) = discovered v >>= \case-    True -> (:) <$> walk v <*> explore vs-    False -> explore vs-  explore [] = return []-  walk v = Node v <$> explore (adjacent v)-  adjacent v = Set.toList (postSet v g)-  discovered v = do new <- gets (not . Set.member v)-                    when new $ modify' (Set.insert v)-                    return new+dfsForestFrom :: Ord a => AdjacencyMap a -> [a] -> Forest a+dfsForestFrom g vs = dfsForestFromImpl g [ v | v <- vs, hasVertex v g ]  -- | Return the list vertices visited by the /depth-first search/ in a graph, -- starting from the given seed vertices. Adjacent vertices are explored in the -- increasing order according to their 'Ord' instance. ----- Complexity: /O((L+m)*log n)/ time and /O(n)/ space, where /L/ is the number--- of seed vertices.+-- Complexity: /O((L + m) * log n)/ time and /O(n)/ space, where /L/ is the+-- number of seed vertices. -- -- @--- dfs vs    $ 'empty'                    == []--- dfs [1]   $ 'edge' 1 1                 == [1]--- dfs [1]   $ 'edge' 1 2                 == [1,2]--- dfs [2]   $ 'edge' 1 2                 == [2]--- dfs [3]   $ 'edge' 1 2                 == []--- dfs [1,2] $ 'edge' 1 2                 == [1,2]--- dfs [2,1] $ 'edge' 1 2                 == [2,1]--- dfs []    $ x                        == []--- dfs [1,4] $ 3 * (1 + 4) * (1 + 5)    == [1,5,4]--- 'isSubgraphOf' ('vertices' $ dfs vs x) x == True--- dfs [3] $ 'circuit' [1..5] + 'circuit' [5,4..1] == [3,2,1,5,4]+-- dfs 'empty'      vs    == []+-- dfs ('edge' 1 1) [1]   == [1]+-- dfs ('edge' 1 2) [0]   == []+-- dfs ('edge' 1 2) [1]   == [1,2]+-- dfs ('edge' 1 2) [2]   == [2]+-- dfs ('edge' 1 2) [1,2] == [1,2]+-- dfs ('edge' 1 2) [2,1] == [2,1]+-- dfs x          []    == []+--+-- 'Data.List.and' [ 'hasVertex' v x | v <- dfs x vs ]       == True+-- dfs (3 * (1 + 4) * (1 + 5)) [1,4]           == [1,5,4]+-- dfs ('circuit' [1..5] + 'circuit' [5,4..1]) [3] == [3,2,1,5,4] -- @-dfs :: Ord a => [a] -> AdjacencyMap a -> [a]-dfs vs = dfsForestFrom vs >=> flatten+dfs :: Ord a => AdjacencyMap a -> [a] -> [a]+dfs x = concatMap flatten . dfsForestFrom x --- | Return 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/.+-- | Return the list of vertices /reachable/ from a source vertex in a graph.+-- The vertices in the resulting list appear in the /depth-first search order/. ----- Complexity: /O(m*log n)/ time and /O(n)/ space.+-- Complexity: /O(m * log n)/ time and /O(n)/ space. -- -- @--- 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 'empty'              x == []+-- reachable ('vertex' 1)         1 == [1]+-- reachable ('edge' 1 1)         1 == [1]+-- reachable ('edge' 1 2)         0 == []+-- reachable ('edge' 1 2)         1 == [1,2]+-- reachable ('edge' 1 2)         2 == [2]+-- reachable ('path'    [1..8]  ) 4 == [4..8]+-- reachable ('circuit' [1..8]  ) 4 == [4..8] ++ [1..3]+-- reachable ('clique'  [8,7..1]) 8 == [8] ++ [1..7]+--+-- 'Data.List.and' [ 'hasVertex' v x | v <- reachable x y ] == True -- @-reachable :: Ord a => a -> AdjacencyMap a -> [a]-reachable x = dfs [x]+reachable :: Ord a => AdjacencyMap a -> a -> [a]+reachable x y = dfs x [y]  type Cycle = NonEmpty type Result a = Either (Cycle a) [a]@@ -224,8 +232,8 @@              , entry  :: Map.Map a NodeState              , order  :: [a] } -topSort' :: Ord a => AdjacencyMap a -> StateT (S a) (Cont (Result a)) (Result a)-topSort' g = liftCallCC' callCC $ \cyclic ->+topSortImpl :: Ord a => AdjacencyMap a -> StateT (S a) (Cont (Result a)) (Result a)+topSortImpl g = liftCallCC' callCC $ \cyclic ->   do let vertices = map fst $ Map.toDescList $ adjacencyMap g          adjacent = Set.toDescList . flip postSet g          dfsRoot x = nodeState x >>= \case@@ -263,7 +271,7 @@ -- a cycle, where the connected components are ordered by their largest vertex -- with respect to @Ord a@. ----- Complexity: /O((n+m)*min(n,W))/ time and /O(n)/ space.+-- Complexity: /O((n + m) * min(n,W))/ time and /O(n)/ space. -- -- @ -- topSort (1 * 2 + 3 * 1)                    == Right [3,1,2]@@ -273,13 +281,13 @@ -- topSort ('path' [5,4..1] + 'edge' 2 4)         == Left (4 ':|' [3,2]) -- topSort ('circuit' [1..3])                   == Left (3 ':|' [1,2]) -- topSort ('circuit' [1..3] + 'circuit' [3,2,1]) == Left (3 ':|' [2])--- topSort (1*2 + 2*1 + 3*4 + 4*3 + 5*1)      == Left (1 ':|' [2])+-- topSort (1 * 2 + (5 + 2) * 1 + 3 * 4 * 3)  == Left (1 ':|' [2]) -- fmap ('flip' 'isTopSortOf' x) (topSort x)      /= Right False -- 'isRight' . topSort                          == 'isAcyclic' -- topSort . 'vertices'                         == Right . 'nub' . 'sort' -- @ topSort :: Ord a => AdjacencyMap a -> Either (Cycle a) [a]-topSort g = runCont (evalStateT (topSort' g) initialState) id+topSort g = runCont (evalStateT (topSortImpl g) initialState) id   where     initialState = S Map.empty Map.empty [] 

@@ -52,10 +52,13 @@ import Algebra.Graph.Label  import qualified Algebra.Graph.Labelled.AdjacencyMap as AM-import qualified Data.Set                            as Set-import qualified Data.Map                            as Map-import qualified GHC.Exts                            as Exts+import qualified Algebra.Graph.ToGraph               as T +import qualified Data.IntSet as IntSet+import qualified Data.Set    as Set+import qualified Data.Map    as Map+import qualified GHC.Exts    as Exts+ -- | Edge-labelled graphs, where the type variable @e@ stands for edge labels. -- For example, 'Graph' @Bool@ @a@ is isomorphic to unlabelled graphs defined in -- the top-level module "Algebra.Graph.Graph", where @False@ and @True@ denote@@ -100,6 +103,17 @@ instance Monoid e => Monoid (Graph e a) where     mempty = empty +-- TODO: Add tests.+instance (Eq e, Monoid e, Ord a) => T.ToGraph (Graph e a) where+    type ToVertex (Graph e a)  = a+    foldg e v o c              = foldg e v (\e -> if e == mempty then o else c)+    vertexList                 = vertexList+    vertexSet                  = vertexSet+    toAdjacencyMap             = AM.skeleton . toAdjacencyMap+    toAdjacencyMapTranspose    = T.toAdjacencyMap . transpose+    toAdjacencyIntMap          = T.toAdjacencyIntMap . toAdjacencyMap+    toAdjacencyIntMapTranspose = T.toAdjacencyIntMap . T.toAdjacencyMapTranspose+ -- TODO: This is a very inefficient implementation. Find a way to construct an -- adjacency map directly, without building intermediate representations for all -- subgraphs.@@ -558,7 +572,7 @@ -- closure               == 'reflexiveClosure' . 'transitiveClosure' -- closure               == 'transitiveClosure' . 'reflexiveClosure' -- closure . closure     == closure--- 'Algebra.Graph.ToGraph.postSet' x (closure y) == Set.'Set.fromList' ('Algebra.Graph.ToGraph.reachable' x y)+-- 'Algebra.Graph.ToGraph.postSet' x (closure y) == Set.'Set.fromList' ('Algebra.Graph.ToGraph.reachable' y x) -- @ closure :: (Eq e, Ord a, StarSemiring e) => Graph e a -> Graph e a closure = fromAdjacencyMap . AM.closure . toAdjacencyMap

@@ -52,9 +52,12 @@ import Algebra.Graph.Label  import qualified Algebra.Graph.AdjacencyMap as AM-import qualified Data.Map.Strict            as Map-import qualified Data.Set                   as Set+import qualified Algebra.Graph.ToGraph      as T +import qualified Data.IntSet     as IntSet+import qualified Data.Map.Strict as Map+import qualified Data.Set        as Set+ -- | Edge-labelled graphs, where the type variable @e@ stands for edge labels. -- For example, 'AdjacencyMap' @Bool@ @a@ is isomorphic to unlabelled graphs -- defined in the top-level module "Algebra.Graph.AdjacencyMap", where @False@@@ -121,6 +124,30 @@ instance (Ord a, Eq e, Monoid e) => Monoid (AdjacencyMap e a) where     mempty = empty +-- TODO: Add tests.+-- | Defined via 'skeleton' and the 'T.ToGraph' instance of 'AM.AdjacencyMap'.+instance (Eq e, Monoid e, Ord a) => T.ToGraph (AdjacencyMap e a) where+    type ToVertex (AdjacencyMap e a) = a+    toGraph                    = T.toGraph . skeleton+    foldg e v o c              = T.foldg e v o c . skeleton+    isEmpty                    = isEmpty+    hasVertex                  = hasVertex+    hasEdge                    = hasEdge+    vertexCount                = vertexCount+    edgeCount                  = edgeCount+    vertexList                 = vertexList+    vertexSet                  = vertexSet+    vertexIntSet               = IntSet.fromAscList . vertexList+    edgeList                   = T.edgeList . skeleton+    edgeSet                    = T.edgeSet . skeleton+    adjacencyList              = T.adjacencyList . skeleton+    preSet                     = preSet+    postSet                    = postSet+    toAdjacencyMap             = skeleton+    toAdjacencyIntMap          = T.toAdjacencyIntMap . skeleton+    toAdjacencyMapTranspose    = T.toAdjacencyMapTranspose . skeleton+    toAdjacencyIntMapTranspose = T.toAdjacencyIntMapTranspose . skeleton+ -- | Construct the /empty graph/. -- -- @@@ -632,7 +659,7 @@ -- closure               == 'reflexiveClosure' . 'transitiveClosure' -- closure               == 'transitiveClosure' . 'reflexiveClosure' -- closure . closure     == closure--- 'postSet' x (closure y) == Set.'Set.fromList' ('Algebra.Graph.ToGraph.reachable' x y)+-- 'postSet' x (closure y) == Set.'Set.fromList' ('Algebra.Graph.ToGraph.reachable' y x) -- @ closure :: (Eq e, Ord a, StarSemiring e) => AdjacencyMap e a -> AdjacencyMap e a closure = goWarshallFloydKleene . reflexiveClosure

@@ -16,6 +16,7 @@ ----------------------------------------------------------------------------- module Algebra.Graph.Labelled.Example.Automaton where +import Control.Arrow ((&&&)) import Data.Map    (Map) import Data.Monoid (Any (..)) @@ -42,10 +43,10 @@ -- | An example automaton for ordering coffee or tea. -- -- @--- order = 'overlays' [ 'Choice'  '-<'['Coffee', 'Tea']'>-' 'Payment'---                  , 'Choice'  '-<'['Cancel'     ]'>-' 'Complete'---                  , 'Payment' '-<'['Cancel'     ]'>-' 'Choice'---                  , 'Payment' '-<'['Pay'        ]'>-' 'Complete' ]+-- coffeeTeaAutomaton = 'overlays' [ 'Choice'  '-<'['Coffee', 'Tea']'>-' 'Payment'+--                               , 'Payment' '-<'['Pay'        ]'>-' 'Complete'+--                               , 'Choice'  '-<'['Cancel'     ]'>-' 'Complete'+--                               , 'Payment' '-<'['Cancel'     ]'>-' 'Choice' ] -- @ coffeeTeaAutomaton :: Automaton Alphabet State coffeeTeaAutomaton = overlays [ Choice  -<[Coffee, Tea]>- Payment@@ -56,7 +57,9 @@ -- | The map of 'State' reachability. -- -- @--- reachability = Map.'Map.fromList' $ map (\s -> (s, 'reachable' s 'order')) ['Choice' ..]+-- reachability = Map.'Map.fromList' $ map ('id' '&&&' 'reachable' skeleton) ['Choice' ..]+--   where+--     skeleton = emap (Any . not . 'isZero') coffeeTeaAutomaton -- @ -- -- Or, when evaluated:@@ -67,7 +70,7 @@ --                             , ('Complete', ['Complete'                   ]) ] -- @ reachability :: Map State [State]-reachability = Map.fromList $ map (\s -> (s, reachable s skeleton)) [Choice ..]+reachability = Map.fromList $ map (id &&& reachable skeleton) [Choice ..]   where     skeleton :: Graph Any State     skeleton = emap (Any . not . isZero) coffeeTeaAutomaton

@@ -913,15 +913,15 @@  -- | /Sparsify/ a graph by adding intermediate 'Left' @Int@ vertices between the -- original vertices (wrapping the latter in 'Right') such that the resulting--- graph is /sparse/, i.e. contains only O(s) edges, but preserves the+-- graph is /sparse/, i.e. contains only /O(s)/ edges, but preserves the -- reachability relation between the original vertices. Sparsification is useful -- when working with dense graphs, as it can reduce the number of edges from--- O(n^2) down to O(n) by replacing cliques, bicliques and similar densely+-- /O(n^2)/ down to /O(n)/ by replacing cliques, bicliques and similar densely -- connected structures by sparse subgraphs built out of intermediate vertices.--- Complexity: O(s) time, memory and size.+-- Complexity: /O(s)/ time, memory and size. -- -- @--- 'Data.List.sort' . 'Algebra.Graph.ToGraph.reachable' x       == 'Data.List.sort' . 'Data.Either.rights' . 'Algebra.Graph.ToGraph.reachable' ('Data.Either.Right' x) . sparsify+-- 'Data.List.sort' . 'Algebra.Graph.ToGraph.reachable' x       == 'Data.List.sort' . 'Data.Either.rights' . 'Algebra.Graph.ToGraph.reachable' (sparsify x) . 'Data.Either.Right' -- 'vertexCount' (sparsify x) <= 'vertexCount' x + 'size' x + 1 -- 'edgeCount'   (sparsify x) <= 3 * 'size' x -- 'size'        (sparsify x) <= 3 * 'size' x@@ -950,7 +950,7 @@ -- contain a quadratic /O(s^2)/ number of edges. -- -- @--- 'Data.List.sort' . 'Algebra.Graph.ToGraph.reachable' k                 == 'Data.List.sort' . 'filter' (<= n) . 'flip' 'Data.Graph.reachable' k . sparsifyKL n+-- 'Data.List.sort' . 'Algebra.Graph.ToGraph.reachable' x                 == 'Data.List.sort' . 'filter' (<= n) . 'Data.Graph.reachable' (sparsifyKL n x) -- 'length' ('Data.Graph.vertices' $ sparsifyKL n x) <= 'vertexCount' x + 'size' x + 1 -- 'length' ('Data.Graph.edges'    $ sparsifyKL n x) <= 3 * 'size' x -- @

@@ -656,7 +656,7 @@ -- closure                  == 'reflexiveClosure' . 'transitiveClosure' -- closure                  == 'transitiveClosure' . 'reflexiveClosure' -- closure . closure        == closure--- 'postSet' x (closure y)    == Set.'Set.fromList' ('Algebra.Graph.ToGraph.reachable' x y)+-- 'postSet' x (closure y)    == Set.'Set.fromList' ('Algebra.Graph.ToGraph.reachable' y x) -- @ closure :: Ord a => AdjacencyMap a -> AdjacencyMap a closure = coerce AM.closure

@@ -49,12 +49,18 @@ import Data.Tree import Data.Tuple -import qualified Data.Maybe as Maybe-import qualified Data.Set   as Set-import qualified Data.Tree  as Tree+import qualified Data.IntSet as IntSet+import qualified Data.Maybe  as Maybe+import qualified Data.Set    as Set+import qualified Data.Tree   as Tree  import Algebra.Graph.Internal +import qualified Algebra.Graph                 as G+import qualified Algebra.Graph.AdjacencyIntMap as AIM+import qualified Algebra.Graph.AdjacencyMap    as AM+import qualified Algebra.Graph.ToGraph         as T+ {-| The 'Relation' data type represents a graph as a /binary relation/. We define a 'Num' instance as a convenient notation for working with graphs: @@ -205,6 +211,26 @@ instance Ord a => Monoid (Relation a) where     mempty = empty +instance Ord a => T.ToGraph (Relation a) where+    type ToVertex (Relation a) = a+    toGraph r                  = G.vertices (Set.toList $ domain   r) `G.overlay`+                                 G.edges    (Set.toList $ relation r)+    isEmpty                    = isEmpty+    hasVertex                  = hasVertex+    hasEdge                    = hasEdge+    vertexCount                = vertexCount+    edgeCount                  = edgeCount+    vertexList                 = vertexList+    vertexSet                  = vertexSet+    vertexIntSet               = IntSet.fromAscList . vertexList+    edgeList                   = edgeList+    edgeSet                    = edgeSet+    adjacencyList              = adjacencyList+    toAdjacencyMap             = AM.stars . adjacencyList+    toAdjacencyIntMap          = AIM.stars . adjacencyList+    toAdjacencyMapTranspose    = AM.transpose . T.toAdjacencyMap+    toAdjacencyIntMapTranspose = AIM.transpose . T.toAdjacencyIntMap+ -- | Construct the /empty graph/. -- -- @@@ -778,7 +804,7 @@ -- closure                 == 'reflexiveClosure' . 'transitiveClosure' -- closure                 == 'transitiveClosure' . 'reflexiveClosure' -- closure . closure       == closure--- 'postSet' x (closure y)   == Set.'Set.fromList' ('Algebra.Graph.ToGraph.reachable' x y)+-- 'postSet' x (closure y)   == Set.'Set.fromList' ('Algebra.Graph.ToGraph.reachable' y x) -- @ closure :: Ord a => Relation a -> Relation a closure = reflexiveClosure . transitiveClosure

@@ -13,8 +13,8 @@ -- import qualified Algebra.Graph.Relation.Symmetric as Symmetric -- @ ----- 'Relation' is an instance of the 'Algebra.Graph.Class.Graph' type--- class, which can be used for polymorphic graph construction and manipulation.+-- 'Relation' is an instance of the 'Algebra.Graph.Class.Graph' type class,+-- which can be used for polymorphic graph construction and manipulation. ----------------------------------------------------------------------------- module Algebra.Graph.Relation.Symmetric (     -- * Data structure@@ -47,9 +47,14 @@ import Data.String import Data.Tree -import qualified Data.Set as Set+import qualified Data.IntSet as IntSet+import qualified Data.Set    as Set -import qualified Algebra.Graph.Relation as R+import qualified Algebra.Graph                 as G+import qualified Algebra.Graph.AdjacencyIntMap as AIM+import qualified Algebra.Graph.AdjacencyMap    as AM+import qualified Algebra.Graph.ToGraph         as T+import qualified Algebra.Graph.Relation        as R  {-| This data type represents a /symmetric binary relation/ over a set of elements of type @a@. Symmetric relations satisfy all laws of the@@ -138,8 +143,28 @@ instance Ord a => Monoid (Relation a) where     mempty = empty +-- | Defined via 'fromSymmetric' and the 'T.ToGraph' instance of 'R.Relation'.+instance Ord a => T.ToGraph (Relation a) where+    type ToVertex (Relation a) = a+    toGraph                    = T.toGraph . fromSymmetric+    isEmpty                    = isEmpty+    hasVertex                  = hasVertex+    hasEdge                    = hasEdge+    vertexCount                = vertexCount+    edgeCount                  = R.edgeCount . fromSymmetric+    vertexList                 = vertexList+    vertexSet                  = vertexSet+    vertexIntSet               = IntSet.fromAscList . vertexList+    edgeList                   = R.edgeList . fromSymmetric+    edgeSet                    = R.relation . fromSymmetric+    adjacencyList              = adjacencyList+    toAdjacencyMap             = T.toAdjacencyMap . fromSymmetric+    toAdjacencyIntMap          = T.toAdjacencyIntMap . fromSymmetric+    toAdjacencyMapTranspose    = T.toAdjacencyMap    -- No need to transpose!+    toAdjacencyIntMapTranspose = T.toAdjacencyIntMap -- No need to transpose!+ -- | Construct a symmetric relation from a given "Algebra.Graph.Relation".--- Complexity: /O(m*log(m))/ time.+-- Complexity: /O(m * log(m))/ time. -- -- @ -- toSymmetric ('Algebra.Graph.Relation.edge' 1 2)         == 'edge' 1 2

@@ -55,21 +55,22 @@ import Data.Set    (Set) import Data.Tree -import qualified Algebra.Graph                                as G-import qualified Algebra.Graph.AdjacencyMap                   as AM-import qualified Algebra.Graph.AdjacencyMap.Algorithm         as AM-import qualified Algebra.Graph.Labelled                       as LG-import qualified Algebra.Graph.Labelled.AdjacencyMap          as LAM-import qualified Algebra.Graph.NonEmpty.AdjacencyMap          as NAM-import qualified Algebra.Graph.AdjacencyIntMap                as AIM-import qualified Algebra.Graph.AdjacencyIntMap.Algorithm      as AIM-import qualified Algebra.Graph.Relation                       as R-import qualified Algebra.Graph.Relation.Symmetric             as SR-import qualified Data.IntMap                                  as IntMap-import qualified Data.IntSet                                  as IntSet-import qualified Data.Map                                     as Map-import qualified Data.Set                                     as Set+import qualified Data.IntMap as IntMap+import qualified Data.IntSet as IntSet+import qualified Data.Map    as Map+import qualified Data.Set    as Set +-- Ideally, we would define all instances in the modules where the corresponding+-- data types are declared. However, that causes import cycles, so we define a+-- few instances here.++import qualified Algebra.Graph                           as G+import qualified Algebra.Graph.AdjacencyMap              as AM+import qualified Algebra.Graph.AdjacencyMap.Algorithm    as AM+import qualified Algebra.Graph.NonEmpty.AdjacencyMap     as NAM+import qualified Algebra.Graph.AdjacencyIntMap           as AIM+import qualified Algebra.Graph.AdjacencyIntMap.Algorithm as AIM+ -- | The 'ToGraph' type class captures data types that can be converted to -- algebraic graphs. Instances of this type class should satisfy the laws -- specified by the default method definitions.@@ -236,29 +237,29 @@     -- necessarily span the whole graph, as some vertices may be unreachable.     --     -- @-    -- dfsForestFrom vs == Algebra.Graph.AdjacencyMap.'AM.dfsForestFrom' vs . toAdjacencyMap+    -- dfsForestFrom == Algebra.Graph.AdjacencyMap.'AM.dfsForestFrom' . toAdjacencyMap     -- @-    dfsForestFrom :: Ord (ToVertex t) => [ToVertex t] -> t -> Forest (ToVertex t)-    dfsForestFrom vs = AM.dfsForestFrom vs . toAdjacencyMap+    dfsForestFrom :: Ord (ToVertex t) => t -> [ToVertex t] -> Forest (ToVertex t)+    dfsForestFrom = AM.dfsForestFrom . toAdjacencyMap      -- | Compute the list of vertices visited by the /depth-first search/ in a     -- graph, when searching from each of the given vertices in order.     --     -- @-    -- dfs vs == Algebra.Graph.AdjacencyMap.'AM.dfs' vs . toAdjacencyMap+    -- dfs == Algebra.Graph.AdjacencyMap.'AM.dfs' . toAdjacencyMap     -- @-    dfs :: Ord (ToVertex t) => [ToVertex t] -> t -> [ToVertex t]-    dfs vs = AM.dfs vs . toAdjacencyMap+    dfs :: Ord (ToVertex t) => t -> [ToVertex t] -> [ToVertex t]+    dfs = AM.dfs . toAdjacencyMap      -- | 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 == Algebra.Graph.AdjacencyMap.'AM.reachable' x . toAdjacencyMap+    -- reachable == Algebra.Graph.AdjacencyMap.'AM.reachable' . toAdjacencyMap     -- @-    reachable :: Ord (ToVertex t) => ToVertex t -> t -> [ToVertex t]-    reachable x = AM.reachable x . toAdjacencyMap+    reachable :: Ord (ToVertex t) => t -> ToVertex t -> [ToVertex t]+    reachable = AM.reachable . toAdjacencyMap      -- | Compute the /topological sort/ of a graph or a @AM.Cycle@ if the     -- graph is cyclic.@@ -329,6 +330,7 @@     isTopSortOf :: Ord (ToVertex t) => [ToVertex t] -> t -> Bool     isTopSortOf vs = AM.isTopSortOf vs . toAdjacencyMap +-- | See "Algebra.Graph". instance Ord a => ToGraph (G.Graph a) where     type ToVertex (G.Graph a) = a     toGraph = id@@ -368,6 +370,7 @@     isDfsForestOf              = AM.isDfsForestOf     isTopSortOf                = AM.isTopSortOf +-- | See "Algebra.Graph.AdjacencyIntMap". instance ToGraph AIM.AdjacencyIntMap where     type ToVertex AIM.AdjacencyIntMap = Int     toGraph                    = G.stars@@ -400,42 +403,6 @@     isDfsForestOf              = AIM.isDfsForestOf     isTopSortOf                = AIM.isTopSortOf --- | See "Algebra.Graph.Labelled".-instance (Eq e, Monoid e, Ord a) => ToGraph (LG.Graph e a) where-    type ToVertex (LG.Graph e a) = a-    foldg e v o c              = LG.foldg e v (\e -> if e == mempty then o else c)-    vertexList                 = LG.vertexList-    vertexSet                  = LG.vertexSet-    toAdjacencyMap             = LAM.skeleton-                               . LG.foldg LAM.empty LAM.vertex LAM.connect-    toAdjacencyMapTranspose    = LAM.skeleton-                               . LG.foldg LAM.empty LAM.vertex (fmap flip LAM.connect)-    toAdjacencyIntMap          = toAdjacencyIntMap . toAdjacencyMap-    toAdjacencyIntMapTranspose = toAdjacencyIntMapTranspose . toAdjacencyMapTranspose---- | See "Algebra.Graph.Labelled.AdjacencyMap".-instance (Eq e, Monoid e, Ord a) => ToGraph (LAM.AdjacencyMap e a) where-    type ToVertex (LAM.AdjacencyMap e a) = a-    toGraph                    = toGraph . LAM.skeleton-    foldg e v o c              = foldg e v o c . LAM.skeleton-    isEmpty                    = LAM.isEmpty-    hasVertex                  = LAM.hasVertex-    hasEdge                    = LAM.hasEdge-    vertexCount                = LAM.vertexCount-    edgeCount                  = LAM.edgeCount-    vertexList                 = LAM.vertexList-    vertexSet                  = LAM.vertexSet-    vertexIntSet               = IntSet.fromAscList . LAM.vertexList-    edgeList                   = edgeList . LAM.skeleton-    edgeSet                    = edgeSet . LAM.skeleton-    adjacencyList              = adjacencyList . LAM.skeleton-    preSet                     = LAM.preSet-    postSet                    = LAM.postSet-    toAdjacencyMap             = LAM.skeleton-    toAdjacencyIntMap          = toAdjacencyIntMap . LAM.skeleton-    toAdjacencyMapTranspose    = toAdjacencyMapTranspose . LAM.skeleton-    toAdjacencyIntMapTranspose = toAdjacencyIntMapTranspose . LAM.skeleton- -- | See "Algebra.Graph.NonEmpty.AdjacencyMap". instance Ord a => ToGraph (NAM.AdjacencyMap a) where     type ToVertex (NAM.AdjacencyMap a) = a@@ -454,9 +421,9 @@     preSet                     = NAM.preSet     postSet                    = NAM.postSet     dfsForest                  = dfsForest . toAdjacencyMap-    dfsForestFrom xs           = dfsForestFrom xs . toAdjacencyMap-    dfs xs                     = dfs xs . toAdjacencyMap-    reachable x                = reachable x . toAdjacencyMap+    dfsForestFrom              = dfsForestFrom . toAdjacencyMap+    dfs                        = dfs . toAdjacencyMap+    reachable                  = reachable . toAdjacencyMap     topSort                    = topSort . toAdjacencyMap     isAcyclic                  = isAcyclic . toAdjacencyMap     toAdjacencyMap             = NAM.fromNonEmpty@@ -465,51 +432,6 @@     toAdjacencyIntMapTranspose = toAdjacencyIntMap . NAM.transpose     isDfsForestOf f            = isDfsForestOf f . toAdjacencyMap     isTopSortOf x              = isTopSortOf x . toAdjacencyMap---- TODO: Get rid of "Relation.Internal" and move this instance to "Relation".--- | See "Algebra.Graph.Relation".-instance Ord a => ToGraph (R.Relation a) where-    type ToVertex (R.Relation a) = a-    toGraph r                  = G.vertices (Set.toList $ R.domain   r) `G.overlay`-                                 G.edges    (Set.toList $ R.relation r)-    isEmpty                    = R.isEmpty-    hasVertex                  = R.hasVertex-    hasEdge                    = R.hasEdge-    vertexCount                = R.vertexCount-    edgeCount                  = R.edgeCount-    vertexList                 = R.vertexList-    vertexSet                  = R.vertexSet-    vertexIntSet               = IntSet.fromAscList . R.vertexList-    edgeList                   = R.edgeList-    edgeSet                    = R.edgeSet-    adjacencyList              = R.adjacencyList-    toAdjacencyMap             = AM.stars . R.adjacencyList-    toAdjacencyIntMap          = AIM.stars . R.adjacencyList-    toAdjacencyMapTranspose    = AM.transpose . toAdjacencyMap-    toAdjacencyIntMapTranspose = AIM.transpose . toAdjacencyIntMap---- TODO: This instance is probably wrong because of the way it treats edges.--- Find out a better way to integrate undirected graphs into 'ToGraph'.--- | See "Algebra.Graph.Symmetric.Relation". Warning: this instance is likely to--- be modified or removed in future.-instance Ord a => ToGraph (SR.Relation a) where-    type ToVertex (SR.Relation a) = a-    toGraph                    = toGraph . SR.fromSymmetric-    isEmpty                    = SR.isEmpty-    hasVertex                  = SR.hasVertex-    hasEdge                    = SR.hasEdge-    vertexCount                = SR.vertexCount-    edgeCount                  = SR.edgeCount-    vertexList                 = SR.vertexList-    vertexSet                  = SR.vertexSet-    vertexIntSet               = IntSet.fromAscList . SR.vertexList-    edgeList                   = SR.edgeList-    edgeSet                    = SR.edgeSet-    adjacencyList              = SR.adjacencyList-    toAdjacencyMap             = toAdjacencyMap . SR.fromSymmetric-    toAdjacencyIntMap          = toAdjacencyIntMap . SR.fromSymmetric-    toAdjacencyMapTranspose    = toAdjacencyMap-    toAdjacencyIntMapTranspose = toAdjacencyIntMap  -- | The /adjacency map/ of a graph: each vertex is associated with a set of its -- /direct successors/.

@@ -60,7 +60,7 @@ import Data.String  import qualified Algebra.Graph                    as G-import qualified Algebra.Graph.Relation.Symmetric as R+import qualified Algebra.Graph.Relation.Symmetric as SR import qualified Data.Set                         as Set  -- TODO: Specialise the API for graphs with vertices of type 'Int'.@@ -88,7 +88,7 @@ provide a more fine-grained class hierarchy for algebraic structures, which we would be able to utilise without violating any laws. -The 'Eq' instance is currently implemented using the 'R.Relation' as the+The 'Eq' instance is currently implemented using the 'SR.Relation' as the /canonical graph representation/ and satisfies all axioms of algebraic graphs:      * 'overlay' is commutative and associative:@@ -144,7 +144,7 @@ 'vertexCount' ('empty' + 'empty') == 0 'size'        ('empty' + 'empty') == 2@ -Converting an undirected 'Graph' to the corresponding 'R.Relation' takes+Converting an undirected 'Graph' to the corresponding 'SR.Relation' takes /O(s + m * log(m))/ time and /O(s + m)/ memory. This is also the complexity of the graph equality test, because it is currently implemented by converting graph expressions to canonical representations based on adjacency maps.@@ -238,7 +238,7 @@ -- 'Algebra.Graph.edgeCount' . fromUndirected    <= (*2) . 'edgeCount' -- @ fromUndirected :: Ord a => Graph a -> G.Graph a-fromUndirected = toGraph . toRelation+fromUndirected = toGraph . SR.fromSymmetric . toRelation  -- | Construct the /empty graph/. --@@ -421,15 +421,15 @@ -- isSubgraphOf x y                         ==> x <= y -- @ isSubgraphOf :: Ord a => Graph a -> Graph a -> Bool-isSubgraphOf x y = R.isSubgraphOf (toRelation x) (toRelation y)+isSubgraphOf x y = SR.isSubgraphOf (toRelation x) (toRelation y) {-# NOINLINE [1] isSubgraphOf #-}  -- TODO: This is a very inefficient implementation. Find a way to construct a -- symmetric relation directly, without building intermediate representations -- for all subgraphs.--- | Convert an undirected graph to a symmetric 'R.Relation'.-toRelation :: Ord a => Graph a -> R.Relation a-toRelation = foldg R.empty R.vertex R.overlay R.connect+-- | Convert an undirected graph to a symmetric 'SR.Relation'.+toRelation :: Ord a => Graph a -> SR.Relation a+toRelation = foldg SR.empty SR.vertex SR.overlay SR.connect {-# INLINE toRelation #-}  -- | Check if a graph is empty.@@ -516,7 +516,7 @@ -- edgeCount            == 'length' . 'edgeList' -- @ edgeCount :: Ord a => Graph a -> Int-edgeCount = R.edgeCount . toRelation+edgeCount = SR.edgeCount . toRelation {-# INLINE [1] edgeCount #-}  -- | The sorted list of vertices of a given graph.@@ -542,7 +542,7 @@ -- edgeList ('star' 2 [3,1]) == [(1,2), (2,3)] -- @ edgeList :: Ord a => Graph a -> [(a, a)]-edgeList = R.edgeList . toRelation+edgeList = SR.edgeList . toRelation {-# INLINE [1] edgeList #-}  -- | The set of vertices of a given graph.@@ -566,7 +566,7 @@ -- edgeSet ('edge' x y) == Set.'Set.singleton' ('min' x y, 'max' x y) -- @ edgeSet :: Ord a => Graph a -> Set (a, a)-edgeSet = R.edgeSet . toRelation+edgeSet = SR.edgeSet . toRelation {-# INLINE [1] edgeSet #-}  -- | The sorted /adjacency list/ of a graph.@@ -580,7 +580,7 @@ -- 'stars' . adjacencyList        == id -- @ adjacencyList :: Ord a => Graph a -> [(a, [a])]-adjacencyList = R.adjacencyList . toRelation+adjacencyList = SR.adjacencyList . toRelation {-# INLINE adjacencyList #-} {-# SPECIALISE adjacencyList :: Graph Int -> [(Int, [Int])] #-} @@ -593,7 +593,7 @@ -- neighbours y ('edge' x y) == Set.'Set.fromList' [x] -- @ neighbours :: Ord a => a -> Graph a -> Set a-neighbours x = R.neighbours x . toRelation+neighbours x = SR.neighbours x . toRelation {-# INLINE neighbours #-}  -- | The /path/ on a list of vertices.

@@ -86,8 +86,8 @@ -- In the following examples we will use the helper function: -- -- @--- (%) :: (GraphKL Int -> a) -> 'AM.AdjacencyMap' Int -> a--- a % g = a $ 'fromAdjacencyMap' g+-- (%) :: Ord a => ('GraphKL' a -> b) -> 'AM.AdjacencyMap' a -> b+-- f % x = f ('fromAdjacencyMap' x) -- @ -- -- for greater clarity.@@ -95,11 +95,10 @@ -- @ -- 'AM.forest' (dfsForest % 'AM.edge' 1 1)           == 'AM.vertex' 1 -- 'AM.forest' (dfsForest % 'AM.edge' 1 2)           == 'AM.edge' 1 2--- 'AM.forest' (dfsForest % 'AM.edge' 2 1)           == 'AM.vertices' [1, 2]+-- 'AM.forest' (dfsForest % 'AM.edge' 2 1)           == 'AM.vertices' [1,2] -- 'AM.isSubgraphOf' ('AM.forest' $ dfsForest % x) x == True -- dfsForest % 'AM.forest' (dfsForest % x)      == dfsForest % x -- dfsForest % 'AM.vertices' vs                 == 'map' (\\v -> Node v []) ('Data.List.nub' $ 'Data.List.sort' vs)--- 'AM.dfsForestFrom' ('AM.vertexList' x) % x        == dfsForest % x -- dfsForest % (3 * (1 + 4) * (1 + 5))     == [ Node { rootLabel = 1 --                                                   , subForest = [ Node { rootLabel = 5 --                                                                        , subForest = [] }]}@@ -117,30 +116,30 @@ -- In the following examples we will use the helper function: -- -- @--- (%) :: (GraphKL Int -> a) -> 'AM.AdjacencyMap' Int -> a--- a % g = a $ 'fromAdjacencyMap' g+-- (%) :: Ord a => ('GraphKL' a -> b) -> 'AM.AdjacencyMap' a -> b+-- f % x = f ('fromAdjacencyMap' x) -- @ -- -- for greater clarity. -- -- @--- 'AM.forest' (dfsForestFrom [1]    % 'AM.edge' 1 1)       == 'AM.vertex' 1--- 'AM.forest' (dfsForestFrom [1]    % 'AM.edge' 1 2)       == 'AM.edge' 1 2--- 'AM.forest' (dfsForestFrom [2]    % 'AM.edge' 1 2)       == 'AM.vertex' 2--- 'AM.forest' (dfsForestFrom [3]    % 'AM.edge' 1 2)       == 'AM.empty'--- 'AM.forest' (dfsForestFrom [2, 1] % 'AM.edge' 1 2)       == 'AM.vertices' [1, 2]--- 'AM.isSubgraphOf' ('AM.forest' $ dfsForestFrom vs % x) x == True--- dfsForestFrom ('AM.vertexList' x) % x               == 'dfsForest' % x--- dfsForestFrom vs               % 'AM.vertices' vs   == 'map' (\\v -> Node v []) ('Data.List.nub' vs)--- dfsForestFrom []               % x             == []--- dfsForestFrom [1, 4] % (3 * (1 + 4) * (1 + 5)) == [ Node { rootLabel = 1---                                                          , subForest = [ Node { rootLabel = 5---                                                                               , subForest = [] }---                                                   , Node { rootLabel = 4---                                                          , subForest = [] }]+-- 'AM.forest' $ (dfsForestFrom % 'AM.edge' 1 1) [1]          == 'AM.vertex' 1+-- 'AM.forest' $ (dfsForestFrom % 'AM.edge' 1 2) [0]          == 'AM.empty'+-- 'AM.forest' $ (dfsForestFrom % 'AM.edge' 1 2) [1]          == 'AM.edge' 1 2+-- 'AM.forest' $ (dfsForestFrom % 'AM.edge' 1 2) [2]          == 'AM.vertex' 2+-- 'AM.forest' $ (dfsForestFrom % 'AM.edge' 1 2) [2,1]        == 'AM.vertices' [1,2]+-- 'AM.isSubgraphOf' ('AM.forest' $ dfsForestFrom % x $ vs) x == True+-- dfsForestFrom % x $ 'AM.vertexList' x                 == 'dfsForest' % x+-- dfsForestFrom % 'AM.vertices' vs $ vs                 == 'map' (\\v -> Node v []) ('Data.List.nub' vs)+-- dfsForestFrom % x $ []                           == []+-- dfsForestFrom % (3 * (1 + 4) * (1 + 5)) $ [1,4]  == [ Node { rootLabel = 1+--                                                            , subForest = [ Node { rootLabel = 5+--                                                                                 , subForest = [] }+--                                                     , Node { rootLabel = 4+--                                                            , subForest = [] }] -- @-dfsForestFrom :: [a] -> GraphKL a -> Forest a-dfsForestFrom vs (GraphKL g r t) = fmap (fmap r) (KL.dfs g (mapMaybe t vs))+dfsForestFrom :: GraphKL a -> [a] -> Forest a+dfsForestFrom (GraphKL g r t) = fmap (fmap r) . KL.dfs g . mapMaybe t  -- | Compute the list of vertices visited by the /depth-first search/ in a -- graph, when searching from each of the given vertices in order.@@ -148,25 +147,26 @@ -- In the following examples we will use the helper function: -- -- @--- (%) :: (GraphKL Int -> a) -> 'AM.AdjacencyMap' Int -> a--- a % g = a $ 'fromAdjacencyMap' g+-- (%) :: Ord a => ('GraphKL' a -> b) -> 'AM.AdjacencyMap' a -> b+-- f % x = f ('fromAdjacencyMap' x) -- @ -- -- for greater clarity. -- -- @--- dfs [1]   % 'AM.edge' 1 1                 == [1]--- dfs [1]   % 'AM.edge' 1 2                 == [1,2]--- dfs [2]   % 'AM.edge' 1 2                 == [2]--- dfs [3]   % 'AM.edge' 1 2                 == []--- dfs [1,2] % 'AM.edge' 1 2                 == [1,2]--- dfs [2,1] % 'AM.edge' 1 2                 == [2,1]--- dfs []    % x                        == []--- dfs [1,4] % (3 * (1 + 4) * (1 + 5))  == [1,5,4]--- 'AM.isSubgraphOf' ('AM.vertices' $ dfs vs x) x == True+-- dfs % 'AM.edge' 1 1 $ [1]   == [1]+-- dfs % 'AM.edge' 1 2 $ [0]   == []+-- dfs % 'AM.edge' 1 2 $ [1]   == [1,2]+-- dfs % 'AM.edge' 1 2 $ [2]   == [2]+-- dfs % 'AM.edge' 1 2 $ [1,2] == [1,2]+-- dfs % 'AM.edge' 1 2 $ [2,1] == [2,1]+-- dfs % x        $ []    == []+--+-- dfs % (3 * (1 + 4) * (1 + 5)) $ [1,4]     == [1,5,4]+-- 'Data.List.and' [ 'AM.hasVertex' v x | v <- dfs % x $ vs ] == True -- @-dfs :: [a] -> GraphKL a -> [a]-dfs vs = concatMap flatten . dfsForestFrom vs+dfs :: GraphKL a -> [a] -> [a]+dfs x = concatMap flatten . dfsForestFrom x  -- | Compute the /topological sort/ of a graph. Note that this function returns -- a result even if the graph is cyclic.@@ -174,8 +174,8 @@ -- In the following examples we will use the helper function: -- -- @--- (%) :: (GraphKL Int -> a) -> 'AM.AdjacencyMap' Int -> a--- a % g = a $ 'fromAdjacencyMap' g+-- (%) :: Ord a => ('GraphKL' a -> b) -> 'AM.AdjacencyMap' a -> b+-- f % x = f ('fromAdjacencyMap' x) -- @ -- -- for greater clarity.@@ -187,6 +187,7 @@ topSort :: GraphKL a -> [a] topSort (GraphKL g r _) = map r (KL.topSort g) +-- TODO: Add docs and tests. scc :: Ord a => AM.AdjacencyMap a -> AM.AdjacencyMap (NonEmpty.AdjacencyMap a) scc m = AM.gmap (component Map.!) $ removeSelfLoops $ AM.gmap (leader Map.!) m   where

@@ -97,12 +97,12 @@         , adjacencyIntMap            :: g Int -> IntMap IntSet         , adjacencyMapTranspose      :: forall a. c a => g a -> Map a (Set a)         , adjacencyIntMapTranspose   :: g Int -> IntMap IntSet-        , bfsForest                  :: forall a. c a => [a] -> g a -> Forest a-        , bfs                        :: forall a. c a => [a] -> g a -> [[a]]+        , bfsForest                  :: forall a. c a => g a -> [a] -> Forest a+        , bfs                        :: forall a. c a => g a -> [a] -> [[a]]         , dfsForest                  :: forall a. c a => g a -> Forest a-        , dfsForestFrom              :: forall a. c a => [a] -> g a -> Forest a-        , dfs                        :: forall a. c a => [a] -> g a -> [a]-        , reachable                  :: forall a. c a => a -> g a -> [a]+        , dfsForestFrom              :: forall a. c a => g a -> [a] -> Forest a+        , dfs                        :: forall a. c a => g a -> [a] -> [a]+        , reachable                  :: forall a. c a => g a -> a -> [a]         , topSort                    :: forall a. c a => g a -> Either (NonEmpty a) [a]         , isAcyclic                  :: forall a. c a => g a -> Bool         , toAdjacencyMap             :: forall a. c a => g a -> AM.AdjacencyMap a

@@ -688,14 +688,14 @@     test "dfsForest                  == Algebra.Graph.AdjacencyMap.dfsForest . toAdjacencyMap" $ \x ->           dfsForest x                == (AM.dfsForest . toAdjacencyMap) x -    test "dfsForestFrom vs           == Algebra.Graph.AdjacencyMap.dfsForestFrom vs . toAdjacencyMap" $ \vs x ->-          dfsForestFrom vs x         == (AM.dfsForestFrom vs . toAdjacencyMap) x+    test "dfsForestFrom              == Algebra.Graph.AdjacencyMap.dfsForestFrom . toAdjacencyMap" $ \x vs ->+          dfsForestFrom x vs         == (AM.dfsForestFrom . toAdjacencyMap) x vs -    test "dfs vs                     == Algebra.Graph.AdjacencyMap.dfs vs . toAdjacencyMap" $ \vs x ->-          dfs vs x                   == (AM.dfs vs . toAdjacencyMap) x+    test "dfs                        == Algebra.Graph.AdjacencyMap.dfs . toAdjacencyMap" $ \x vs ->+          dfs x vs                   == (AM.dfs . toAdjacencyMap) x vs -    test "reachable x                == Algebra.Graph.AdjacencyMap.reachable x . toAdjacencyMap" $ \x y ->-          reachable x y              == (AM.reachable x . toAdjacencyMap) y+    test "reachable                  == Algebra.Graph.AdjacencyMap.reachable . toAdjacencyMap" $ \x y ->+          reachable x y              == (AM.reachable . toAdjacencyMap) x y      test "topSort                    == Algebra.Graph.AdjacencyMap.topSort . toAdjacencyMap" $ \x ->           topSort x                  == (AM.topSort . toAdjacencyMap) x@@ -782,14 +782,14 @@     test "dfsForest                  == Algebra.Graph.AdjacencyMap.dfsForest . toAdjacencyMap" $ \x ->           dfsForest x                == (AM.dfsForest . toAdjacencyMap) x -    test "dfsForestFrom vs           == Algebra.Graph.AdjacencyMap.dfsForestFrom vs . toAdjacencyMap" $ \vs x ->-          dfsForestFrom vs x         == (AM.dfsForestFrom vs . toAdjacencyMap) x+    test "dfsForestFrom              == Algebra.Graph.AdjacencyMap.dfsForestFrom . toAdjacencyMap" $ \x vs ->+          dfsForestFrom x vs         == (AM.dfsForestFrom . toAdjacencyMap) x vs -    test "dfs vs                     == Algebra.Graph.AdjacencyMap.dfs vs . toAdjacencyMap" $ \vs x ->-          dfs vs x                   == (AM.dfs vs . toAdjacencyMap) x+    test "dfs                        == Algebra.Graph.AdjacencyMap.dfs . toAdjacencyMap" $ \x vs ->+          dfs x vs                   == (AM.dfs . toAdjacencyMap) x vs -    test "reachable x                == Algebra.Graph.AdjacencyMap.reachable x . toAdjacencyMap" $ \x y ->-          reachable x y              == (AM.reachable x . toAdjacencyMap) y+    test "reachable                  == Algebra.Graph.AdjacencyMap.reachable . toAdjacencyMap" $ \x y ->+          reachable x y              == (AM.reachable . toAdjacencyMap) x y      test "topSort                    == Algebra.Graph.AdjacencyMap.topSort . toAdjacencyMap" $ \x ->           topSort x                  == (AM.topSort . toAdjacencyMap) x@@ -1594,8 +1594,8 @@     test "closure . closure       == closure" $ size10 $ \x ->          (closure . closure) x    == closure x -    test "postSet x (closure y)   == Set.fromList (reachable x y)" $ size10 $ \x y ->-          postSet x (closure y)   == Set.fromList (reachable x y)+    test "postSet x (closure y)   == Set.fromList (reachable y x)" $ size10 $ \x y ->+          postSet x (closure y)   == Set.fromList (reachable y x)  testReflexiveClosure :: TestsuiteInt g -> IO () testReflexiveClosure (prefix, API{..}) = do@@ -1702,114 +1702,106 @@ testBfsForest :: TestsuiteInt g -> IO () testBfsForest (prefix, API{..}) = do     putStrLn $ "\n============ " ++ prefix ++ "bfsForest ============"-    test "bfsForest vs empty                           == []" $ \vs ->-          bfsForest vs empty                           == []+    test "forest $ bfsForest (edge 1 2) [0]        == empty" $+         (forest $ bfsForest (edge 1 2) [0])       == empty -    test "forest (bfsForest [1]   $ edge 1 1)          == vertex 1" $-          forest (bfsForest [1]   $ edge 1 1)          == vertex 1+    test "forest $ bfsForest (edge 1 2) [1]        == edge 1 2" $+         (forest $ bfsForest (edge 1 2) [1])       == edge 1 2 -    test "forest (bfsForest [1]   $ edge 1 2)          == edge 1 2" $-          forest (bfsForest [1]   $ edge 1 2)          == edge 1 2+    test "forest $ bfsForest (edge 1 2) [2]        == vertex 2" $+         (forest $ bfsForest (edge 1 2) [2])       == vertex 2 -    test "forest (bfsForest [2]   $ edge 1 2)          == vertex 2" $-          forest (bfsForest [2]   $ edge 1 2)          == vertex 2+    test "forest $ bfsForest (edge 1 2) [0,1,2]    == vertices [1,2]" $+         (forest $ bfsForest (edge 1 2) [0,1,2])   == vertices [1,2] -    test "forest (bfsForest [3]   $ edge 1 2)          == empty" $-          forest (bfsForest [3]   $ edge 1 2)          == empty+    test "forest $ bfsForest (edge 1 2) [2,1,0]    == vertices [1,2]" $+         (forest $ bfsForest (edge 1 2) [2,1,0])   == vertices [1,2] -    test "forest (bfsForest [2,1] $ edge 1 2)          == vertices [1,2]" $-          forest (bfsForest [2,1] $ edge 1 2)          == vertices [1,2]+    test "forest $ bfsForest (edge 1 1) [1]        == vertex 1" $+         (forest $ bfsForest (edge 1 1) [1])       == vertex 1 -    test "isSubgraphOf (forest $ bfsForest vs x) x     == True" $ \vs x ->-          isSubgraphOf (forest $ bfsForest vs x) x     == True+    test "isSubgraphOf (forest $ bfsForest x vs) x == True" $ \x vs ->+          isSubgraphOf (forest $ bfsForest x vs) x == True -    test "bfsForest (vertexList g) g                   == <correct result>" $ \g ->-          bfsForest (vertexList g) g                   ==-          map (\v -> Node v []) (nub $ vertexList g)+    test "bfsForest x (vertexList x)               == map (\v -> Node v []) (nub $ vertexList x)" $ \x ->+          bfsForest x (vertexList x)               == map (\v -> Node v []) (nub $ vertexList x) -    test "bfsForest []             x                   == []" $ \x ->-          bfsForest []             x                   == []+    test "bfsForest x []                           == []" $ \x ->+          bfsForest x []                           == [] -    test "bfsForest [1,4] $ 3 * (1 + 4) * (1 + 5)      == <correct result>" $-          bfsForest [1,4]  (3 * (1 + 4) * (1 + 5))     == [ Node { rootLabel = 1-                                                                 , subForest = [ Node { rootLabel = 5-                                                                                      , subForest = [] }]}-                                                          , Node { rootLabel = 4-                                                                 , subForest = [] }]+    test "bfsForest empty vs                       == []" $ \vs ->+          bfsForest empty vs                       == [] -    test "bfsForest [3] (circuit [1..5] + (circuit [5,4..1])) == <correct result>" $-          bfsForest [3] (circuit [1..5] + (circuit [5,4..1])) ==-          [ Node { rootLabel = 3-                 , subForest = [ Node { rootLabel = 2-                                      , subForest = [ Node { rootLabel = 1-                                                           , subForest = []}]}-                               , Node { rootLabel = 4-                                      , subForest = [ Node { rootLabel = 5-                                                           , subForest = []}]}]}]+    test "bfsForest (3 * (1 + 4) * (1 + 5)) [1,4]  == <correct result>" $+          bfsForest (3 * (1 + 4) * (1 + 5)) [1,4]  == [ Node { rootLabel = 1+                                                             , subForest = [ Node { rootLabel = 5+                                                                                  , subForest = [] }]}+                                                      , Node { rootLabel = 4+                                                             , subForest = [] }] +    test "forest $ bfsForest (circuit [1..5] + circuit [5,4..1]) [3] == path [3,2,1] + path [3,4,5]" $+         (forest $ bfsForest (circuit [1..5] + circuit [5,4..1]) [3])== path [3,2,1] + path [3,4,5]+ testBfs :: TestsuiteInt g -> IO () testBfs (prefix, API{..}) = do     putStrLn $ "\n============ " ++ prefix ++ "bfs ============" -    test "bfs vs    $ empty                             == []" $ \vs ->-          bfs vs      empty                             == []--    test "bfs []      g                                 == []" $ \g ->-          bfs []      g                                 == []+    test "bfs (edge 1 2) [0]                                   == []" $+          bfs (edge 1 2) [0]                                   == [] -    test "bfs [1]    (edge 1 1)                         == [[1]]" $-          bfs [1]    (edge 1 1)                         == [[1]]+    test "bfs (edge 1 2) [1]                                   == [[1], [2]]" $+          bfs (edge 1 2) [1]                                   == [[1], [2]] -    test "bfs [1]    (edge 1 2)                         == [[1],[2]]" $-          bfs [1]    (edge 1 2)                         == [[1],[2]]+    test "bfs (edge 1 2) [2]                                   == [[2]]" $+          bfs (edge 1 2) [2]                                   == [[2]] -    test "bfs [2]    (edge 1 2)                         == [[2]]" $-          bfs [2]    (edge 1 2)                         == [[2]]+    test "bfs (edge 1 2) [1,2]                                 == [[1,2]]" $+          bfs (edge 1 2) [1,2]                                 == [[1,2]] -    test "bfs [1,2]  (edge 1 2)                         == [[1,2]]" $-          bfs [1,2]  (edge 1 2)                         == [[1,2]]+    test "bfs (edge 1 2) [2,1]                                 == [[2,1]]" $+          bfs (edge 1 2) [2,1]                                 == [[2,1]] -    test "bfs [2,1]  (edge 1 2)                         == [[2,1]]" $-          bfs [2,1]  (edge 1 2)                         == [[2,1]]+    test "bfs (edge 1 1) [1]                                   == [[1]]" $+          bfs (edge 1 1) [1]                                   == [[1]] -    test "bfs [3]    (edge 1 2)                         == []" $-          bfs [3]    (edge 1 2)                         == []+    test "bfs empty vs                                         == []" $ \vs ->+          bfs empty vs                                         == [] -    test "bfs [1,2] ((1*2) + (3*4) + (5*6))             == [[1,2]]" $-          bfs [1,2] ((1*2) + (3*4) + (5*6))             == [[1,2]]+    test "bfs x []                                             == []" $ \x ->+          bfs x []                                             == [] -    test "bfs [1,3] ((1*2) + (3*4) + (5*6))             == [[1,3],[2,4]]" $-          bfs [1,3] ((1*2) + (3*4) + (5*6))             == [[1,3],[2,4]]+    test "bfs (1 * 2 + 3 * 4 + 5 * 6) [1,2]                    == [[1,2]]" $+          bfs (1 * 2 + 3 * 4 + 5 * 6) [1,2]                    == [[1,2]] -    test "bfs [3]  (3 * (1 + 4) * (1 + 5))              == [[3],[1,4,5]]" $-          bfs [3]  (3 * (1 + 4) * (1 + 5))              == [[3],[1,4,5]]+    test "bfs (1 * 2 + 3 * 4 + 5 * 6) [1,3]                    == [[1,3], [2,4]]" $+          bfs (1 * 2 + 3 * 4 + 5 * 6) [1,3]                    == [[1,3], [2,4]] -    test "bfs [2] (circuit [1..5] + (circuit [5,4..1])) == [[2],[1,3],[5,4]]" $-          bfs [2] (circuit [1..5] + (circuit [5,4..1])) == [[2],[1,3],[5,4]]+    test "bfs (3 * (1 + 4) * (1 + 5)) [3]                      == [[3], [1,4,5]]" $+          bfs (3 * (1 + 4) * (1 + 5)) [3]                      == [[3], [1,4,5]] -    test "concat (bfs [3] $ circuit [1..5] + circuit [5,4..1]) == [3,2,4,1,5]" $-          concat (bfs [3] $ circuit [1..5] + circuit [5,4..1]) == [3,2,4,1,5]+    test "bfs (circuit [1..5] + circuit [5,4..1]) [2]          == [[2], [1,3], [5,4]]" $+          bfs (circuit [1..5] + circuit [5,4..1]) [2]          == [[2], [1,3], [5,4]] -    test "isSubgraphOf (vertices $ concat $ bfs vs x) x == True" $ \vs x ->-          isSubgraphOf (vertices $ concat $ bfs vs x) x == True+    test "concat $ bfs (circuit [1..5] + circuit [5,4..1]) [3] == [3,2,4,1,5]" $+         (concat $ bfs (circuit [1..5] + circuit [5,4..1]) [3])== [3,2,4,1,5] -    test "bfs vs == map concat . List.transpose . map levels . bfsForest vs" $ \vs g ->-          (bfs vs) g == (map concat . List.transpose . map levels . bfsForest vs) g+    test "map concat . transpose . map levels . bfsForest x    == bfs x" $ \x vs ->+         (map concat . List.transpose . map levels . bfsForest x) vs == bfs x vs  testDfsForest :: TestsuiteInt g -> IO () testDfsForest (prefix, API{..}) = do     putStrLn $ "\n============ " ++ prefix ++ "dfsForest ============"-    test "dfsForest empty                       == []" $-          dfsForest empty                       == []+    test "forest $ dfsForest empty              == empty" $+         (forest $ dfsForest empty)             == empty -    test "forest (dfsForest $ edge 1 1)         == vertex 1" $-          forest (dfsForest $ edge 1 1)         == vertex 1+    test "forest $ dfsForest (edge 1 1)         == vertex 1" $+         (forest $ dfsForest (edge 1 1))        == vertex 1 -    test "forest (dfsForest $ edge 1 2)         == edge 1 2" $-          forest (dfsForest $ edge 1 2)         == edge 1 2+    test "forest $ dfsForest (edge 1 2)         == edge 1 2" $+         (forest $ dfsForest (edge 1 2))        == edge 1 2 -    test "forest (dfsForest $ edge 2 1)         == vertices [1,2]" $-          forest (dfsForest $ edge 2 1)         == vertices [1,2]+    test "forest $ dfsForest (edge 2 1)         == vertices [1,2]" $+         (forest $ dfsForest (edge 2 1))        == vertices [1,2]      test "isSubgraphOf (forest $ dfsForest x) x == True" $ \x ->           isSubgraphOf (forest $ dfsForest x) x == True@@ -1824,127 +1816,133 @@           dfsForest (vertices vs)               == map (\v -> Node v []) (nub $ sort vs)      test "dfsForest $ 3 * (1 + 4) * (1 + 5)     == <correct result>" $-          dfsForest  (3 * (1 + 4) * (1 + 5))    == [ Node { rootLabel = 1+         (dfsForest $ 3 * (1 + 4) * (1 + 5))    == [ Node { rootLabel = 1                                                    , subForest = [ Node { rootLabel = 5                                                                         , subForest = [] }]}                                                    , Node { rootLabel = 3                                                    , subForest = [ Node { rootLabel = 4                                                                         , subForest = [] }]}]+     test "forest (dfsForest $ circuit [1..5] + circuit [5,4..1]) == path [1,2,3,4,5]" $           forest (dfsForest $ circuit [1..5] + circuit [5,4..1]) == path [1,2,3,4,5]  testDfsForestFrom :: TestsuiteInt g -> IO () testDfsForestFrom (prefix, API{..}) = do     putStrLn $ "\n============ " ++ prefix ++ "dfsForestFrom ============"-    test "dfsForestFrom vs empty                           == []" $ \vs ->-          dfsForestFrom vs empty                           == []+    test "forest $ dfsForestFrom empty      vs             == empty" $ \vs ->+         (forest $ dfsForestFrom empty      vs)            == empty -    test "forest (dfsForestFrom [1]   $ edge 1 1)          == vertex 1" $-          forest (dfsForestFrom [1]   $ edge 1 1)          == vertex 1+    test "forest $ dfsForestFrom (edge 1 1) [1]            == vertex 1" $+         (forest $ dfsForestFrom (edge 1 1) [1])           == vertex 1 -    test "forest (dfsForestFrom [1]   $ edge 1 2)          == edge 1 2" $-          forest (dfsForestFrom [1]   $ edge 1 2)          == edge 1 2+    test "forest $ dfsForestFrom (edge 1 2) [0]            == empty" $+         (forest $ dfsForestFrom (edge 1 2) [0])           == empty -    test "forest (dfsForestFrom [2]   $ edge 1 2)          == vertex 2" $-          forest (dfsForestFrom [2]   $ edge 1 2)          == vertex 2+    test "forest $ dfsForestFrom (edge 1 2) [1]            == edge 1 2" $+         (forest $ dfsForestFrom (edge 1 2) [1])           == edge 1 2 -    test "forest (dfsForestFrom [3]   $ edge 1 2)          == empty" $-          forest (dfsForestFrom [3]   $ edge 1 2)          == empty+    test "forest $ dfsForestFrom (edge 1 2) [2]            == vertex 2" $+         (forest $ dfsForestFrom (edge 1 2) [2])           == vertex 2 -    test "forest (dfsForestFrom [2,1] $ edge 1 2)          == vertices [1,2]" $-          forest (dfsForestFrom [2,1] $ edge 1 2)          == vertices [1,2]+    test "forest $ dfsForestFrom (edge 1 2) [1,2]          == edge 1 2" $+         (forest $ dfsForestFrom (edge 1 2) [1,2])         == edge 1 2 -    test "isSubgraphOf (forest $ dfsForestFrom vs x) x     == True" $ \vs x ->-          isSubgraphOf (forest $ dfsForestFrom vs x) x     == True+    test "forest $ dfsForestFrom (edge 1 2) [2,1]          == vertices [1,2]" $+         (forest $ dfsForestFrom (edge 1 2) [2,1])         == vertices [1,2] -    test "isDfsForestOf (dfsForestFrom (vertexList x) x) x == True" $ \x ->-          isDfsForestOf (dfsForestFrom (vertexList x) x) x == True+    test "isSubgraphOf (forest $ dfsForestFrom x vs) x     == True" $ \x vs ->+          isSubgraphOf (forest $ dfsForestFrom x vs) x     == True -    test "dfsForestFrom (vertexList x) x                   == dfsForest x" $ \x ->-          dfsForestFrom (vertexList x) x                   == dfsForest x+    test "isDfsForestOf (dfsForestFrom x (vertexList x)) x == True" $ \x ->+          isDfsForestOf (dfsForestFrom x (vertexList x)) x == True -    test "dfsForestFrom vs             (vertices vs)       == map (\\v -> Node v []) (nub vs)" $ \vs ->-          dfsForestFrom vs             (vertices vs)       == map (\v -> Node v []) (nub vs)+    test "dfsForestFrom x (vertexList x)                   == dfsForest x" $ \x ->+          dfsForestFrom x (vertexList x)                   == dfsForest x -    test "dfsForestFrom []             x                   == []" $ \x ->-          dfsForestFrom []             x                   == []+    test "dfsForestFrom x []                               == []" $ \x ->+          dfsForestFrom x []                               == [] -    test "dfsForestFrom [1,4] $ 3 * (1 + 4) * (1 + 5)      == <correct result>" $-          dfsForestFrom [1,4]  (3 * (1 + 4) * (1 + 5))     == [ Node { rootLabel = 1+    test "dfsForestFrom (3 * (1 + 4) * (1 + 5)) [1,4]      == <correct result>" $+          dfsForestFrom (3 * (1 + 4) * (1 + 5)) [1,4]      == [ Node { rootLabel = 1                                                                      , subForest = [ Node { rootLabel = 5                                                                                           , subForest = [] }]}                                                               , Node { rootLabel = 4                                                                      , subForest = [] }]-    test "forest (dfsForestFrom [3] $ circuit [1..5] + circuit [5,4..1]) == path [3,2,1,5,4]" $-          forest (dfsForestFrom [3] $ circuit [1..5] + circuit [5,4..1]) == path [3,2,1,5,4]+    test "forest $ dfsForestFrom (circuit [1..5] + circuit [5,4..1]) [3] == path [3,2,1,5,4]" $+         (forest $ dfsForestFrom (circuit [1..5] + circuit [5,4..1]) [3])== path [3,2,1,5,4]   testDfs :: TestsuiteInt g -> IO () testDfs (prefix, API{..}) = do     putStrLn $ "\n============ " ++ prefix ++ "dfs ============"-    test "dfs vs    $ empty                    == []" $ \vs ->-          dfs vs      empty                    == []+    test "dfs empty      vs    == []" $ \vs ->+          dfs empty      vs    == [] -    test "dfs [1]   $ edge 1 1                 == [1]" $-          dfs [1]    (edge 1 1)                == [1]+    test "dfs (edge 1 1) [1]   == [1]" $+          dfs (edge 1 1) [1]   == [1] -    test "dfs [1]   $ edge 1 2                 == [1,2]" $-          dfs [1]    (edge 1 2)                == [1,2]+    test "dfs (edge 1 2) [0]   == []" $+          dfs (edge 1 2) [0]   == [] -    test "dfs [2]   $ edge 1 2                 == [2]" $-          dfs [2]    (edge 1 2)                 == [2]+    test "dfs (edge 1 2) [1]   == [1,2]" $+          dfs (edge 1 2) [1]   == [1,2] -    test "dfs [3]   $ edge 1 2                 == []" $-          dfs [3]    (edge 1 2)                == []+    test "dfs (edge 1 2) [2]   == [2]" $+          dfs (edge 1 2) [2]   == [2] -    test "dfs [1,2] $ edge 1 2                 == [1,2]" $-          dfs [1,2]  (edge 1 2)                == [1,2]+    test "dfs (edge 1 2) [1,2] == [1,2]" $+          dfs (edge 1 2) [1,2] == [1,2] -    test "dfs [2,1] $ edge 1 2                 == [2,1]" $-          dfs [2,1]  (edge 1 2)                 == [2,1]+    test "dfs (edge 1 2) [2,1] == [2,1]" $+          dfs (edge 1 2) [2,1] == [2,1] -    test "dfs []    $ x                        == []" $ \x ->-          dfs []      x                        == []+    test "dfs x          []    == []" $ \x ->+          dfs x          []    == [] -    test "dfs [1,4] $ 3 * (1 + 4) * (1 + 5)    == [1,5,4]" $-          dfs [1,4]  (3 * (1 + 4) * (1 + 5))   == [1,5,4]+    putStrLn ""+    test "and [ hasVertex v x | v <- dfs x vs ]       == True" $ \x vs ->+          and [ hasVertex v x | v <- dfs x vs ]       == True -    test "isSubgraphOf (vertices $ dfs vs x) x == True" $ \vs x ->-          isSubgraphOf (vertices $ dfs vs x) x == True+    test "dfs (3 * (1 + 4) * (1 + 5)) [1,4]           == [1,5,4]" $+          dfs (3 * (1 + 4) * (1 + 5)) [1,4]           == [1,5,4] -    test "dfs [3] (circuit [1..5] + circuit [5,4..1]) == [3,2,1,5,4]" $-          dfs [3] (circuit [1..5] + circuit [5,4..1]) == [3,2,1,5,4]+    test "dfs (circuit [1..5] + circuit [5,4..1]) [3] == [3,2,1,5,4]" $+          dfs (circuit [1..5] + circuit [5,4..1]) [3] == [3,2,1,5,4]  testReachable :: TestsuiteInt g -> IO () testReachable (prefix, API{..}) = do     putStrLn $ "\n============ " ++ prefix ++ "dfs ============"-    test "reachable x $ empty                       == []" $ \x ->-          reachable x   empty                       == []+    test "reachable empty              x == []" $ \x ->+          reachable empty              x == [] -    test "reachable 1 $ vertex 1                    == [1]" $-          reachable 1  (vertex 1)                   == [1]+    test "reachable (vertex 1)         1 == [1]" $+          reachable (vertex 1)         1 == [1] -    test "reachable 1 $ vertex 2                    == []" $-          reachable 1  (vertex 2)                   == []+    test "reachable (edge 1 1)         1 == [1]" $+          reachable (edge 1 1)         1 == [1] -    test "reachable 1 $ edge 1 1                    == [1]" $-          reachable 1  (edge 1 1)                   == [1]+    test "reachable (edge 1 2)         0 == []" $+          reachable (edge 1 2)         0 == [] -    test "reachable 1 $ edge 1 2                    == [1,2]" $-          reachable 1  (edge 1 2)                   == [1,2]+    test "reachable (edge 1 2)         1 == [1,2]" $+          reachable (edge 1 2)         1 == [1,2] -    test "reachable 4 $ path    [1..8]              == [4..8]" $-          reachable 4  (path    [1..8])             == [4..8]+    test "reachable (edge 1 2)         2 == [2]" $+          reachable (edge 1 2)         2 == [2] -    test "reachable 4 $ circuit [1..8]              == [4..8] ++ [1..3]" $-          reachable 4  (circuit [1..8])             == [4..8] ++ [1..3]+    test "reachable (path    [1..8]  ) 4 == [4..8]" $+          reachable (path    [1..8]  ) 4 == [4..8] -    test "reachable 8 $ clique  [8,7..1]            == [8] ++ [1..7]" $-          reachable 8  (clique  [8,7..1])           == [8] ++ [1..7]+    test "reachable (circuit [1..8]  ) 4 == [4..8] ++ [1..3]" $+          reachable (circuit [1..8]  ) 4 == [4..8] ++ [1..3] -    test "isSubgraphOf (vertices $ reachable x y) y == True" $ \x y ->-          isSubgraphOf (vertices $ reachable x y) y == True+    test "reachable (clique  [8,7..1]) 8 == [8] ++ [1..7]" $+          reachable (clique  [8,7..1]) 8 == [8] ++ [1..7] +    putStrLn ""+    test "and [ hasVertex v x | v <- reachable x y ] == True" $ \x y ->+          and [ hasVertex v x | v <- reachable x y ] == True+ testTopSort :: TestsuiteInt g -> IO () testTopSort (prefix, API{..}) = do     putStrLn $ "\n============ " ++ prefix ++ "topSort ============"@@ -1969,8 +1967,8 @@     test "topSort (circuit [1..3] + circuit [3,2,1]) == Left (3 :| [2])" $           topSort (circuit [1..3] + circuit [3,2,1]) == Left (3 :| [2]) -    test "topSort (1*2 + 2*1 + 3*4 + 4*3 + 5*1)      == Left (1 :| [2])" $-          topSort (1*2 + 2*1 + 3*4 + 4*3 + 5*1)      == Left (1 :| [2])+    test "topSort (1 * 2 + (5 + 2) * 1 + 3 * 4 * 3)  == Left (1 :| [2])" $+          topSort (1 * 2 + (5 + 2) * 1 + 3 * 4 * 3)  == Left (1 :| [2])      test "fmap (flip isTopSortOf x) (topSort x) /= Right False" $ \x ->           fmap (flip isTopSortOf x) (topSort x) /= Right False

@@ -79,8 +79,8 @@     testBox         tPoly      putStrLn "\n============ Graph.sparsify ============"-    test "sort . reachable x       == sort . rights . reachable (Right x) . sparsify" $ \x (y :: G) ->-         (sort . reachable x) y    == (sort . rights . reachable (Right x) . sparsify) y+    test "sort . reachable x       == sort . rights . reachable (sparsify x) . Right" $ \(x :: G) y ->+         (sort . reachable x) y    ==(sort . rights . reachable (sparsify x) . Right) y      test "vertexCount (sparsify x) <= vertexCount x + size x + 1" $ \(x :: G) ->           vertexCount (sparsify x) <= vertexCount x + size x + 1@@ -92,12 +92,12 @@           size        (sparsify x) <= 3 * size x      putStrLn "\n============ Graph.sparsifyKL ============"-    test "sort . reachable k                 == sort . filter (<= n) . flip reachable k . sparsifyKL n" $ \(Positive n) -> do+    test "sort . reachable x                 == sort . filter (<= n) . reachable (sparsifyKL n x)" $ \(Positive n) -> do         let pairs = (,) <$> choose (1, n) <*> choose (1, n)-        k  <- choose (1, n)         es <- listOf pairs         let x = vertices [1..n] `overlay` edges es-        return $ (sort . reachable k) x == (sort . filter (<= n) . flip KL.reachable k . sparsifyKL n) x+        y <- choose (1, n)+        return $ (sort . reachable x) y == (sort . filter (<= n) . KL.reachable (sparsifyKL n x)) y      test "length (vertices $ sparsifyKL n x) <= vertexCount x + size x + 1" $ \(Positive n) -> do         let pairs = (,) <$> choose (1, n) <*> choose (1, n)

@@ -430,8 +430,8 @@     test "closure . closure     == closure" $ size10 $ \x ->          (closure . closure) x  == closure (x :: LAD) -    test "postSet x (closure y) == Set.fromList (reachable x y)" $ size10 $ \(x :: Int) (y :: LAD) ->-          postSet x (closure y) == Set.fromList (reachable x y)+    test "postSet x (closure y) == Set.fromList (reachable y x)" $ size10 $ \(x :: Int) (y :: LAD) ->+          postSet x (closure y) == Set.fromList (reachable y x)      putStrLn "\n============ Labelled.AdjacencyMap.reflexiveClosure ============"     test "reflexiveClosure empty              == empty" $

@@ -422,8 +422,8 @@     test "closure . closure     == closure" $ size10 $ \x ->          (closure . closure) x  == closure (x :: LAD) -    test "postSet x (closure y) == Set.fromList (reachable x y)" $ size10 $ \(x :: Int) (y :: LAD) ->-          T.postSet x (closure y) == Set.fromList (T.reachable x y)+    test "postSet x (closure y) == Set.fromList (reachable y x)" $ size10 $ \(x :: Int) (y :: LAD) ->+          T.postSet x (closure y) == Set.fromList (T.reachable y x)      putStrLn "\n============ Labelled.Graph.reflexiveClosure ============"     test "reflexiveClosure empty              == empty" $

@@ -580,8 +580,8 @@     test "closure . closure       == closure" $ sizeLimit $ \(x :: G) ->          (closure . closure) x    == closure x -    test "postSet x (closure y)   == Set.fromList (reachable x y)" $ sizeLimit $ \x (y :: G) ->-          postSet x (closure y)   == Set.fromList (reachable x y)+    test "postSet x (closure y)   == Set.fromList (reachable y x)" $ sizeLimit $ \x (y :: G) ->+          postSet x (closure y)   == Set.fromList (reachable y x)      putStrLn $ "\n============ NonEmpty.AdjacencyMap.reflexiveClosure ============"     test "reflexiveClosure (vertex x)         == edge x x" $ \(x :: Int) ->

@@ -654,8 +654,8 @@           simplify (1 * 1 * 1) === (1 * 1 :: G)      putStrLn "\n============ NonEmpty.Graph.sparsify ============"-    test "sort . reachable x       == sort . rights . reachable (Right x) . sparsify" $ \x (y :: G) ->-         (sort . reachable x) y    == (sort . rights . reachable (Right x) . sparsify) y+    test "sort . reachable x       == sort . rights . reachable (sparsify x) . Right" $ \(x :: G) y ->+         (sort . reachable x) y    ==(sort . rights . reachable (sparsify x) . Right) y      test "vertexCount (sparsify x) <= vertexCount x + size x + 1" $ \(x :: G) ->           vertexCount (sparsify x) <= vertexCount x + size x + 1@@ -666,13 +666,13 @@     test "size        (sparsify x) <= 3 * size x" $ \(x :: G) ->           size        (sparsify x) <= 3 * size x -    putStrLn "\n============ NonEmpty.Graph.sparsify ============"-    test "sort . reachable k                 == sort . filter (<= n) . flip reachable k . sparsifyKL n" $ \(Positive n) -> do+    putStrLn "\n============ NonEmpty.Graph.sparsifyKL ============"+    test "sort . reachable x                 == sort . filter (<= n) . reachable (sparsifyKL n x)" $ \(Positive n) -> do         let pairs = (,) <$> choose (1, n) <*> choose (1, n)-        k  <- choose (1, n)         es <- listOf pairs         let x = G.edges es `overlay1` vertices1 [1..n]-        return $ (sort . reachable k) x == (sort . filter (<= n) . flip KL.reachable k . sparsifyKL n) x+        y <- choose (1, n)+        return $ (sort . reachable x) y == (sort . filter (<= n) . KL.reachable (sparsifyKL n x)) y      test "length (vertices $ sparsifyKL n x) <= vertexCount x + size x + 1" $ \(Positive n) -> do         let pairs = (,) <$> choose (1, n) <*> choose (1, n)

@@ -13,9 +13,10 @@     testTyped     ) where -import qualified Algebra.Graph.AdjacencyMap as AM-import qualified Algebra.Graph.AdjacencyIntMap as AIM import Algebra.Graph.Test+import Algebra.Graph.AdjacencyMap ( forest, empty, vertex, edge, vertices+                                  , isSubgraphOf, vertexList, hasVertex )+ import Data.Array (array) import Data.Graph.Typed import Data.Tree@@ -24,11 +25,14 @@ import qualified Data.Graph  as KL import qualified Data.IntSet as IntSet +import qualified Algebra.Graph.AdjacencyMap    as AM+import qualified Algebra.Graph.AdjacencyIntMap as AIM+ type AI = AM.AdjacencyMap Int  -- TODO: Improve the alignment in the testsuite to match the documentation. (%) :: (GraphKL Int -> a) -> AM.AdjacencyMap Int -> a-a % g = a $ fromAdjacencyMap g+f % x = f (fromAdjacencyMap x)  testTyped :: IO () testTyped = do@@ -68,93 +72,94 @@      putStrLn $ "\n============ Typed.dfsForest ============"     test "forest (dfsForest % edge 1 1)           == vertex 1" $-          AM.forest (dfsForest % AM.edge 1 1)     == AM.vertex 1+          forest (dfsForest % edge 1 1)           == vertex 1      test "forest (dfsForest % edge 1 2)           == edge 1 2" $-          AM.forest (dfsForest % AM.edge 1 2)     == AM.edge 1 2+          forest (dfsForest % edge 1 2)           == edge 1 2      test "forest (dfsForest % edge 2 1)           == vertices [1, 2]" $-          AM.forest (dfsForest % AM.edge 2 1)     == AM.vertices [1, 2]+          forest (dfsForest % edge 2 1)           == vertices [1, 2]      test "isSubgraphOf (forest $ dfsForest % x) x == True" $ \x ->-          AM.isSubgraphOf (AM.forest $ dfsForest % x) x == True+          isSubgraphOf (forest $ dfsForest % x) x == True      test "dfsForest % forest (dfsForest % x)      == dfsForest % x" $ \x ->-          dfsForest % AM.forest (dfsForest % x)   == dfsForest % x+          dfsForest % forest (dfsForest % x)      == dfsForest % x      test "dfsForest % vertices vs                 == map (\\v -> Node v []) (nub $ sort vs)" $ \vs ->-          dfsForest % AM.vertices vs              == map (\v -> Node v []) (nub $ sort vs)+          dfsForest % vertices vs                 == map (\v -> Node v []) (nub $ sort vs)      test "dfsForest % (3 * (1 + 4) * (1 + 5))     == <correct result>" $           dfsForest % (3 * (1 + 4) * (1 + 5))     == [ Node { rootLabel = 1-                                                   , subForest = [ Node { rootLabel = 5-                                                                        , subForest = [] }]}-                                                   , Node { rootLabel = 3-                                                   , subForest = [ Node { rootLabel = 4-                                                                        , subForest = [] }]}]+                                                     , subForest = [ Node { rootLabel = 5+                                                                          , subForest = [] }]}+                                                     , Node { rootLabel = 3+                                                     , subForest = [ Node { rootLabel = 4+                                                                          , subForest = [] }]}]      putStrLn $ "\n============ Typed.dfsForestFrom ============"-    test "forest (dfsForestFrom [1]       % edge 1 1)     == vertex 1" $-          AM.forest (dfsForestFrom [1]    % AM.edge 1 1)  == AM.vertex 1+    test "forest $ (dfsForestFrom % edge 1 1) [1]         == vertex 1" $+         (forest $ (dfsForestFrom % edge 1 1) [1])        == vertex 1 -    test "forest (dfsForestFrom [1]       % edge 1 2)     == edge 1 2" $-          AM.forest (dfsForestFrom [1]    % AM.edge 1 2)  == AM.edge 1 2+    test "forest $ (dfsForestFrom % edge 1 2) [0]         == empty" $+         (forest $ (dfsForestFrom % edge 1 2) [0])        == empty -    test "forest (dfsForestFrom [2]       % edge 1 2)     == vertex 2" $-          AM.forest (dfsForestFrom [2]    % AM.edge 1 2)  == AM.vertex 2+    test "forest $ (dfsForestFrom % edge 1 2) [1]         == edge 1 2" $+         (forest $ (dfsForestFrom % edge 1 2) [1])        == edge 1 2 -    test "forest (dfsForestFrom [3]       % edge 1 2)     == empty" $-          AM.forest (dfsForestFrom [3]    % AM.edge 1 2)  == AM.empty+    test "forest $ (dfsForestFrom % edge 1 2) [2]         == vertex 2" $+         (forest $ (dfsForestFrom % edge 1 2) [2])        == vertex 2 -    test "forest (dfsForestFrom [2, 1]    % edge 1 2)     == vertices [1, 2]" $-          AM.forest (dfsForestFrom [2, 1] % AM.edge 1 2)  == AM.vertices [1, 2]+    test "forest $ (dfsForestFrom % edge 1 2) [2,1]       == vertices [1,2]" $+         (forest $ (dfsForestFrom % edge 1 2) [2,1])      == vertices [1,2] -    test "isSubgraphOf (forest $ dfsForestFrom vs % x) x  == True" $ \vs x ->-          AM.isSubgraphOf (AM.forest (dfsForestFrom vs % x)) x == True+    test "isSubgraphOf (forest $ dfsForestFrom % x $ vs) x == True" $ \x vs ->+          isSubgraphOf (forest $ dfsForestFrom % x $ vs) x == True -    test "dfsForestFrom (vertexList x) % x                == dfsForest % x" $ \x ->-          dfsForestFrom (AM.vertexList x) % x             == dfsForest % x+    test "dfsForestFrom % x $ vertexList x                == dfsForest % x" $ \x ->+         (dfsForestFrom % x $ vertexList x)               == dfsForest % x -    test "dfsForestFrom vs           % (AM.vertices vs)   == map (\\v -> Node v []) (nub vs)" $ \vs ->-          dfsForestFrom vs           %  AM.vertices vs    == map (\v -> Node v []) (nub vs)+    test "dfsForestFrom % vertices vs $ vs                == map (\\v -> Node v []) (nub vs)" $ \vs ->+         (dfsForestFrom % vertices vs $ vs)               == map (\v -> Node v []) (nub vs) -    test "dfsForestFrom []           % x                  == []" $ \x ->-          dfsForestFrom []           % x                  == []+    test "dfsForestFrom % x $ []                          == []" $ \x ->+         (dfsForestFrom % x $ [])                         == [] -    test "dfsForestFrom [1, 4] % 3 * (1 + 4) * (1 + 5)    == <correct result>" $-          dfsForestFrom [1, 4] % (3 * (1 + 4) * (1 + 5))  == [ Node { rootLabel = 1+    test "dfsForestFrom % (3 * (1 + 4) * (1 + 5)) $ [1,4] == <correct result>" $+         (dfsForestFrom % (3 * (1 + 4) * (1 + 5)) $ [1,4])== [ Node { rootLabel = 1                                                                     , subForest = [ Node { rootLabel = 5                                                                                          , subForest = [] }]}                                                              , Node { rootLabel = 4                                                                     , subForest = [] }]      putStrLn $ "\n============ Typed.dfs ============"-    test "dfs [1]    % edge 1 1                  == [1]" $-          dfs [1]    % AM.edge 1 1               == [1]+    test "dfs % edge 1 1 $ [1]   == [1]" $+         (dfs % edge 1 1 $ [1])  == [1] -    test "dfs [1]    % edge 1 2                  == [1,2]" $-          dfs [1]    % AM.edge 1 2               == [1,2]+    test "dfs % edge 1 2 $ [0]   == []" $+         (dfs % edge 1 2 $ [0])  == [] -    test "dfs [2]    % edge 1 2                  == [2]" $-          dfs [2]    % AM.edge 1 2               == [2]+    test "dfs % edge 1 2 $ [1]   == [1,2]" $+         (dfs % edge 1 2 $ [1])  == [1,2] -    test "dfs [3]    % edge 1 2                  == []" $-          dfs [3]    % AM.edge 1 2               == []+    test "dfs % edge 1 2 $ [2]   == [2]" $+         (dfs % edge 1 2 $ [2])  == [2] -    test "dfs [1, 2] % edge 1 2                  == [1, 2]" $-          dfs [1, 2] % AM.edge 1 2               == [1, 2]+    test "dfs % edge 1 2 $ [1,2] == [1,2]" $+         (dfs % edge 1 2 $ [1,2])== [1,2] -    test "dfs [2, 1] % edge 1 2                  == [2, 1]" $-          dfs [2, 1] % AM.edge 1 2               == [2, 1]+    test "dfs % edge 1 2 $ [2,1] == [2,1]" $+         (dfs % edge 1 2 $ [2,1])== [2,1] -    test "dfs []     % x                         == []" $ \x ->-          dfs []     % x                         == []+    test "dfs % x        $ []    == []" $ \x ->+         (dfs % x        $ [])   == [] -    test "dfs [1, 4] % 3 * (1 + 4) * (1 + 5)     == [1,5,4]" $-          dfs [1, 4] % (3 * (1 + 4) * (1 + 5))   == [1,5,4]+    putStrLn ""+    test "dfs % (3 * (1 + 4) * (1 + 5)) $ [1,4]     == [1,5,4]" $+         (dfs % (3 * (1 + 4) * (1 + 5)) $ [1,4])    == [1,5,4] -    test "isSubgraphOf (vertices $ dfs vs % x) x == True" $ \vs x ->-          AM.isSubgraphOf (AM.vertices $ dfs vs % x) x == True+    test "and [ hasVertex v x | v <- dfs % x $ vs ] == True" $ \x vs ->+          and [ hasVertex v x | v <- dfs % x $ vs ] == True      putStrLn "\n============ Typed.topSort ============"     test "topSort % (1 * 2 + 3 * 1) == [3,1,2]" $