algebraic-graphs 0.6.1 → 0.8
raw patch · 54 files changed
Files
- CHANGES.md +10/−0
- LICENSE +1/−1
- README.md +1/−1
- algebraic-graphs.cabal +11/−10
- src/Algebra/Graph.hs +7/−7
- src/Algebra/Graph/Acyclic/AdjacencyMap.hs +1/−1
- src/Algebra/Graph/AdjacencyIntMap.hs +3/−3
- src/Algebra/Graph/AdjacencyIntMap/Algorithm.hs +129/−121
- src/Algebra/Graph/AdjacencyMap.hs +3/−3
- src/Algebra/Graph/AdjacencyMap/Algorithm.hs +130/−121
- src/Algebra/Graph/Bipartite/AdjacencyMap.hs +1/−7
- src/Algebra/Graph/Bipartite/AdjacencyMap/Algorithm.hs +1/−1
- src/Algebra/Graph/Class.hs +2/−2
- src/Algebra/Graph/Example/Todo.hs +33/−16
- src/Algebra/Graph/Export.hs +5/−5
- src/Algebra/Graph/Export/Dot.hs +2/−2
- src/Algebra/Graph/HigherKinded/Class.hs +2/−2
- src/Algebra/Graph/Internal.hs +3/−5
- src/Algebra/Graph/Label.hs +18/−11
- src/Algebra/Graph/Labelled.hs +19/−6
- src/Algebra/Graph/Labelled/AdjacencyMap.hs +31/−4
- src/Algebra/Graph/Labelled/Example/Automaton.hs +10/−7
- src/Algebra/Graph/Labelled/Example/Network.hs +1/−1
- src/Algebra/Graph/NonEmpty.hs +6/−7
- src/Algebra/Graph/NonEmpty/AdjacencyMap.hs +2/−2
- src/Algebra/Graph/Relation.hs +31/−7
- src/Algebra/Graph/Relation/Preorder.hs +1/−1
- src/Algebra/Graph/Relation/Reflexive.hs +1/−1
- src/Algebra/Graph/Relation/Symmetric.hs +28/−6
- src/Algebra/Graph/Relation/Transitive.hs +1/−1
- src/Algebra/Graph/ToGraph.hs +30/−108
- src/Algebra/Graph/Undirected.hs +14/−14
- src/Data/Graph/Typed.hs +39/−38
- test/Algebra/Graph/Test.hs +1/−1
- test/Algebra/Graph/Test/API.hs +6/−6
- test/Algebra/Graph/Test/Acyclic/AdjacencyMap.hs +1/−1
- test/Algebra/Graph/Test/AdjacencyIntMap.hs +1/−1
- test/Algebra/Graph/Test/AdjacencyMap.hs +1/−1
- test/Algebra/Graph/Test/Arbitrary.hs +1/−4
- test/Algebra/Graph/Test/Bipartite/AdjacencyMap.hs +2/−3
- test/Algebra/Graph/Test/Export.hs +1/−1
- test/Algebra/Graph/Test/Generic.hs +156/−158
- test/Algebra/Graph/Test/Graph.hs +6/−6
- test/Algebra/Graph/Test/Internal.hs +1/−1
- test/Algebra/Graph/Test/Label.hs +1/−1
- test/Algebra/Graph/Test/Labelled/AdjacencyMap.hs +3/−3
- test/Algebra/Graph/Test/Labelled/Graph.hs +3/−3
- test/Algebra/Graph/Test/NonEmpty/AdjacencyMap.hs +3/−3
- test/Algebra/Graph/Test/NonEmpty/Graph.hs +7/−7
- test/Algebra/Graph/Test/Relation.hs +1/−1
- test/Algebra/Graph/Test/Relation/Symmetric.hs +1/−1
- test/Algebra/Graph/Test/RewriteRules.hs +1/−1
- test/Algebra/Graph/Test/Undirected.hs +1/−1
- test/Data/Graph/Test/Typed.hs +59/−54
CHANGES.md view
@@ -1,5 +1,15 @@ # Change log +## 0.8++* #305, #312: Support GHC 9.4, GHC 9.6 and GHC 9.8.+* #303, #314: Stop supporting GHC 8.4, GHC 8.6 and GHC 8.8.++## 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`.
LICENSE view
@@ -1,6 +1,6 @@ MIT License -Copyright (c) 2016-2022 Andrey Mokhov+Copyright (c) 2016-2025 Andrey Mokhov Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal
README.md view
@@ -1,6 +1,6 @@ # Algebraic graphs -[](https://hackage.haskell.org/package/algebraic-graphs) [](https://github.com/snowleopard/alga/actions)+[](https://hackage.haskell.org/package/algebraic-graphs) [](https://github.com/snowleopard/alga/actions) **Alga** is a library for algebraic construction and manipulation of graphs in Haskell. See [this Haskell Symposium paper](https://github.com/snowleopard/alga-paper) and the
algebraic-graphs.cabal view
@@ -1,18 +1,18 @@ cabal-version: 2.2 name: algebraic-graphs-version: 0.6.1+version: 0.8 synopsis: A library for algebraic graph construction and transformation license: MIT license-file: LICENSE author: Andrey Mokhov <andrey.mokhov@gmail.com>, github: @snowleopard maintainer: Andrey Mokhov <andrey.mokhov@gmail.com>, github: @snowleopard, Alexandre Moine <alexandre@moine.me>, github: @nobrakal-copyright: Andrey Mokhov, 2016-2022+copyright: Andrey Mokhov, 2016-2025 homepage: https://github.com/snowleopard/alga bug-reports: https://github.com/snowleopard/alga/issues category: Algebra, Algorithms, Data Structures, Graphs build-type: Simple-tested-with: GHC==9.2, GHC==9.0, GHC==8.10, GHC==8.8, GHC==8.6, GHC==8.4+tested-with: GHC==9.8.2, GHC==9.6.3, GHC==9.4.7, GHC==9.2.8, GHC==9.0.2, GHC==8.10.7 description: <https://github.com/snowleopard/alga Alga> is a library for algebraic construction and manipulation of graphs in Haskell. See <https://github.com/snowleopard/alga-paper this paper>@@ -68,10 +68,10 @@ common common-settings build-depends: array >= 0.4 && < 0.6,- base >= 4.11 && < 5,- containers >= 0.5.5.1 && < 0.8,- deepseq >= 1.3.0.1 && < 1.5,- transformers >= 0.4 && < 0.6+ base >= 4.12 && < 5,+ containers >= 0.5.5.1 && < 0.9,+ deepseq >= 1.3.0.1 && < 1.6,+ transformers >= 0.4 && < 0.7 default-language: Haskell2010 default-extensions: ConstraintKinds DeriveFunctor@@ -86,6 +86,7 @@ TupleSections TypeApplications TypeFamilies+ TypeOperators other-extensions: CPP OverloadedStrings RecordWildCards@@ -132,7 +133,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 +162,7 @@ Data.Graph.Test.Typed build-depends: algebraic-graphs, extra >= 1.4 && < 2,- inspection-testing >= 0.4.6.0 && < 0.5,- QuickCheck >= 2.14 && < 2.15+ inspection-testing >= 0.4.2.2 && < 0.7,+ QuickCheck >= 2.14 && < 2.16 other-extensions: ConstrainedClassMethods TemplateHaskell
src/Algebra/Graph.hs view
@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Algebra.Graph--- Copyright : (c) Andrey Mokhov 2016-2022+-- Copyright : (c) Andrey Mokhov 2016-2025 -- License : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability : experimental@@ -56,7 +56,7 @@ import Data.Foldable (toList) import Data.Maybe (fromMaybe) import Data.String-import Data.Tree+import Data.Tree (Tree (..)) import GHC.Generics import Algebra.Graph.Internal@@ -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 -- @
src/Algebra/Graph/Acyclic/AdjacencyMap.hs view
@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Algebra.Graph.Acyclic.AdjacencyMap--- Copyright : (c) Andrey Mokhov 2016-2022+-- Copyright : (c) Andrey Mokhov 2016-2025 -- License : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability : experimental
src/Algebra/Graph/AdjacencyIntMap.hs view
@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Algebra.Graph.AdjacencyIntMap--- Copyright : (c) Andrey Mokhov 2016-2022+-- Copyright : (c) Andrey Mokhov 2016-2025 -- License : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability : experimental@@ -51,7 +51,7 @@ import Data.List ((\\)) import Data.Monoid (Sum (..)) import Data.Set (Set)-import Data.Tree+import Data.Tree (Forest, Tree (..)) import GHC.Generics import qualified Data.IntMap.Strict as IntMap@@ -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
src/Algebra/Graph/AdjacencyIntMap/Algorithm.hs view
@@ -2,7 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Algebra.Graph.AdjacencyIntMap.Algorithm--- Copyright : (c) Andrey Mokhov 2016-2022+-- Copyright : (c) Andrey Mokhov 2016-2025 -- License : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability : unstable@@ -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
src/Algebra/Graph/AdjacencyMap.hs view
@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Algebra.Graph.AdjacencyMap--- Copyright : (c) Andrey Mokhov 2016-2022+-- Copyright : (c) Andrey Mokhov 2016-2025 -- License : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability : experimental@@ -55,7 +55,7 @@ import Data.Monoid import Data.Set (Set) import Data.String-import Data.Tree+import Data.Tree (Forest, Tree (..)) import GHC.Generics import qualified Data.Map.Strict as Map@@ -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
src/Algebra/Graph/AdjacencyMap/Algorithm.hs view
@@ -2,7 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Algebra.Graph.AdjacencyMap.Algorithm--- Copyright : (c) Andrey Mokhov 2016-2022+-- Copyright : (c) Andrey Mokhov 2016-2025 -- License : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability : unstable@@ -33,10 +33,9 @@ import Data.Either import Data.List.NonEmpty (NonEmpty(..), (<|)) import Data.Maybe-import Data.Tree+import Data.Tree (Forest, Tree (..), flatten, levels, unfoldForestM_BF) import Algebra.Graph.AdjacencyMap-import Algebra.Graph.Internal import qualified Algebra.Graph.NonEmpty.AdjacencyMap as NonEmpty import qualified Data.Array as Array@@ -48,79 +47,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 +146,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 +154,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 +231,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 +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]@@ -273,13 +280,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 [] @@ -373,23 +380,25 @@ -- called when exiting vertex v. if v is the bottom of a scc -- boundary, we add a new SCC, otherwise v is part of a larger scc -- being constructed and we continue.- exit v = do newComponent <- (v==).snd.head <$> gets boundaryStack- when newComponent $ insertComponent v- return newComponent+ exit v = do boundaryStack <- gets boundaryStack+ case boundaryStack of+ (p_top, top) : newBoundaryStack | v == top -> do+ insertComponent p_top top newBoundaryStack+ return True - insertComponent v = modify'- (\(SCC pre scc bnd pth pres sccs gs es_i es_o) ->+ _ -> return False++ insertComponent p_v v newBoundaryStack = modify'+ (\(SCC pre scc _oldBoundaryStack pth pres sccs gs es_i es_o) -> let (curr,v_pth') = span (/=v) pth- pth' = tail v_pth' -- Here we know that v_pth' starts with v+ pth' = drop 1 v_pth' -- Here we know that v_pth' starts with v (es,es_i') = span ((>=p_v).fst) es_i g_i | null es = vertex v | otherwise = edges (snd <$> es)- p_v = fst $ head bnd scc' = scc + 1- bnd' = tail bnd sccs' = List.foldl' (\sccs x -> Map.insert x scc sccs) sccs (v:curr) gs' = g_i:gs- in SCC pre scc' bnd' pth' pres sccs' gs' es_i' es_o)+ in SCC pre scc' newBoundaryStack pth' pres sccs' gs' es_i' es_o) inedge uv = modify' (\(SCC pre scc bnd pth pres sccs gs es_i es_o) ->
src/Algebra/Graph/Bipartite/AdjacencyMap.hs view
@@ -1,7 +1,7 @@ ---------------------------------------------------------------------------- -- | -- Module : Algebra.Graph.Bipartite.AdjacencyMap--- Copyright : (c) Andrey Mokhov 2016-2022+-- Copyright : (c) Andrey Mokhov 2016-2025 -- License : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability : experimental@@ -53,19 +53,13 @@ consistent ) where -import Control.Monad-import Control.Monad.Trans.Maybe-import Control.Monad.Trans.State import Data.Either-import Data.Foldable (asum) import Data.List ((\\), sort) import Data.Map.Strict (Map)-import Data.Maybe import Data.Set (Set) import GHC.Exts (IsList(..)) import GHC.Generics -import qualified Algebra.Graph as G import qualified Algebra.Graph.AdjacencyMap as AM import qualified Data.Map.Strict as Map
src/Algebra/Graph/Bipartite/AdjacencyMap/Algorithm.hs view
@@ -2,7 +2,7 @@ ---------------------------------------------------------------------------- -- | -- Module : Algebra.Graph.Bipartite.AdjacencyMap.Algorithm--- Copyright : (c) Andrey Mokhov 2016-2022+-- Copyright : (c) Andrey Mokhov 2016-2025 -- License : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability : experimental
src/Algebra/Graph/Class.hs view
@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Algebra.Graph.Class--- Copyright : (c) Andrey Mokhov 2016-2022+-- Copyright : (c) Andrey Mokhov 2016-2025 -- License : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability : experimental@@ -46,7 +46,7 @@ path, circuit, clique, biclique, star, tree, forest ) where -import Data.Tree+import Data.Tree (Forest, Tree (..)) import Algebra.Graph.Label (Dioid, one)
src/Algebra/Graph/Example/Todo.hs view
@@ -1,6 +1,14 @@ {-# LANGUAGE OverloadedStrings #-}-module Algebra.Graph.Example.Todo (Todo, todo, low, high, (~*~), (>*<), priority) where+module Algebra.Graph.Example.Todo (+ -- * Creating and manipulating to-do lists+ Todo, todo, low, high, (~*~), (>*<), priority, + -- * Examples+ shopping, holiday+ ) where++-- Based on https://blogs.ncl.ac.uk/andreymokhov/graphs-in-disguise/+ import Data.Map (Map) import Data.String @@ -13,10 +21,10 @@ data Todo a = T (Map a Int) (AdjacencyMap a) deriving Show instance Ord a => Eq (Todo a) where- x == y = todo x == todo y+ x == y = todo x == todo y instance (IsString a, Ord a) => IsString (Todo a) where- fromString = C.vertex . fromString+ fromString = C.vertex . fromString -- Lower the priority of items in a given todo list low :: Todo a -> Todo a@@ -39,8 +47,7 @@ x >*< y = high x `C.connect` low y todo :: forall a. Ord a => Todo a -> Maybe [a]-todo (T p g) =- case AM.topSort $ gmap prioritise g of+todo (T p g) = case AM.topSort $ gmap prioritise g of Left _ -> Nothing Right xs -> Just $ map snd xs where@@ -48,16 +55,26 @@ prioritise x = (negate $ Map.findWithDefault 0 x p, x) instance (IsString a, Ord a) => Num (Todo a) where- fromInteger i = fromString $ show (fromInteger i :: Integer)- (+) = C.overlay- (*) = C.connect- signum = const C.empty- abs = id- negate = id+ fromInteger i = fromString $ show (fromInteger i :: Integer)+ (+) = C.overlay+ (*) = C.connect+ signum = const C.empty+ abs = id+ negate = id instance Ord a => Graph (Todo a) where- type Vertex (Todo a) = a- empty = T Map.empty AM.empty- vertex x = T (Map.singleton x 0) (C.vertex x)- overlay (T p1 g1) (T p2 g2) = T (Map.unionWith (+) p1 p2) (C.overlay g1 g2)- connect (T p1 g1) (T p2 g2) = T (Map.unionWith (+) p1 p2) (C.connect g1 g2)+ type Vertex (Todo a) = a+ empty = T Map.empty AM.empty+ vertex x = T (Map.singleton x 0) (C.vertex x)+ overlay (T p1 g1) (T p2 g2) = T (Map.unionWith (+) p1 p2) (C.overlay g1 g2)+ connect (T p1 g1) (T p2 g2) = T (Map.unionWith (+) p1 p2) (C.connect g1 g2)++-- λ> todo shopping+-- Just ["coat","presents","phone wife","scarf"]+shopping :: Todo String+shopping = "presents" + "coat" + "phone wife" ~*~ "scarf"++-- λ> todo holiday+-- Just ["coat","presents","phone wife","scarf","pack","travel"]+holiday :: Todo String+holiday = shopping * "pack" * "travel"
src/Algebra/Graph/Export.hs view
@@ -2,7 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Algebra.Graph.Export--- Copyright : (c) Andrey Mokhov 2016-2022+-- Copyright : (c) Andrey Mokhov 2016-2025 -- License : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability : experimental@@ -37,7 +37,7 @@ -- implementation uses difference lists). Here @s@ is the type of abstract -- symbols or strings (text or binary). 'Doc' @s@ is a 'Monoid', therefore -- 'mempty' corresponds to the /empty document/ and two documents can be--- concatenated with 'mappend' (or operator 'Data.Monoid.<>'). Documents+-- concatenated with 'mappend' (or operator 'Data.Semigroup.<>'). Documents -- comprising a single symbol or string can be constructed using the function -- 'literal'. Alternatively, you can construct documents as string literals, -- e.g. simply as @"alga"@, by using the @OverloadedStrings@ GHC extension. To@@ -91,7 +91,7 @@ -- constructed directly from string literals (see the second example below). -- -- @--- literal "Hello, " 'Data.Monoid.<>' literal "World!" == literal "Hello, World!"+-- literal "Hello, " 'Data.Semigroup.<>' literal "World!" == literal "Hello, World!" -- literal "I am just a string literal" == "I am just a string literal" -- 'render' . literal == 'id' -- @@@ -101,8 +101,8 @@ -- | Render the document as a single string. An inverse of the function 'literal'. -- -- @--- render ('literal' "al" 'Data.Monoid.<>' 'literal' "ga") :: ('IsString' s, 'Monoid' s) => s--- render ('literal' "al" 'Data.Monoid.<>' 'literal' "ga") == "alga"+-- render ('literal' "al" 'Data.Semigroup.<>' 'literal' "ga") :: ('IsString' s, 'Monoid' s) => s+-- render ('literal' "al" 'Data.Semigroup.<>' 'literal' "ga") == "alga" -- render 'mempty' == 'mempty' -- render . 'literal' == 'id' -- @
src/Algebra/Graph/Export/Dot.hs view
@@ -2,7 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Algebra.Graph.Export.Dot--- Copyright : (c) Andrey Mokhov 2016-2022+-- Copyright : (c) Andrey Mokhov 2016-2025 -- License : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability : experimental@@ -21,7 +21,7 @@ export, exportAsIs, exportViaShow ) where -import Data.List (map, null, intersperse)+import Data.List (intersperse) import Data.Monoid import Data.String hiding (unlines) import Prelude hiding (unlines)
src/Algebra/Graph/HigherKinded/Class.hs view
@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Algebra.Graph.HigherKinded.Class--- Copyright : (c) Andrey Mokhov 2016-2022+-- Copyright : (c) Andrey Mokhov 2016-2025 -- License : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability : experimental@@ -54,7 +54,7 @@ import Control.Applicative (Alternative(empty, (<|>))) import Control.Monad (MonadPlus, mfilter)-import Data.Tree+import Data.Tree (Forest, Tree (..)) import qualified Algebra.Graph as G
src/Algebra/Graph/Internal.hs view
@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Algebra.Graph.Internal--- Copyright : (c) Andrey Mokhov 2016-2022+-- Copyright : (c) Andrey Mokhov 2016-2025 -- License : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability : experimental@@ -29,13 +29,11 @@ import Data.Coerce import Data.Foldable-import Data.IntSet (IntSet) import Data.Semigroup (Endo (..)) import Data.Set (Set) -import qualified Data.IntSet as IntSet-import qualified Data.Set as Set-import qualified GHC.Exts as Exts+import qualified Data.Set as Set+import qualified GHC.Exts as Exts -- | An abstract list data type with /O(1)/ time concatenation (the current -- implementation uses difference lists). Here @a@ is the type of list elements.
src/Algebra/Graph/Label.hs view
@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Algebra.Graph.Label--- Copyright : (c) Andrey Mokhov 2016-2022+-- Copyright : (c) Andrey Mokhov 2016-2025 -- License : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability : experimental@@ -22,17 +22,16 @@ NonNegative, finite, finiteWord, unsafeFinite, infinite, getFinite, Distance, distance, getDistance, Capacity, capacity, getCapacity, Count, count, getCount, PowerSet (..), Minimum, getMinimum, noMinimum,- Path, Label, isZero, RegularExpression,+ Path, Label, symbol, symbols, isZero, RegularExpression, -- * Combining edge labels Optimum (..), ShortestPath, AllShortestPaths, CountShortestPaths, WidestPath ) where -import Control.Applicative import Control.Monad import Data.Coerce import Data.Maybe-import Data.Monoid (Any (..), Monoid (..), Sum (..))+import Data.Monoid (Any (..), Sum (..)) import Data.Semigroup (Max (..), Min (..)) import Data.Set (Set) import GHC.Exts (IsList (..))@@ -72,7 +71,7 @@ > x <.> (y <+> z) == x <.> y <+> x <.> z > (x <+> y) <.> z == x <.> z <+> y <.> z -}-class (Monoid a, Semigroup a) => Semiring a where+class Monoid a => Semiring a where one :: a (<.>) :: a -> a -> a @@ -285,11 +284,11 @@ instance (Num a, Eq a) => Num (Extended a) where fromInteger = Finite . fromInteger - (+) = liftA2 (+)+ (+) = liftM2 (+) Finite 0 * _ = Finite 0 _ * Finite 0 = Finite 0- x * y = liftA2 (*) x y+ x * y = liftM2 (*) x y negate = fmap negate signum = fmap signum@@ -331,7 +330,7 @@ instance (Monoid a, Ord a) => Semiring (Minimum a) where one = pure mempty- (<.>) = liftA2 mappend+ (<.>) = liftM2 mappend instance (Monoid a, Ord a) => Dioid (Minimum a) @@ -364,8 +363,8 @@ instance (Monoid a, Ord a) => Dioid (PowerSet a) where --- | The type of /free labels/ over the underlying set of symbols @a@. This data--- type is an instance of classes 'StarSemiring' and 'Dioid'.+-- | The type of /free labels/ over the underlying set of symbols @a@. 'Label' values+-- can be manipulated via its 'Semigroup', 'Monoid' and 'StarSemiring' class instances. data Label a = Zero | One | Symbol a@@ -377,9 +376,17 @@ infixl 6 :+: infixl 7 :*: +-- | Wrap a value into a 'Symbol' constructor+symbol :: a -> Label a+symbol = Symbol++-- | Wrap a list of values into 'Symbol' constructors terminated by 'Zero'+symbols :: Foldable t => t a -> Label a+symbols = foldr ((<>) . Symbol) Zero+ instance IsList (Label a) where type Item (Label a) = a- fromList = foldr ((<>) . Symbol) Zero+ fromList = symbols toList = error "Label.toList cannot be given a reasonable definition" instance Show a => Show (Label a) where
src/Algebra/Graph/Labelled.hs view
@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Algebra.Graph.Labelled--- Copyright : (c) Andrey Mokhov 2016-2022+-- Copyright : (c) Andrey Mokhov 2016-2025 -- License : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability : experimental@@ -52,10 +52,12 @@ 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.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@@ -68,7 +70,7 @@ instance (Eq e, Monoid e, Ord a) => Eq (Graph e a) where x == y = toAdjacencyMap x == toAdjacencyMap y -instance (Eq e, Monoid e, Ord a, Ord e) => Ord (Graph e a) where+instance (Monoid e, Ord a, Ord e) => Ord (Graph e a) where compare x y = compare (toAdjacencyMap x) (toAdjacencyMap y) -- | __Note:__ this does not satisfy the usual ring laws; see 'Graph'@@ -100,6 +102,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 +571,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
src/Algebra/Graph/Labelled/AdjacencyMap.hs view
@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Algebra.Graph.Labelled.AdjacencyMap--- Copyright : (c) Andrey Mokhov 2016-2022+-- Copyright : (c) Andrey Mokhov 2016-2025 -- License : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability : experimental@@ -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
src/Algebra/Graph/Labelled/Example/Automaton.hs view
@@ -2,7 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Algebra.Graph.Labelled.Example.Automaton--- Copyright : (c) Andrey Mokhov 2016-2022+-- Copyright : (c) Andrey Mokhov 2016-2025 -- License : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability : experimental@@ -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
src/Algebra/Graph/Labelled/Example/Network.hs view
@@ -2,7 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Algebra.Graph.Labelled.Example.Network--- Copyright : (c) Andrey Mokhov 2016-2022+-- Copyright : (c) Andrey Mokhov 2016-2025 -- License : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability : experimental
src/Algebra/Graph/NonEmpty.hs view
@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Algebra.Graph.NonEmpty--- Copyright : (c) Andrey Mokhov 2016-2022+-- Copyright : (c) Andrey Mokhov 2016-2025 -- License : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability : experimental@@ -53,7 +53,6 @@ ) where import Control.DeepSeq-import Control.Monad import Control.Monad.Trans.State import Data.List.NonEmpty (NonEmpty (..)) import Data.String@@ -913,15 +912,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 +949,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 -- @
src/Algebra/Graph/NonEmpty/AdjacencyMap.hs view
@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Algebra.Graph.NonEmpty.AdjacencyMap--- Copyright : (c) Andrey Mokhov 2016-2022+-- Copyright : (c) Andrey Mokhov 2016-2025 -- License : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability : experimental@@ -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
src/Algebra/Graph/Relation.hs view
@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Algebra.Graph.Relation--- Copyright : (c) Andrey Mokhov 2016-2022+-- Copyright : (c) Andrey Mokhov 2016-2025 -- License : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability : experimental@@ -46,14 +46,18 @@ import Data.Bifunctor import Data.Set (Set, union) import Data.String-import Data.Tree+import Data.Tree (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 +209,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 +802,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
src/Algebra/Graph/Relation/Preorder.hs view
@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Algebra.Graph.Relation.Preorder--- Copyright : (c) Andrey Mokhov 2016-2022+-- Copyright : (c) Andrey Mokhov 2016-2025 -- License : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability : experimental
src/Algebra/Graph/Relation/Reflexive.hs view
@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Algebra.Graph.Relation.Reflexive--- Copyright : (c) Andrey Mokhov 2016-2022+-- Copyright : (c) Andrey Mokhov 2016-2025 -- License : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability : experimental
src/Algebra/Graph/Relation/Symmetric.hs view
@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Algebra.Graph.Relation.Symmetric--- Copyright : (c) Andrey Mokhov 2016-2022+-- Copyright : (c) Andrey Mokhov 2016-2025 -- License : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability : experimental@@ -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@@ -45,10 +45,12 @@ import Data.Coerce import Data.Set (Set) import Data.String-import Data.Tree+import Data.Tree (Forest, Tree) -import qualified Data.Set as Set+import qualified Data.IntSet as IntSet+import qualified Data.Set as Set +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@@ -138,8 +140,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
src/Algebra/Graph/Relation/Transitive.hs view
@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Algebra.Graph.Relation.Transitive--- Copyright : (c) Andrey Mokhov 2016-2022+-- Copyright : (c) Andrey Mokhov 2016-2025 -- License : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability : experimental
src/Algebra/Graph/ToGraph.hs view
@@ -2,7 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Algebra.Graph.ToGraph--- Copyright : (c) Andrey Mokhov 2016-2022+-- Copyright : (c) Andrey Mokhov 2016-2025 -- License : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability : experimental@@ -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/.
src/Algebra/Graph/Undirected.hs view
@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Algebra.Graph.Undirected--- Copyright : (c) Andrey Mokhov 2016-2022+-- Copyright : (c) Andrey Mokhov 2016-2025 -- License : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability : experimental@@ -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.
src/Data/Graph/Typed.hs view
@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Data.Graph.Typed--- Copyright : (c) Anton Lorenzen, Andrey Mokhov 2016-2022+-- Copyright : (c) Anton Lorenzen, Andrey Mokhov 2016-2025 -- License : MIT (see the file LICENSE) -- Maintainer : anfelor@posteo.de, andrey.mokhov@gmail.com -- Stability : unstable@@ -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
test/Algebra/Graph/Test.hs view
@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Algebra.Graph.Test--- Copyright : (c) Andrey Mokhov 2016-2022+-- Copyright : (c) Andrey Mokhov 2016-2025 -- License : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability : experimental
test/Algebra/Graph/Test/API.hs view
@@ -3,7 +3,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Algebra.Graph.Test.API--- Copyright : (c) Andrey Mokhov 2016-2022+-- Copyright : (c) Andrey Mokhov 2016-2025 -- License : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability : experimental@@ -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
test/Algebra/Graph/Test/Acyclic/AdjacencyMap.hs view
@@ -2,7 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Algebra.Graph.Test.Acyclic.AdjacencyMap--- Copyright : (c) Andrey Mokhov 2016-2022+-- Copyright : (c) Andrey Mokhov 2016-2025 -- License : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability : experimental
test/Algebra/Graph/Test/AdjacencyIntMap.hs view
@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Algebra.Graph.Test.AdjacencyIntMap--- Copyright : (c) Andrey Mokhov 2016-2022+-- Copyright : (c) Andrey Mokhov 2016-2025 -- License : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability : experimental
test/Algebra/Graph/Test/AdjacencyMap.hs view
@@ -2,7 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Algebra.Graph.Test.AdjacencyMap--- Copyright : (c) Andrey Mokhov 2016-2022+-- Copyright : (c) Andrey Mokhov 2016-2025 -- License : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability : experimental
test/Algebra/Graph/Test/Arbitrary.hs view
@@ -1,9 +1,8 @@-{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} ----------------------------------------------------------------------------- -- | -- Module : Algebra.Graph.Test.Arbitrary--- Copyright : (c) Andrey Mokhov 2016-2022+-- Copyright : (c) Andrey Mokhov 2016-2025 -- License : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability : experimental@@ -15,10 +14,8 @@ arbitraryGraph, arbitraryRelation, arbitraryAdjacencyMap, ) where -import Control.Monad import Data.List.NonEmpty (NonEmpty (..), toList) import Data.Maybe (catMaybes)-import Data.Tree import Test.QuickCheck import Algebra.Graph
test/Algebra/Graph/Test/Bipartite/AdjacencyMap.hs view
@@ -2,7 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Algebra.Graph.Test.Bipartite.AdjacencyMap--- Copyright : (c) Andrey Mokhov 2016-2022+-- Copyright : (c) Andrey Mokhov 2016-2025 -- License : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability : experimental@@ -20,7 +20,7 @@ import Algebra.Graph.Test import Data.Either import Data.Either.Extra-import Data.List (nub, sort)+import Data.List (nub) import Data.Map.Strict (Map) import Data.Set (Set) @@ -30,7 +30,6 @@ import qualified Data.Map.Strict as Map import qualified Data.Set as Set import qualified Data.Tuple-import qualified Algebra.Graph.Bipartite.AdjacencyMap as B type AI = AM.AdjacencyMap Int type AII = AM.AdjacencyMap (Either Int Int)
test/Algebra/Graph/Test/Export.hs view
@@ -2,7 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Algebra.Graph.Test.Export--- Copyright : (c) Andrey Mokhov 2016-2022+-- Copyright : (c) Andrey Mokhov 2016-2025 -- License : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability : experimental
test/Algebra/Graph/Test/Generic.hs view
@@ -2,7 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Algebra.Graph.Test.Generic--- Copyright : (c) Andrey Mokhov 2016-2022+-- Copyright : (c) Andrey Mokhov 2016-2025 -- License : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability : experimental@@ -13,7 +13,7 @@ import Control.Monad (when) import Data.Either-import Data.List (nub, sort)+import Data.List (nub) import Data.List.NonEmpty (NonEmpty (..)) import Data.Tree import Data.Tuple@@ -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
test/Algebra/Graph/Test/Graph.hs view
@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Algebra.Graph.Test.Graph--- Copyright : (c) Andrey Mokhov 2016-2022+-- Copyright : (c) Andrey Mokhov 2016-2025 -- License : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability : experimental@@ -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)
test/Algebra/Graph/Test/Internal.hs view
@@ -2,7 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Algebra.Graph.Test.Internal--- Copyright : (c) Andrey Mokhov 2016-2022+-- Copyright : (c) Andrey Mokhov 2016-2025 -- License : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability : experimental
test/Algebra/Graph/Test/Label.hs view
@@ -2,7 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Algebra.Graph.Test.Label--- Copyright : (c) Andrey Mokhov 2016-2022+-- Copyright : (c) Andrey Mokhov 2016-2025 -- License : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability : experimental
test/Algebra/Graph/Test/Labelled/AdjacencyMap.hs view
@@ -2,7 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Algebra.Graph.Test.Labelled.AdjacencyMap--- Copyright : (c) Andrey Mokhov 2016-2022+-- Copyright : (c) Andrey Mokhov 2016-2025 -- License : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability : experimental@@ -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" $
test/Algebra/Graph/Test/Labelled/Graph.hs view
@@ -2,7 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Algebra.Graph.Test.Labelled.Graph--- Copyright : (c) Andrey Mokhov 2016-2022+-- Copyright : (c) Andrey Mokhov 2016-2025 -- License : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability : experimental@@ -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" $
test/Algebra/Graph/Test/NonEmpty/AdjacencyMap.hs view
@@ -2,7 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Algebra.Graph.Test.NonEmpty.AdjacencyMap--- Copyright : (c) Andrey Mokhov 2016-2022+-- Copyright : (c) Andrey Mokhov 2016-2025 -- License : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability : experimental@@ -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) ->
test/Algebra/Graph/Test/NonEmpty/Graph.hs view
@@ -2,7 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Algebra.Graph.Test.NonEmpty.Graph--- Copyright : (c) Andrey Mokhov 2016-2022+-- Copyright : (c) Andrey Mokhov 2016-2025 -- License : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability : experimental@@ -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)
test/Algebra/Graph/Test/Relation.hs view
@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Algebra.Graph.Test.Relation--- Copyright : (c) Andrey Mokhov 2016-2022+-- Copyright : (c) Andrey Mokhov 2016-2025 -- License : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability : experimental
test/Algebra/Graph/Test/Relation/Symmetric.hs view
@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Algebra.Graph.Test.Relation.Symmetric--- Copyright : (c) Andrey Mokhov 2016-2022+-- Copyright : (c) Andrey Mokhov 2016-2025 -- License : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability : experimental
test/Algebra/Graph/Test/RewriteRules.hs view
@@ -2,7 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Algebra.Graph.Test.RewriteRules--- Copyright : (c) Andrey Mokhov 2016-2022+-- Copyright : (c) Andrey Mokhov 2016-2025 -- License : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability : experimental
test/Algebra/Graph/Test/Undirected.hs view
@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Algebra.Graph.Test.Undirected--- Copyright : (c) Andrey Mokhov 2016-2022+-- Copyright : (c) Andrey Mokhov 2016-2025 -- License : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability : experimental
test/Data/Graph/Test/Typed.hs view
@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Data.Graph.Test.Typed--- Copyright : (c) Andrey Mokhov 2016-2022+-- Copyright : (c) Andrey Mokhov 2016-2025 -- License : MIT (see the file LICENSE) -- Maintainer : anfelor@posteo.de, andrey.mokhov@gmail.com -- Stability : experimental@@ -13,22 +13,26 @@ 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-import Data.List (nub, sort)+import Data.List (nub) 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]" $