algebraic-graphs 0.0.3 → 0.0.4

raw patch · 23 files changed

+1823/−1307 lines, 23 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• README.md +54/−4
• algebraic-graphs.cabal +2/−1
• src/Algebra/Graph.hs +55/−25
• src/Algebra/Graph/AdjacencyMap.hs +232/−26
• src/Algebra/Graph/AdjacencyMap/Internal.hs +45/−229
• src/Algebra/Graph/Class.hs +15/−0
• src/Algebra/Graph/Fold.hs +28/−15
• src/Algebra/Graph/HigherKinded/Class.hs +34/−13
• src/Algebra/Graph/IntAdjacencyMap.hs +233/−27
• src/Algebra/Graph/IntAdjacencyMap/Internal.hs +51/−235
• src/Algebra/Graph/Relation.hs +323/−14
• src/Algebra/Graph/Relation/Internal.hs +53/−461
• src/Algebra/Graph/Relation/InternalDerived.hs +161/−0
• src/Algebra/Graph/Relation/Preorder.hs +2/−1
• src/Algebra/Graph/Relation/Reflexive.hs +2/−1
• src/Algebra/Graph/Relation/Symmetric.hs +2/−1
• src/Algebra/Graph/Relation/Transitive.hs +2/−1
• test/Algebra/Graph/Test/AdjacencyMap.hs +69/−40
• test/Algebra/Graph/Test/Arbitrary.hs +32/−17
• test/Algebra/Graph/Test/Fold.hs +116/−55
• test/Algebra/Graph/Test/Graph.hs +125/−62
• test/Algebra/Graph/Test/IntAdjacencyMap.hs +68/−39
• test/Algebra/Graph/Test/Relation.hs +119/−40

@@ -2,14 +2,64 @@  [![Hackage version](https://img.shields.io/hackage/v/algebraic-graphs.svg?label=Hackage)](https://hackage.haskell.org/package/algebraic-graphs) [![Linux & OS X status](https://img.shields.io/travis/snowleopard/alga/master.svg?label=Linux%20%26%20OS%20X)](https://travis-ci.org/snowleopard/alga) [![Windows status](https://img.shields.io/appveyor/ci/snowleopard/alga/master.svg?label=Windows)](https://ci.appveyor.com/project/snowleopard/alga) -A library for algebraic construction and manipulation of graphs in Haskell. See+**Alga** is a library for algebraic construction and manipulation of graphs in Haskell. See [this paper](https://github.com/snowleopard/alga-paper) for the motivation behind the library, the underlying theory and implementation details. -The following series of blog posts also describe the ideas behind the library:+## Main idea++Consider the following data type, which is defined in the top-level module+[Algebra.Graph](http://hackage.haskell.org/package/algebraic-graphs/docs/Algebra-Graph.html)+of the library:++```haskell+data Graph a = Empty | Vertex a | Overlay (Graph a) (Graph a) | Connect (Graph a) (Graph a)  +```++We can give the following semantics to the constructors in terms of the pair **(V, E)** of graph *vertices* and *edges*:++* `Empty` constructs the empty graph **(∅, ∅)**.+* `Vertex x` constructs a graph containing a single vertex, i.e. **({x}, ∅)**.+* `Overlay x y` overlays graphs **(Vx, Ex)** and **(Vy, Ey)** constructing **(Vx ∪ Vy, Ex ∪ Ey)**.+* `Connect x y` connects graphs **(Vx, Ex)** and **(Vy, Ey)** constructing **(Vx ∪ Vy, Ex ∪ Ey ∪ Vx × Vy)**.++Alternatively, we can give an algebraic semantics to the above graph construction primitives by defining the following+type class and specifying a set of laws for its instances (see module [Algebra.Graph.Class](http://hackage.haskell.org/package/algebraic-graphs/docs/Algebra-Graph-Class.html)):++```haskell+class Graph g where+    type Vertex g+    empty   :: g+    vertex  :: Vertex g -> g+    overlay :: g -> g -> g+    connect :: g -> g -> g+```++The laws of the type class are remarkably similar to those of a [semiring](https://en.wikipedia.org/wiki/Semiring),+so we use `+` and `*` as convenient shortcuts for `overlay` and `connect`, respectively:++* (`+`, `empty`) is an idempotent commutative monoid.+* (`*`, `empty`) is a monoid.+* `*` distributes over `+`, that is: `x * (y + z) == x * y + x * z` and `(x + y) * z == x * z + y * z`.+* `*` can be decomposed: `x * y * z == x * y + x * z + y * z`.++This algebraic structure corresponds to *unlabelled directed graphs*: every expression represents a graph, and every+graph can be represented by an expression. Other types of graphs (e.g. undirected) can be obtained by modifying the+above set of laws. Algebraic graphs provide a convenient, safe and powerful interface for working with graphs in Haskell,+and allow the application of equational reasoning for proving the correctness of graph algorithms.++## How fast is the library?++Alga can handle graphs comprising millions of vertices and billions of edges in a matter of seconds, which is fast+enough for many applications. We believe there is a lot of potential for improving the performance of the library, and+this is one of our top priorities. If you come across a performance issue when using the library, please let us know.++Some preliminary benchmarks can be found in [doc/benchmarks](https://github.com/snowleopard/alga/blob/master/doc/benchmarks.md).++## Blog posts++The development of the library has been documented in the series of blog posts: * Introduction: https://blogs.ncl.ac.uk/andreymokhov/an-algebra-of-graphs/ * A few different flavours of the algebra: https://blogs.ncl.ac.uk/andreymokhov/graphs-a-la-carte/ * Graphs in disguise or How to plan you holiday using Haskell: https://blogs.ncl.ac.uk/andreymokhov/graphs-in-disguise/ * Old graphs from new types: https://blogs.ncl.ac.uk/andreymokhov/old-graphs-from-new-types/--Some preliminary benchmarks can be found in [doc/benchmarks](https://github.com/snowleopard/alga/blob/master/doc/benchmarks.md).

@@ -1,5 +1,5 @@ name:          algebraic-graphs-version:       0.0.3+version:       0.0.4 synopsis:      A library for algebraic graph construction and transformation license:       MIT license-file:  LICENSE@@ -59,6 +59,7 @@                         Algebra.Graph.IntAdjacencyMap.Internal,                         Algebra.Graph.Relation,                         Algebra.Graph.Relation.Internal,+                        Algebra.Graph.Relation.InternalDerived,                         Algebra.Graph.Relation.Preorder,                         Algebra.Graph.Relation.Reflexive,                         Algebra.Graph.Relation.Symmetric,

@@ -58,8 +58,8 @@ import qualified Data.Tree                        as Tree  {-| The 'Graph' datatype is a deep embedding of the core graph construction-primitives 'empty', 'vertex', 'overlay' and 'connect'. We define a-law-abiding 'Num' instance as a convenient notation for working with graphs:+primitives 'empty', 'vertex', 'overlay' and 'connect'. We define a 'Num'+instance as a convenient notation for working with graphs:      > 0           == Vertex 0     > 1 + 2       == Overlay (Vertex 1) (Vertex 2)@@ -482,6 +482,7 @@ -- edgeList ('edge' x y)     == [(x,y)] -- edgeList ('star' 2 [3,1]) == [(2,1), (2,3)] -- edgeList . 'edges'        == 'Data.List.nub' . 'Data.List.sort'+-- edgeList . 'transpose'    == 'Data.List.sort' . map 'Data.Tuple.swap' . edgeList -- @ edgeList :: Ord a => Graph a -> [(a, a)] edgeList = AM.edgeList . C.toGraph@@ -528,9 +529,10 @@ -- given list. -- -- @--- path []    == 'empty'--- path [x]   == 'vertex' x--- path [x,y] == 'edge' x y+-- path []        == 'empty'+-- path [x]       == 'vertex' x+-- path [x,y]     == 'edge' x y+-- path . 'reverse' == 'transpose' . path -- @ path :: [a] -> Graph a path = H.path@@ -540,9 +542,10 @@ -- given list. -- -- @--- circuit []    == 'empty'--- circuit [x]   == 'edge' x x--- circuit [x,y] == 'edges' [(x,y), (y,x)]+-- circuit []        == 'empty'+-- circuit [x]       == 'edge' x x+-- circuit [x,y]     == 'edges' [(x,y), (y,x)]+-- circuit . 'reverse' == 'transpose' . circuit -- @ circuit :: [a] -> Graph a circuit = H.circuit@@ -552,10 +555,11 @@ -- given list. -- -- @--- clique []      == 'empty'--- clique [x]     == 'vertex' x--- clique [x,y]   == 'edge' x y--- clique [x,y,z] == 'edges' [(x,y), (x,z), (y,z)]+-- clique []        == 'empty'+-- clique [x]       == 'vertex' x+-- clique [x,y]     == 'edge' x y+-- clique [x,y,z]   == 'edges' [(x,y), (x,z), (y,z)]+-- clique . 'reverse' == 'transpose' . clique -- @ clique :: [a] -> Graph a clique = H.clique@@ -569,6 +573,7 @@ -- biclique [x]     []      == 'vertex' x -- biclique []      [y]     == 'vertex' y -- biclique [x1,x2] [y1,y2] == 'edges' [(x1,y1), (x1,y2), (x2,y1), (x2,y2)]+-- biclique xs      ys      == 'connect' ('vertices' xs) ('vertices' ys) -- @ biclique :: [a] -> [a] -> Graph a biclique = H.biclique@@ -588,12 +593,26 @@ -- | The /tree graph/ constructed from a given 'Tree' data structure. -- Complexity: /O(T)/ time, memory and size, where /T/ is the size of the -- given tree (i.e. the number of vertices in the tree).+--+-- @+-- tree (Node x [])                                         == 'vertex' x+-- tree (Node x [Node y [Node z []]])                       == 'path' [x,y,z]+-- tree (Node x [Node y [], Node z []])                     == 'star' x [y,z]+-- tree (Node 1 [Node 2 [], Node 3 [Node 4 [], Node 5 []]]) == 'edges' [(1,2), (1,3), (3,4), (3,5)]+-- @ tree :: Tree.Tree a -> Graph a tree = H.tree  -- | The /forest graph/ constructed from a given 'Forest' data structure. -- Complexity: /O(F)/ time, memory and size, where /F/ is the size of the -- given forest (i.e. the number of vertices in the forest).+--+-- @+-- forest []                                                  == 'empty'+-- forest [x]                                                 == 'tree' x+-- forest [Node 1 [Node 2 [], Node 3 []], Node 4 [Node 5 []]] == 'edges' [(1,2), (1,3), (4,5)]+-- forest                                                     == 'overlays' . map 'tree'+-- @ forest :: Tree.Forest a -> Graph a forest = H.forest @@ -627,17 +646,20 @@ torus :: [a] -> [b] -> Graph (a, b) torus = H.torus --- | Construct a /De Bruijn graph/ of given dimension and symbols of a given--- alphabet.--- Complexity: /O(A * D^A)/ time, memory and size, where /A/ is the size of the+-- | Construct a /De Bruijn graph/ of a given non-negative dimension using symbols+-- from a given alphabet.+-- Complexity: /O(A^(D + 1))/ time, memory and size, where /A/ is the size of the -- alphabet and /D/ is the dimention of the graph. -- -- @--- deBruijn k []    == 'empty'--- deBruijn 1 [0,1] == 'edges' [ ([0],[0]), ([0],[1]), ([1],[0]), ([1],[1]) ]--- deBruijn 2 "0"   == 'edge' "00" "00"--- deBruijn 2 "01"  == 'edges' [ ("00","00"), ("00","01"), ("01","10"), ("01","11")---                           , ("10","00"), ("10","01"), ("11","10"), ("11","11") ]+--           deBruijn 0 xs               == 'edge' [] []+-- n > 0 'Test.QuickCheck.==>' deBruijn n []               == 'empty'+--           deBruijn 1 [0,1]            == 'edges' [ ([0],[0]), ([0],[1]), ([1],[0]), ([1],[1]) ]+--           deBruijn 2 "0"              == 'edge' "00" "00"+--           deBruijn 2 "01"             == 'edges' [ ("00","00"), ("00","01"), ("01","10"), ("01","11")+--                                                , ("10","00"), ("10","01"), ("11","10"), ("11","11") ]+--           'vertexCount' (deBruijn n xs) == ('length' $ 'Data.List.nub' xs)^n+-- n > 0 'Test.QuickCheck.==>' 'edgeCount'   (deBruijn n xs) == ('length' $ 'Data.List.nub' xs)^(n + 1) -- @ deBruijn :: Int -> [a] -> Graph [a] deBruijn = H.deBruijn@@ -740,6 +762,11 @@ -- transpose ('vertex' x)  == 'vertex' x -- transpose ('edge' x y)  == 'edge' y x -- transpose . transpose == id+-- transpose . 'path'      == 'path'    . 'reverse'+-- transpose . 'circuit'   == 'circuit' . 'reverse'+-- transpose . 'clique'    == 'clique'  . 'reverse'+-- transpose ('box' x y)   == 'box' (transpose x) (transpose y)+-- 'edgeList' . transpose  == 'Data.List.sort' . map 'Data.Tuple.swap' . 'edgeList' -- @ transpose :: Graph a -> Graph a transpose = foldg empty vertex overlay (flip connect)@@ -802,11 +829,14 @@ -- stands for the equality up to an isomorphism, e.g. @(x, ()) ~~ x@. -- -- @--- box x y             ~~ box y x--- box x (box y z)     ~~ box (box x y) z--- box x ('overlay' y z) == 'overlay' (box x y) (box x z)--- box x ('vertex' ())   ~~ x--- box x 'empty'         ~~ 'empty'+-- box x y               ~~ box y x+-- box x (box y z)       ~~ box (box x y) z+-- box x ('overlay' y z)   == 'overlay' (box x y) (box x z)+-- box x ('vertex' ())     ~~ x+-- box x 'empty'           ~~ 'empty'+-- 'transpose'   (box x y) == box ('transpose' x) ('transpose' y)+-- 'vertexCount' (box x y) == 'vertexCount' x * 'vertexCount' y+-- 'edgeCount'   (box x y) <= 'vertexCount' x * 'edgeCount' y + 'edgeCount' x * 'vertexCount' y -- @ box :: Graph a -> Graph b -> Graph (a, b) box = H.box

@@ -56,6 +56,31 @@ import qualified Data.Map.Strict     as Map import qualified Data.Set            as Set +-- | Construct the /empty graph/.+-- Complexity: /O(1)/ time and memory.+--+-- @+-- 'isEmpty'     empty == True+-- 'hasVertex' x empty == False+-- 'vertexCount' empty == 0+-- 'edgeCount'   empty == 0+-- @+empty :: Ord a => AdjacencyMap a+empty = C.empty++-- | Construct the graph comprising /a single isolated vertex/.+-- Complexity: /O(1)/ time and memory.+--+-- @+-- 'isEmpty'     (vertex x) == False+-- 'hasVertex' x (vertex x) == True+-- 'hasVertex' 1 (vertex 2) == False+-- 'vertexCount' (vertex x) == 1+-- 'edgeCount'   (vertex x) == 0+-- @+vertex :: Ord a => a -> AdjacencyMap a+vertex = C.vertex+ -- | Construct the graph comprising /a single edge/. -- Complexity: /O(1)/ time, memory. --@@ -69,6 +94,70 @@ edge :: Ord a => a -> a -> AdjacencyMap a edge = C.edge +-- | /Overlay/ two graphs. This is an idempotent, commutative and associative+-- operation with the identity 'empty'.+-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.+--+-- @+-- 'isEmpty'     (overlay x y) == 'isEmpty'   x   && 'isEmpty'   y+-- 'hasVertex' z (overlay x y) == 'hasVertex' z x || 'hasVertex' z y+-- 'vertexCount' (overlay x y) >= 'vertexCount' x+-- 'vertexCount' (overlay x y) <= 'vertexCount' x + 'vertexCount' y+-- 'edgeCount'   (overlay x y) >= 'edgeCount' x+-- 'edgeCount'   (overlay x y) <= 'edgeCount' x   + 'edgeCount' y+-- 'vertexCount' (overlay 1 2) == 2+-- 'edgeCount'   (overlay 1 2) == 0+-- @+overlay :: Ord a => AdjacencyMap a -> AdjacencyMap a -> AdjacencyMap a+overlay = C.overlay++-- | /Connect/ two graphs. This is an associative operation with the identity+-- 'empty', which distributes over the overlay and obeys the decomposition axiom.+-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory. Note that the+-- number of edges in the resulting graph is quadratic with respect to the number+-- of vertices of the arguments: /m = O(m1 + m2 + n1 * n2)/.+--+-- @+-- 'isEmpty'     (connect x y) == 'isEmpty'   x   && 'isEmpty'   y+-- 'hasVertex' z (connect x y) == 'hasVertex' z x || 'hasVertex' z y+-- 'vertexCount' (connect x y) >= 'vertexCount' x+-- 'vertexCount' (connect x y) <= 'vertexCount' x + 'vertexCount' y+-- 'edgeCount'   (connect x y) >= 'edgeCount' x+-- 'edgeCount'   (connect x y) >= 'edgeCount' y+-- 'edgeCount'   (connect x y) >= 'vertexCount' x * 'vertexCount' y+-- 'edgeCount'   (connect x y) <= 'vertexCount' x * 'vertexCount' y + 'edgeCount' x + 'edgeCount' y+-- 'vertexCount' (connect 1 2) == 2+-- 'edgeCount'   (connect 1 2) == 1+-- @+connect :: Ord a => AdjacencyMap a -> AdjacencyMap a -> AdjacencyMap a+connect = C.connect++-- | Construct the graph comprising a given list of isolated vertices.+-- Complexity: /O(L * log(L))/ time and /O(L)/ memory, where /L/ is the length+-- of the given list.+--+-- @+-- vertices []            == 'empty'+-- vertices [x]           == 'vertex' x+-- 'hasVertex' x . vertices == 'elem' x+-- 'vertexCount' . vertices == 'length' . 'Data.List.nub'+-- 'vertexSet'   . vertices == Set.'Set.fromList'+-- @+vertices :: Ord a => [a] -> AdjacencyMap a+vertices = AdjacencyMap . Map.fromList . map (\x -> (x, Set.empty))++-- | Construct the graph from a list of edges.+-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.+--+-- @+-- edges []          == 'empty'+-- edges [(x, y)]    == 'edge' x y+-- 'edgeCount' . edges == 'length' . 'Data.List.nub'+-- 'edgeList' . edges  == 'Data.List.nub' . 'Data.List.sort'+-- @+edges :: Ord a => [(a, a)] -> AdjacencyMap a+edges = fromAdjacencyList . map (fmap return)+ -- | Overlay a given list of graphs. -- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory. --@@ -107,6 +196,23 @@ graph :: Ord a => [a] -> [(a, a)] -> AdjacencyMap a graph vs es = overlay (vertices vs) (edges es) +-- | Construct a graph from an adjacency list.+-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.+--+-- @+-- fromAdjacencyList []                                  == 'empty'+-- fromAdjacencyList [(x, [])]                           == 'vertex' x+-- fromAdjacencyList [(x, [y])]                          == 'edge' x y+-- fromAdjacencyList . 'adjacencyList'                     == id+-- 'overlay' (fromAdjacencyList xs) (fromAdjacencyList ys) == fromAdjacencyList (xs ++ ys)+-- @+fromAdjacencyList :: Ord a => [(a, [a])] -> AdjacencyMap a+fromAdjacencyList as = AdjacencyMap $ Map.unionWith Set.union vs es+  where+    ss = map (fmap Set.fromList) as+    vs = Map.fromSet (const Set.empty) . Set.unions $ map snd ss+    es = Map.fromListWith Set.union ss+ -- | The 'isSubgraphOf' function takes two graphs and returns 'True' if the -- first graph is a /subgraph/ of the second. -- Complexity: /O((n + m) * log(n))/ time.@@ -193,6 +299,32 @@ vertexList :: Ord a => AdjacencyMap a -> [a] vertexList = Map.keys . adjacencyMap +-- | The sorted list of edges of a graph.+-- Complexity: /O(n + m)/ time and /O(m)/ memory.+--+-- @+-- edgeList 'empty'          == []+-- edgeList ('vertex' x)     == []+-- edgeList ('edge' x y)     == [(x,y)]+-- edgeList ('star' 2 [3,1]) == [(2,1), (2,3)]+-- edgeList . 'edges'        == 'Data.List.nub' . 'Data.List.sort'+-- @+edgeList :: AdjacencyMap a -> [(a, a)]+edgeList (AdjacencyMap m) = [ (x, y) | (x, ys) <- Map.toAscList m, y <- Set.toAscList ys ]++-- | The sorted /adjacency list/ of a graph.+-- Complexity: /O(n + m)/ time and /O(m)/ memory.+--+-- @+-- adjacencyList 'empty'               == []+-- adjacencyList ('vertex' x)          == [(x, [])]+-- adjacencyList ('edge' 1 2)          == [(1, [2]), (2, [])]+-- adjacencyList ('star' 2 [3,1])      == [(1, []), (2, [1,3]), (3, [])]+-- 'fromAdjacencyList' . adjacencyList == id+-- @+adjacencyList :: AdjacencyMap a -> [(a, [a])]+adjacencyList = map (fmap Set.toAscList) . Map.toAscList . adjacencyMap+ -- | The set of vertices of a given graph. -- Complexity: /O(n)/ time and memory. --@@ -263,16 +395,23 @@ clique = C.clique  -- | The /biclique/ on a list of vertices.--- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.+-- Complexity: /O(n * log(n) + m)/ time and /O(n + m)/ memory. -- -- @ -- biclique []      []      == 'empty' -- biclique [x]     []      == 'vertex' x -- biclique []      [y]     == 'vertex' y -- biclique [x1,x2] [y1,y2] == 'edges' [(x1,y1), (x1,y2), (x2,y1), (x2,y2)]+-- biclique xs      ys      == 'connect' ('vertices' xs) ('vertices' ys) -- @ biclique :: Ord a => [a] -> [a] -> AdjacencyMap a-biclique = C.biclique+biclique xs ys = AdjacencyMap $ Map.fromSet adjacent (x `Set.union` y)+  where+    x = Set.fromList xs+    y = Set.fromList ys+    adjacent v+        | v `Set.member` x = y+        | otherwise        = Set.empty  -- | The /star/ formed by a centre vertex and a list of leaves. -- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.@@ -287,14 +426,51 @@  -- | The /tree graph/ constructed from a given 'Tree' data structure. -- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.+--+-- @+-- tree (Node x [])                                         == 'vertex' x+-- tree (Node x [Node y [Node z []]])                       == 'path' [x,y,z]+-- tree (Node x [Node y [], Node z []])                     == 'star' x [y,z]+-- tree (Node 1 [Node 2 [], Node 3 [Node 4 [], Node 5 []]]) == 'edges' [(1,2), (1,3), (3,4), (3,5)]+-- @ tree :: Ord a => Tree a -> AdjacencyMap a tree = C.tree  -- | The /forest graph/ constructed from a given 'Forest' data structure. -- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.+--+-- @+-- forest []                                                  == 'empty'+-- forest [x]                                                 == 'tree' x+-- forest [Node 1 [Node 2 [], Node 3 []], Node 4 [Node 5 []]] == 'edges' [(1,2), (1,3), (4,5)]+-- forest                                                     == 'overlays' . map 'tree'+-- @ forest :: Ord a => Forest a -> AdjacencyMap a forest = C.forest +-- | Remove a vertex from a given graph.+-- Complexity: /O(n*log(n))/ time.+--+-- @+-- removeVertex x ('vertex' x)       == 'empty'+-- removeVertex x . removeVertex x == removeVertex x+-- @+removeVertex :: Ord a => a -> AdjacencyMap a -> AdjacencyMap a+removeVertex x = AdjacencyMap . Map.map (Set.delete x) . Map.delete x . adjacencyMap++-- | Remove an edge from a given graph.+-- Complexity: /O(log(n))/ time.+--+-- @+-- removeEdge x y ('edge' x y)       == 'vertices' [x, y]+-- removeEdge x y . removeEdge x y == removeEdge x y+-- removeEdge x y . 'removeVertex' x == 'removeVertex' x+-- removeEdge 1 1 (1 * 1 * 2 * 2)  == 1 * 2 * 2+-- removeEdge 1 2 (1 * 1 * 2 * 2)  == 1 * 1 + 2 * 2+-- @+removeEdge :: Ord a => a -> a -> AdjacencyMap a -> AdjacencyMap a+removeEdge x y = AdjacencyMap . Map.adjust (Set.delete y) x . adjacencyMap+ -- | The function @'replaceVertex' x y@ replaces vertex @x@ with vertex @y@ in a -- given 'AdjacencyMap'. If @y@ already exists, @x@ and @y@ will be merged. -- Complexity: /O((n + m) * log(n))/ time.@@ -320,37 +496,35 @@ mergeVertices :: Ord a => (a -> Bool) -> a -> AdjacencyMap a -> AdjacencyMap a mergeVertices p v = gmap $ \u -> if p u then v else u --- | 'GraphKL' encapsulates King-Launchbury graphs, which are implemented in--- the "Data.Graph" module of the @containers@ library. If @graphKL g == h@ then--- the following holds:------ @--- map ('getVertex' h) ('Data.Graph.vertices' $ 'getGraph' h)                            == Set.'Set.toAscList' ('vertexSet' g)--- map (\\(x, y) -> ('getVertex' h x, 'getVertex' h y)) ('Data.Graph.edges' $ 'getGraph' h) == 'edgeList' g--- @-data GraphKL a = GraphKL {-    -- | Array-based graph representation (King and Launchbury, 1995).-    getGraph :: KL.Graph,-    -- | A mapping of "Data.Graph.Vertex" to vertices of type @a@.-    getVertex :: KL.Vertex -> a }---- | Build 'GraphKL' from the adjacency map of a graph.+-- | Transform a graph by applying a function to each of its vertices. This is+-- similar to @Functor@'s 'fmap' but can be used with non-fully-parametric+-- 'AdjacencyMap'.+-- Complexity: /O((n + m) * log(n))/ time. -- -- @--- 'fromGraphKL' . graphKL == id+-- gmap f 'empty'      == 'empty'+-- gmap f ('vertex' x) == 'vertex' (f x)+-- gmap f ('edge' x y) == 'edge' (f x) (f y)+-- gmap id           == id+-- gmap f . gmap g   == gmap (f . g) -- @-graphKL :: Ord a => AdjacencyMap a -> GraphKL a-graphKL m = GraphKL g $ \u -> case r u of (_, v, _) -> v-  where-    (g, r) = KL.graphFromEdges' [ ((), v, us) | (v, us) <- adjacencyList m ]+gmap :: (Ord a, Ord b) => (a -> b) -> AdjacencyMap a -> AdjacencyMap b+gmap f = AdjacencyMap . Map.map (Set.map f) . Map.mapKeysWith Set.union f . adjacencyMap --- | Extract the adjacency map of a King-Launchbury graph.+-- | Construct the /induced subgraph/ of a given graph by removing the+-- vertices that do not satisfy a given predicate.+-- Complexity: /O(m)/ time, assuming that the predicate takes /O(1)/ to+-- be evaluated. -- -- @--- fromGraphKL . 'graphKL' == id+-- induce (const True)  x      == x+-- induce (const False) x      == 'empty'+-- induce (/= x)               == 'removeVertex' x+-- induce p . induce q         == induce (\\x -> p x && q x)+-- 'isSubgraphOf' (induce p x) x == True -- @-fromGraphKL :: Ord a => GraphKL a -> AdjacencyMap a-fromGraphKL (GraphKL g r) = fromAdjacencyList $ map (\(x, ys) -> (r x, map r ys)) (assocs g)+induce :: Ord a => (a -> Bool) -> AdjacencyMap a -> AdjacencyMap a+induce p = AdjacencyMap . Map.map (Set.filter p) . Map.filterWithKey (\k _ -> p k) . adjacencyMap  -- | Compute the /depth-first search/ forest of a graph. --@@ -420,3 +594,35 @@     GraphKL g r = graphKL m     components  = Map.fromList $ concatMap (expand . fmap r . toList) (KL.scc g)     expand xs   = let s = Set.fromList xs in map (\x -> (x, s)) xs++-- | 'GraphKL' encapsulates King-Launchbury graphs, which are implemented in+-- the "Data.Graph" module of the @containers@ library. If @graphKL g == h@ then+-- the following holds:+--+-- @+-- map ('getVertex' h) ('Data.Graph.vertices' $ 'getGraph' h)                            == Set.'Set.toAscList' ('vertexSet' g)+-- map (\\(x, y) -> ('getVertex' h x, 'getVertex' h y)) ('Data.Graph.edges' $ 'getGraph' h) == 'edgeList' g+-- @+data GraphKL a = GraphKL {+    -- | Array-based graph representation (King and Launchbury, 1995).+    getGraph :: KL.Graph,+    -- | A mapping of "Data.Graph.Vertex" to vertices of type @a@.+    getVertex :: KL.Vertex -> a }++-- | Build 'GraphKL' from the adjacency map of a graph.+--+-- @+-- 'fromGraphKL' . graphKL == id+-- @+graphKL :: Ord a => AdjacencyMap a -> GraphKL a+graphKL m = GraphKL g $ \u -> case r u of (_, v, _) -> v+  where+    (g, r) = KL.graphFromEdges' [ ((), v, us) | (v, us) <- adjacencyList m ]++-- | Extract the adjacency map of a King-Launchbury graph.+--+-- @+-- fromGraphKL . 'graphKL' == id+-- @+fromGraphKL :: Ord a => GraphKL a -> AdjacencyMap a+fromGraphKL (GraphKL g r) = fromAdjacencyList $ map (\(x, ys) -> (r x, map r ys)) (assocs g)

@@ -9,32 +9,23 @@ -- This module exposes the implementation of adjacency maps. The API is unstable -- and unsafe. Where possible use non-internal module "Algebra.Graph.AdjacencyMap" -- instead.--- ----------------------------------------------------------------------------- module Algebra.Graph.AdjacencyMap.Internal (-    -- * Adjacency map-    AdjacencyMap (..), consistent,--    -- * Basic graph construction primitives-    empty, vertex, overlay, connect, vertices, edges, fromAdjacencyList,--    -- * Graph properties-    edgeList, adjacencyList,--    -- * Graph transformation-    removeVertex, removeEdge, gmap, induce+    -- * Adjacency map implementation+    AdjacencyMap (..), consistent   ) where  import Data.Map.Strict (Map, keysSet, fromSet) import Data.Set (Set) -import qualified Algebra.Graph.Class as C-import qualified Data.Map.Strict     as Map-import qualified Data.Set            as Set+import Algebra.Graph.Class +import qualified Data.Map.Strict as Map+import qualified Data.Set        as Set+ {-| The 'AdjacencyMap' data type represents a graph by a map of vertices to-their adjacency sets. We define a law-abiding 'Num' instance as a convenient-notation for working with graphs:+their adjacency sets. We define a 'Num' instance as a convenient notation for+working with graphs:      > 0           == vertex 0     > 1 + 2       == overlay (vertex 1) (vertex 2)@@ -44,7 +35,7 @@  The 'Show' instance is defined using basic graph construction primitives: -@show ('empty'     :: AdjacencyMap Int) == "empty"+@show (empty     :: AdjacencyMap Int) == "empty" show (1         :: AdjacencyMap Int) == "vertex 1" show (1 + 2     :: AdjacencyMap Int) == "vertices [1,2]" show (1 * 2     :: AdjacencyMap Int) == "edge 1 2"@@ -53,35 +44,38 @@  The 'Eq' instance satisfies all axioms of algebraic graphs: -    * 'overlay' is commutative and associative:+    * 'Algebra.Graph.AdjacencyMap.overlay' is commutative and associative:          >       x + y == y + x         > x + (y + z) == (x + y) + z -    * 'connect' is associative and has 'empty' as the identity:+    * 'Algebra.Graph.AdjacencyMap.connect' is associative and has+    'Algebra.Graph.AdjacencyMap.empty' as the identity:          >   x * empty == x         >   empty * x == x         > x * (y * z) == (x * y) * z -    * 'connect' distributes over 'overlay':+    * 'Algebra.Graph.AdjacencyMap.connect' distributes over+    'Algebra.Graph.AdjacencyMap.overlay':          > x * (y + z) == x * y + x * z         > (x + y) * z == x * z + y * z -    * 'connect' can be decomposed:+    * 'Algebra.Graph.AdjacencyMap.connect' can be decomposed:          > x * y * z == x * y + x * z + y * z  The following useful theorems can be proved from the above set of axioms. -    * 'overlay' has 'empty' as the identity and is idempotent:+    * 'Algebra.Graph.AdjacencyMap.overlay' has 'Algebra.Graph.AdjacencyMap.empty'+    as the identity and is idempotent:          >   x + empty == x         >   empty + x == x         >       x + x == x -    * Absorption and saturation of 'connect':+    * Absorption and saturation of 'Algebra.Graph.AdjacencyMap.connect':          > x * y + x + y == x * y         >     x * x * x == x * x@@ -96,26 +90,27 @@   } deriving Eq  instance (Ord a, Show a) => Show (AdjacencyMap a) where-    show a@(AdjacencyMap m)+    show (AdjacencyMap m)         | m == Map.empty = "empty"         | es == []       = if Set.size vs > 1 then "vertices " ++ show (Set.toAscList vs)                                               else "vertex "   ++ show v-        | vs == related  = if length es > 1 then "edges " ++ show es+        | vs == referred = if length es > 1 then "edges " ++ show es                                             else "edge "  ++ show e ++ " " ++ show f         | otherwise      = "graph " ++ show (Set.toAscList vs) ++ " " ++ show es       where-        vs      = keysSet m-        es      = edgeList a-        v       = head $ Set.toList vs-        (e,f)   = head es-        related = Set.fromList . uncurry (++) $ unzip es+        vs       = keysSet m+        es       = internalEdgeList m+        v        = head $ Set.toList vs+        (e, f)   = head es+        referred = referredToVertexSet m -instance Ord a => C.Graph (AdjacencyMap a) where+instance Ord a => Graph (AdjacencyMap a) where     type Vertex (AdjacencyMap a) = a-    empty   = empty-    vertex  = vertex-    overlay = overlay-    connect = connect+    empty       = AdjacencyMap $ Map.empty+    vertex x    = AdjacencyMap $ Map.singleton x Set.empty+    overlay x y = AdjacencyMap $ Map.unionWith Set.union (adjacencyMap x) (adjacencyMap y)+    connect x y = AdjacencyMap $ Map.unionsWith Set.union [ adjacencyMap x, adjacencyMap y,+        fromSet (const . keysSet $ adjacencyMap y) (keysSet $ adjacencyMap x) ]  instance (Ord a, Num a) => Num (AdjacencyMap a) where     fromInteger = vertex . fromInteger@@ -128,204 +123,25 @@ -- | Check if the internal graph representation is consistent, i.e. that all -- edges refer to existing vertices. It should be impossible to create an -- inconsistent adjacency map, and we use this function in testing.+-- /Note: this function is for internal use only/. -- -- @--- consistent 'empty'                  == True--- consistent ('vertex' x)             == True--- consistent ('overlay' x y)          == True--- consistent ('connect' x y)          == True+-- consistent 'Algebra.Graph.AdjacencyMap.empty'                  == True+-- consistent ('Algebra.Graph.AdjacencyMap.vertex' x)             == True+-- consistent ('Algebra.Graph.AdjacencyMap.overlay' x y)          == True+-- consistent ('Algebra.Graph.AdjacencyMap.connect' x y)          == True -- consistent ('Algebra.Graph.AdjacencyMap.edge' x y)             == True--- consistent ('edges' xs)             == True+-- consistent ('Algebra.Graph.AdjacencyMap.edges' xs)             == True -- consistent ('Algebra.Graph.AdjacencyMap.graph' xs ys)          == True--- consistent ('fromAdjacencyList' xs) == True+-- consistent ('Algebra.Graph.AdjacencyMap.fromAdjacencyList' xs) == True -- @ consistent :: Ord a => AdjacencyMap a -> Bool-consistent m = Set.fromList (uncurry (++) $ unzip $ edgeList m)-    `Set.isSubsetOf` keysSet (adjacencyMap m)---- | Construct the /empty graph/.--- Complexity: /O(1)/ time and memory.------ @--- 'Algebra.Graph.AdjacencyMap.isEmpty'     empty == True--- 'Algebra.Graph.AdjacencyMap.hasVertex' x empty == False--- 'Algebra.Graph.AdjacencyMap.vertexCount' empty == 0--- 'Algebra.Graph.AdjacencyMap.edgeCount'   empty == 0--- @-empty :: AdjacencyMap a-empty = AdjacencyMap $ Map.empty---- | Construct the graph comprising /a single isolated vertex/.--- Complexity: /O(1)/ time and memory.------ @--- 'Algebra.Graph.AdjacencyMap.isEmpty'     (vertex x) == False--- 'Algebra.Graph.AdjacencyMap.hasVertex' x (vertex x) == True--- 'Algebra.Graph.AdjacencyMap.hasVertex' 1 (vertex 2) == False--- 'Algebra.Graph.AdjacencyMap.vertexCount' (vertex x) == 1--- 'Algebra.Graph.AdjacencyMap.edgeCount'   (vertex x) == 0--- @-vertex :: a -> AdjacencyMap a-vertex x = AdjacencyMap $ Map.singleton x Set.empty---- | /Overlay/ two graphs. This is an idempotent, commutative and associative--- operation with the identity 'empty'.--- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.------ @--- 'Algebra.Graph.AdjacencyMap.isEmpty'     (overlay x y) == 'Algebra.Graph.AdjacencyMap.isEmpty'   x   && 'Algebra.Graph.AdjacencyMap.isEmpty'   y--- 'Algebra.Graph.AdjacencyMap.hasVertex' z (overlay x y) == 'Algebra.Graph.AdjacencyMap.hasVertex' z x || 'Algebra.Graph.AdjacencyMap.hasVertex' z y--- 'Algebra.Graph.AdjacencyMap.vertexCount' (overlay x y) >= 'Algebra.Graph.AdjacencyMap.vertexCount' x--- 'Algebra.Graph.AdjacencyMap.vertexCount' (overlay x y) <= 'Algebra.Graph.AdjacencyMap.vertexCount' x + 'Algebra.Graph.AdjacencyMap.vertexCount' y--- 'Algebra.Graph.AdjacencyMap.edgeCount'   (overlay x y) >= 'Algebra.Graph.AdjacencyMap.edgeCount' x--- 'Algebra.Graph.AdjacencyMap.edgeCount'   (overlay x y) <= 'Algebra.Graph.AdjacencyMap.edgeCount' x   + 'Algebra.Graph.AdjacencyMap.edgeCount' y--- 'Algebra.Graph.AdjacencyMap.vertexCount' (overlay 1 2) == 2--- 'Algebra.Graph.AdjacencyMap.edgeCount'   (overlay 1 2) == 0--- @-overlay :: Ord a => AdjacencyMap a -> AdjacencyMap a -> AdjacencyMap a-overlay x y = AdjacencyMap $ Map.unionWith Set.union (adjacencyMap x) (adjacencyMap y)---- | /Connect/ two graphs. This is an associative operation with the identity--- 'empty', which distributes over the overlay and obeys the decomposition axiom.--- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory. Note that the--- number of edges in the resulting graph is quadratic with respect to the number--- of vertices of the arguments: /m = O(m1 + m2 + n1 * n2)/.------ @--- 'Algebra.Graph.AdjacencyMap.isEmpty'     (connect x y) == 'Algebra.Graph.AdjacencyMap.isEmpty'   x   && 'Algebra.Graph.AdjacencyMap.isEmpty'   y--- 'Algebra.Graph.AdjacencyMap.hasVertex' z (connect x y) == 'Algebra.Graph.AdjacencyMap.hasVertex' z x || 'Algebra.Graph.AdjacencyMap.hasVertex' z y--- 'Algebra.Graph.AdjacencyMap.vertexCount' (connect x y) >= 'Algebra.Graph.AdjacencyMap.vertexCount' x--- 'Algebra.Graph.AdjacencyMap.vertexCount' (connect x y) <= 'Algebra.Graph.AdjacencyMap.vertexCount' x + 'Algebra.Graph.AdjacencyMap.vertexCount' y--- 'Algebra.Graph.AdjacencyMap.edgeCount'   (connect x y) >= 'Algebra.Graph.AdjacencyMap.edgeCount' x--- 'Algebra.Graph.AdjacencyMap.edgeCount'   (connect x y) >= 'Algebra.Graph.AdjacencyMap.edgeCount' y--- 'Algebra.Graph.AdjacencyMap.edgeCount'   (connect x y) >= 'Algebra.Graph.AdjacencyMap.vertexCount' x * 'Algebra.Graph.AdjacencyMap.vertexCount' y--- 'Algebra.Graph.AdjacencyMap.edgeCount'   (connect x y) <= 'Algebra.Graph.AdjacencyMap.vertexCount' x * 'Algebra.Graph.AdjacencyMap.vertexCount' y + 'Algebra.Graph.AdjacencyMap.edgeCount' x + 'Algebra.Graph.AdjacencyMap.edgeCount' y--- 'Algebra.Graph.AdjacencyMap.vertexCount' (connect 1 2) == 2--- 'Algebra.Graph.AdjacencyMap.edgeCount'   (connect 1 2) == 1--- @-connect :: Ord a => AdjacencyMap a -> AdjacencyMap a -> AdjacencyMap a-connect x y = AdjacencyMap $ Map.unionsWith Set.union [ adjacencyMap x, adjacencyMap y,-    fromSet (const . keysSet $ adjacencyMap y) (keysSet $ adjacencyMap x) ]---- | Construct the graph comprising a given list of isolated vertices.--- Complexity: /O(L * log(L))/ time and /O(L)/ memory, where /L/ is the length--- of the given list.------ @--- vertices []            == 'empty'--- vertices [x]           == 'vertex' x--- 'Algebra.Graph.AdjacencyMap.hasVertex' x . vertices == 'elem' x--- 'Algebra.Graph.AdjacencyMap.vertexCount' . vertices == 'length' . 'Data.List.nub'--- 'Algebra.Graph.AdjacencyMap.vertexSet'   . vertices == Set.'Set.fromList'--- @-vertices :: Ord a => [a] -> AdjacencyMap a-vertices = AdjacencyMap . Map.fromList . map (\x -> (x, Set.empty))---- | Construct the graph from a list of edges.--- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.------ @--- edges []          == 'empty'--- edges [(x, y)]    == 'Algebra.Graph.AdjacencyMap.edge' x y--- 'Algebra.Graph.AdjacencyMap.edgeCount' . edges == 'length' . 'Data.List.nub'--- 'edgeList' . edges  == 'Data.List.nub' . 'Data.List.sort'--- @-edges :: Ord a => [(a, a)] -> AdjacencyMap a-edges = fromAdjacencyList . map (fmap return)---- | Construct a graph from an adjacency list.--- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.------ @--- fromAdjacencyList []                                  == 'empty'--- fromAdjacencyList [(x, [])]                           == 'vertex' x--- fromAdjacencyList [(x, [y])]                          == 'Algebra.Graph.AdjacencyMap.edge' x y--- fromAdjacencyList . 'adjacencyList'                     == id--- 'overlay' (fromAdjacencyList xs) (fromAdjacencyList ys) == fromAdjacencyList (xs ++ ys)--- @-fromAdjacencyList :: Ord a => [(a, [a])] -> AdjacencyMap a-fromAdjacencyList as = AdjacencyMap $ Map.unionWith Set.union vs es-  where-    ss = map (fmap Set.fromList) as-    vs = fromSet (const Set.empty) . Set.unions $ map snd ss-    es = Map.fromListWith Set.union ss---- | The sorted list of edges of a graph.--- Complexity: /O(n + m)/ time and /O(m)/ memory.------ @--- edgeList 'empty'          == []--- edgeList ('vertex' x)     == []--- edgeList ('Algebra.Graph.AdjacencyMap.edge' x y)     == [(x,y)]--- edgeList ('Algebra.Graph.AdjacencyMap.star' 2 [3,1]) == [(2,1), (2,3)]--- edgeList . 'edges'        == 'Data.List.nub' . 'Data.List.sort'--- @-edgeList :: AdjacencyMap a -> [(a, a)]-edgeList = concatMap (\(x, ys) -> map (x,) ys) . adjacencyList---- | The sorted /adjacency list/ of a graph.--- Complexity: /O(n + m)/ time and /O(m)/ memory.------ @--- adjacencyList 'empty'               == []--- adjacencyList ('vertex' x)          == [(x, [])]--- adjacencyList ('Algebra.Graph.AdjacencyMap.edge' 1 2)          == [(1, [2]), (2, [])]--- adjacencyList ('Algebra.Graph.AdjacencyMap.star' 2 [3,1])      == [(1, []), (2, [1,3]), (3, [])]--- 'fromAdjacencyList' . adjacencyList == id--- @-adjacencyList :: AdjacencyMap a -> [(a, [a])]-adjacencyList = map (fmap Set.toAscList) . Map.toAscList . adjacencyMap---- | Remove a vertex from a given graph.--- Complexity: /O(n*log(n))/ time.------ @--- removeVertex x ('vertex' x)       == 'empty'--- removeVertex x . removeVertex x == removeVertex x--- @-removeVertex :: Ord a => a -> AdjacencyMap a -> AdjacencyMap a-removeVertex x = AdjacencyMap . Map.map (Set.delete x) . Map.delete x . adjacencyMap---- | Remove an edge from a given graph.--- Complexity: /O(log(n))/ time.------ @--- removeEdge x y ('Algebra.Graph.AdjacencyMap.edge' x y)       == 'vertices' [x, y]--- removeEdge x y . removeEdge x y == removeEdge x y--- removeEdge x y . 'removeVertex' x == 'removeVertex' x--- removeEdge 1 1 (1 * 1 * 2 * 2)  == 1 * 2 * 2--- removeEdge 1 2 (1 * 1 * 2 * 2)  == 1 * 1 + 2 * 2--- @-removeEdge :: Ord a => a -> a -> AdjacencyMap a -> AdjacencyMap a-removeEdge x y = AdjacencyMap . Map.adjust (Set.delete y) x . adjacencyMap---- | Transform a graph by applying a function to each of its vertices. This is--- similar to @Functor@'s 'fmap' but can be used with non-fully-parametric--- 'AdjacencyMap'.--- Complexity: /O((n + m) * log(n))/ time.------ @--- gmap f 'empty'      == 'empty'--- gmap f ('vertex' x) == 'vertex' (f x)--- gmap f ('Algebra.Graph.AdjacencyMap.edge' x y) == 'Algebra.Graph.AdjacencyMap.edge' (f x) (f y)--- gmap id           == id--- gmap f . gmap g   == gmap (f . g)--- @-gmap :: (Ord a, Ord b) => (a -> b) -> AdjacencyMap a -> AdjacencyMap b-gmap f = AdjacencyMap . Map.map (Set.map f) . Map.mapKeysWith Set.union f . adjacencyMap+consistent (AdjacencyMap m) = referredToVertexSet m `Set.isSubsetOf` keysSet m --- | Construct the /induced subgraph/ of a given graph by removing the--- vertices that do not satisfy a given predicate.--- Complexity: /O(m)/ time, assuming that the predicate takes /O(1)/ to--- be evaluated.------ @--- induce (const True)  x      == x--- induce (const False) x      == 'empty'--- induce (/= x)               == 'removeVertex' x--- induce p . induce q         == induce (\\x -> p x && q x)--- 'Algebra.Graph.AdjacencyMap.isSubgraphOf' (induce p x) x == True--- @-induce :: Ord a => (a -> Bool) -> AdjacencyMap a -> AdjacencyMap a-induce p = AdjacencyMap . Map.map (Set.filter p) . Map.filterWithKey (\k _ -> p k) . adjacencyMap+-- The set of vertices that are referred to by the edges+referredToVertexSet :: Ord a => Map a (Set a) -> Set a+referredToVertexSet = Set.fromList . uncurry (++) . unzip . internalEdgeList +-- The list of edges in adjacency map+internalEdgeList :: Map a (Set a) -> [(a, a)]+internalEdgeList m = [ (x, y) | (x, ys) <- Map.toAscList m, y <- Set.toAscList ys ]

@@ -350,6 +350,7 @@ -- biclique [x]     []      == 'vertex' x -- biclique []      [y]     == 'vertex' y -- biclique [x1,x2] [y1,y2] == 'edges' [(x1,y1), (x1,y2), (x2,y1), (x2,y2)]+-- biclique xs      ys      == 'connect' ('vertices' xs) ('vertices' ys) -- @ biclique :: Graph g => [Vertex g] -> [Vertex g] -> g biclique xs ys = connect (vertices xs) (vertices ys)@@ -369,12 +370,26 @@ -- | The /tree graph/ constructed from a given 'Tree' data structure. -- Complexity: /O(T)/ time, memory and size, where /T/ is the size of the -- given tree (i.e. the number of vertices in the tree).+--+-- @+-- tree (Node x [])                                         == 'vertex' x+-- tree (Node x [Node y [Node z []]])                       == 'path' [x,y,z]+-- tree (Node x [Node y [], Node z []])                     == 'star' x [y,z]+-- tree (Node 1 [Node 2 [], Node 3 [Node 4 [], Node 5 []]]) == 'edges' [(1,2), (1,3), (3,4), (3,5)]+-- @ tree :: Graph g => Tree (Vertex g) -> g tree (Node x f) = overlay (star x $ map rootLabel f) (forest f)  -- | The /forest graph/ constructed from a given 'Forest' data structure. -- Complexity: /O(F)/ time, memory and size, where /F/ is the size of the -- given forest (i.e. the number of vertices in the forest).+--+-- @+-- forest []                                                  == 'empty'+-- forest [x]                                                 == 'tree' x+-- forest [Node 1 [Node 2 [], Node 3 []], Node 4 [Node 5 []]] == 'edges' [(1,2), (1,3), (4,5)]+-- forest                                                     == 'overlays' . map 'tree'+-- @ forest :: Graph g => Forest (Vertex g) -> g forest = overlays . map tree 

@@ -61,7 +61,7 @@  {-| The 'Fold' datatype is the Boehm-Berarducci encoding of the core graph construction primitives 'empty', 'vertex', 'overlay' and 'connect'. We define a-law-abiding 'Num' instance as a convenient notation for working with graphs:+'Num' instance as a convenient notation for working with graphs:      > 0           == vertex 0     > 1 + 2       == overlay (vertex 1) (vertex 2)@@ -71,7 +71,7 @@  The 'Show' instance is defined using basic graph construction primitives: -@show ('empty'     :: Fold Int) == "empty"+@show (empty     :: Fold Int) == "empty" show (1         :: Fold Int) == "vertex 1" show (1 + 2     :: Fold Int) == "vertices [1,2]" show (1 * 2     :: Fold Int) == "edge 1 2"@@ -478,6 +478,7 @@ -- edgeList ('edge' x y)     == [(x,y)] -- edgeList ('star' 2 [3,1]) == [(2,1), (2,3)] -- edgeList . 'edges'        == 'Data.List.nub' . 'Data.List.sort'+-- edgeList . 'transpose'    == 'Data.List.sort' . map 'Data.Tuple.swap' . edgeList -- @ edgeList :: Ord a => Fold a -> [(a, a)] edgeList = AM.edgeList . C.toGraph@@ -549,19 +550,23 @@ torus :: (C.Graph g, C.Vertex g ~ (a, b)) => [a] -> [b] -> g torus xs ys = C.circuit xs `box` C.circuit ys --- | Construct a /De Bruijn graph/ of given dimension and symbols of a given--- alphabet.--- Complexity: /O(A * D^A)/ time, memory and size, where /A/ is the size of the+-- | Construct a /De Bruijn graph/ of a given non-negative dimension using symbols+-- from a given alphabet.+-- Complexity: /O(A^(D + 1))/ time, memory and size, where /A/ is the size of the -- alphabet and /D/ is the dimention of the graph. -- -- @--- deBruijn k []    == 'empty'--- deBruijn 1 [0,1] == 'edges' [ ([0],[0]), ([0],[1]), ([1],[0]), ([1],[1]) ]--- deBruijn 2 "0"   == 'edge' "00" "00"--- deBruijn 2 "01"  == 'edges' [ ("00","00"), ("00","01"), ("01","10"), ("01","11")---                           , ("10","00"), ("10","01"), ("11","10"), ("11","11") ]+--           deBruijn 0 xs               == 'edge' [] []+-- n > 0 'Test.QuickCheck.==>' deBruijn n []               == 'empty'+--           deBruijn 1 [0,1]            == 'edges' [ ([0],[0]), ([0],[1]), ([1],[0]), ([1],[1]) ]+--           deBruijn 2 "0"              == 'edge' "00" "00"+--           deBruijn 2 "01"             == 'edges' [ ("00","00"), ("00","01"), ("01","10"), ("01","11")+--                                                , ("10","00"), ("10","01"), ("11","10"), ("11","11") ]+--           'vertexCount' (deBruijn n xs) == ('length' $ 'Data.List.nub' xs)^n+-- n > 0 'Test.QuickCheck.==>' 'edgeCount'   (deBruijn n xs) == ('length' $ 'Data.List.nub' xs)^(n + 1) -- @ deBruijn :: (C.Graph g, C.Vertex g ~ [a]) => Int -> [a] -> g+deBruijn 0   _        = edge [] [] deBruijn len alphabet = bind skeleton expand   where     overlaps = mapM (const alphabet) [2..len]@@ -638,6 +643,11 @@ -- transpose ('vertex' x)  == 'vertex' x -- transpose ('edge' x y)  == 'edge' y x -- transpose . transpose == id+-- transpose . 'C.path'      == 'C.path'    . 'reverse'+-- transpose . 'C.circuit'   == 'C.circuit' . 'reverse'+-- transpose . 'C.clique'    == 'C.clique'  . 'reverse'+-- transpose ('box' x y)   == 'box' (transpose x) (transpose y)+-- 'edgeList' . transpose  == 'Data.List.sort' . map 'Data.Tuple.swap' . 'edgeList' -- @ transpose :: C.Graph g => Fold (C.Vertex g) -> g transpose = foldg C.empty C.vertex C.overlay (flip C.connect)@@ -730,11 +740,14 @@ -- stands for the equality up to an isomorphism, e.g. @(x, ()) ~~ x@. -- -- @--- box x y             ~~ box y x--- box x (box y z)     ~~ box (box x y) z--- box x ('overlay' y z) == 'overlay' (box x y) (box x z)--- box x ('vertex' ())   ~~ x--- box x 'empty'         ~~ 'empty'+-- box x y               ~~ box y x+-- box x (box y z)       ~~ box (box x y) z+-- box x ('overlay' y z)   == 'overlay' (box x y) (box x z)+-- box x ('vertex' ())     ~~ x+-- box x 'empty'           ~~ 'empty'+-- 'transpose'   (box x y) == box ('transpose' x) ('transpose' y)+-- 'vertexCount' (box x y) == 'vertexCount' x * 'vertexCount' y+-- 'edgeCount'   (box x y) <= 'vertexCount' x * 'edgeCount' y + 'edgeCount' x * 'vertexCount' y -- @ box :: (C.Graph g, C.Vertex g ~ (a, b)) => Fold a -> Fold b -> g box x y = C.overlays $ xs ++ ys

@@ -394,6 +394,7 @@ -- biclique [x]     []      == 'vertex' x -- biclique []      [y]     == 'vertex' y -- biclique [x1,x2] [y1,y2] == 'edges' [(x1,y1), (x1,y2), (x2,y1), (x2,y2)]+-- biclique xs      ys      == 'connect' ('vertices' xs) ('vertices' ys) -- @ biclique :: Graph g => [a] -> [a] -> g a biclique xs ys = connect (vertices xs) (vertices ys)@@ -413,12 +414,26 @@ -- | The /tree graph/ constructed from a given 'Tree' data structure. -- Complexity: /O(T)/ time, memory and size, where /T/ is the size of the -- given tree (i.e. the number of vertices in the tree).+--+-- @+-- tree (Node x [])                                         == 'vertex' x+-- tree (Node x [Node y [Node z []]])                       == 'path' [x,y,z]+-- tree (Node x [Node y [], Node z []])                     == 'star' x [y,z]+-- tree (Node 1 [Node 2 [], Node 3 [Node 4 [], Node 5 []]]) == 'edges' [(1,2), (1,3), (3,4), (3,5)]+-- @ tree :: Graph g => Tree a -> g a tree (Node x f) = overlay (star x $ map rootLabel f) (forest f)  -- | The /forest graph/ constructed from a given 'Forest' data structure. -- Complexity: /O(F)/ time, memory and size, where /F/ is the size of the -- given forest (i.e. the number of vertices in the forest).+--+-- @+-- forest []                                                  == 'empty'+-- forest [x]                                                 == 'tree' x+-- forest [Node 1 [Node 2 [], Node 3 []], Node 4 [Node 5 []]] == 'edges' [(1,2), (1,3), (4,5)]+-- forest                                                     == 'overlays' . map 'tree'+-- @ forest :: Graph g => Forest a -> g a forest = overlays . map tree @@ -452,19 +467,23 @@ torus :: Graph g => [a] -> [b] -> g (a, b) torus xs ys = circuit xs `box` circuit ys --- | Construct a /De Bruijn graph/ of given dimension and symbols of a given--- alphabet.--- Complexity: /O(A * D^A)/ time, memory and size, where /A/ is the size of the+-- | Construct a /De Bruijn graph/ of a given non-negative dimension using symbols+-- from a given alphabet.+-- Complexity: /O(A^(D + 1))/ time, memory and size, where /A/ is the size of the -- alphabet and /D/ is the dimention of the graph. -- -- @--- deBruijn k []    == 'empty'--- deBruijn 1 [0,1] == 'edges' [ ([0],[0]), ([0],[1]), ([1],[0]), ([1],[1]) ]--- deBruijn 2 "0"   == 'edge' "00" "00"--- deBruijn 2 "01"  == 'edges' [ ("00","00"), ("00","01"), ("01","10"), ("01","11")---                           , ("10","00"), ("10","01"), ("11","10"), ("11","11") ]+--           deBruijn 0 xs               == 'edge' [] []+-- n > 0 'Test.QuickCheck.==>' deBruijn n []               == 'empty'+--           deBruijn 1 [0,1]            == 'edges' [ ([0],[0]), ([0],[1]), ([1],[0]), ([1],[1]) ]+--           deBruijn 2 "0"              == 'edge' "00" "00"+--           deBruijn 2 "01"             == 'edges' [ ("00","00"), ("00","01"), ("01","10"), ("01","11")+--                                                , ("10","00"), ("10","01"), ("11","10"), ("11","11") ]+--           'vertexCount' (deBruijn n xs) == ('length' $ 'Data.List.nub' xs)^n+-- n > 0 'Test.QuickCheck.==>' 'edgeCount'   (deBruijn n xs) == ('length' $ 'Data.List.nub' xs)^(n + 1) -- @ deBruijn :: Graph g => Int -> [a] -> g [a]+deBruijn 0   _        = edge [] [] deBruijn len alphabet = skeleton >>= expand   where     overlaps = mapM (const alphabet) [2..len]@@ -551,11 +570,13 @@ -- stands for the equality up to an isomorphism, e.g. @(x, ()) ~~ x@. -- -- @--- box x y             ~~ box y x--- box x (box y z)     ~~ box (box x y) z--- box x ('overlay' y z) == 'overlay' (box x y) (box x z)--- box x ('vertex' ())   ~~ x--- box x 'empty'         ~~ 'empty'+-- box x y               ~~ box y x+-- box x (box y z)       ~~ box (box x y) z+-- box x ('overlay' y z)   == 'overlay' (box x y) (box x z)+-- box x ('vertex' ())     ~~ x+-- box x 'empty'           ~~ 'empty'+-- 'vertexCount' (box x y) == 'vertexCount' x * 'vertexCount' y+-- 'edgeCount'   (box x y) <= 'vertexCount' x * 'edgeCount' y + 'edgeCount' x * 'vertexCount' y -- @ box :: Graph g => g a -> g b -> g (a, b) box x y = msum $ xs ++ ys

@@ -46,6 +46,7 @@  import Data.Array import Data.IntSet (IntSet)+import Data.Set (Set) import Data.Tree  import Algebra.Graph.IntAdjacencyMap.Internal@@ -56,6 +57,31 @@ import qualified Data.IntSet         as IntSet import qualified Data.Set            as Set +-- | Construct the /empty graph/.+-- Complexity: /O(1)/ time and memory.+--+-- @+-- 'isEmpty'     empty == True+-- 'hasVertex' x empty == False+-- 'vertexCount' empty == 0+-- 'edgeCount'   empty == 0+-- @+empty :: IntAdjacencyMap+empty = C.empty++-- | Construct the graph comprising /a single isolated vertex/.+-- Complexity: /O(1)/ time and memory.+--+-- @+-- 'isEmpty'     (vertex x) == False+-- 'hasVertex' x (vertex x) == True+-- 'hasVertex' 1 (vertex 2) == False+-- 'vertexCount' (vertex x) == 1+-- 'edgeCount'   (vertex x) == 0+-- @+vertex :: Int -> IntAdjacencyMap+vertex = C.vertex+ -- | Construct the graph comprising /a single edge/. -- Complexity: /O(1)/ time, memory. --@@ -69,6 +95,70 @@ edge :: Int -> Int -> IntAdjacencyMap edge = C.edge +-- | /Overlay/ two graphs. This is an idempotent, commutative and associative+-- operation with the identity 'empty'.+-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.+--+-- @+-- 'isEmpty'     (overlay x y) == 'isEmpty'   x   && 'isEmpty'   y+-- 'hasVertex' z (overlay x y) == 'hasVertex' z x || 'hasVertex' z y+-- 'vertexCount' (overlay x y) >= 'vertexCount' x+-- 'vertexCount' (overlay x y) <= 'vertexCount' x + 'vertexCount' y+-- 'edgeCount'   (overlay x y) >= 'edgeCount' x+-- 'edgeCount'   (overlay x y) <= 'edgeCount' x   + 'edgeCount' y+-- 'vertexCount' (overlay 1 2) == 2+-- 'edgeCount'   (overlay 1 2) == 0+-- @+overlay :: IntAdjacencyMap -> IntAdjacencyMap -> IntAdjacencyMap+overlay = C.overlay++-- | /Connect/ two graphs. This is an associative operation with the identity+-- 'empty', which distributes over the overlay and obeys the decomposition axiom.+-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory. Note that the+-- number of edges in the resulting graph is quadratic with respect to the number+-- of vertices of the arguments: /m = O(m1 + m2 + n1 * n2)/.+--+-- @+-- 'isEmpty'     (connect x y) == 'isEmpty'   x   && 'isEmpty'   y+-- 'hasVertex' z (connect x y) == 'hasVertex' z x || 'hasVertex' z y+-- 'vertexCount' (connect x y) >= 'vertexCount' x+-- 'vertexCount' (connect x y) <= 'vertexCount' x + 'vertexCount' y+-- 'edgeCount'   (connect x y) >= 'edgeCount' x+-- 'edgeCount'   (connect x y) >= 'edgeCount' y+-- 'edgeCount'   (connect x y) >= 'vertexCount' x * 'vertexCount' y+-- 'edgeCount'   (connect x y) <= 'vertexCount' x * 'vertexCount' y + 'edgeCount' x + 'edgeCount' y+-- 'vertexCount' (connect 1 2) == 2+-- 'edgeCount'   (connect 1 2) == 1+-- @+connect :: IntAdjacencyMap -> IntAdjacencyMap -> IntAdjacencyMap+connect = C.connect++-- | Construct the graph comprising a given list of isolated vertices.+-- Complexity: /O(L * log(L))/ time and /O(L)/ memory, where /L/ is the length+-- of the given list.+--+-- @+-- vertices []            == 'empty'+-- vertices [x]           == 'vertex' x+-- 'hasVertex' x . vertices == 'elem' x+-- 'vertexCount' . vertices == 'length' . 'Data.List.nub'+-- 'vertexSet'   . vertices == IntSet.'IntSet.fromList'+-- @+vertices :: [Int] -> IntAdjacencyMap+vertices = IntAdjacencyMap . IntMap.fromList . map (\x -> (x, IntSet.empty))++-- | Construct the graph from a list of edges.+-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.+--+-- @+-- edges []          == 'empty'+-- edges [(x, y)]    == 'edge' x y+-- 'edgeCount' . edges == 'length' . 'Data.List.nub'+-- 'edgeList' . edges  == 'Data.List.nub' . 'Data.List.sort'+-- @+edges :: [(Int, Int)] -> IntAdjacencyMap+edges = fromAdjacencyList . map (fmap return)+ -- | Overlay a given list of graphs. -- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory. --@@ -107,6 +197,23 @@ graph :: [Int] -> [(Int, Int)] -> IntAdjacencyMap graph vs es = overlay (vertices vs) (edges es) +-- | Construct a graph from an adjacency list.+-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.+--+-- @+-- fromAdjacencyList []                                  == 'empty'+-- fromAdjacencyList [(x, [])]                           == 'vertex' x+-- fromAdjacencyList [(x, [y])]                          == 'edge' x y+-- fromAdjacencyList . 'adjacencyList'                     == id+-- 'overlay' (fromAdjacencyList xs) (fromAdjacencyList ys) == fromAdjacencyList (xs ++ ys)+-- @+fromAdjacencyList :: [(Int, [Int])] -> IntAdjacencyMap+fromAdjacencyList as = IntAdjacencyMap $ IntMap.unionWith IntSet.union vs es+  where+    ss = map (fmap IntSet.fromList) as+    vs = IntMap.fromSet (const IntSet.empty) . IntSet.unions $ map snd ss+    es = IntMap.fromListWith IntSet.union ss+ -- | The 'isSubgraphOf' function takes two graphs and returns 'True' if the -- first graph is a /subgraph/ of the second. -- Complexity: /O((n + m) * log(n))/ time.@@ -193,6 +300,32 @@ vertexList :: IntAdjacencyMap -> [Int] vertexList = IntMap.keys . adjacencyMap +-- | The sorted list of edges of a graph.+-- Complexity: /O(n + m)/ time and /O(m)/ memory.+--+-- @+-- edgeList 'empty'          == []+-- edgeList ('vertex' x)     == []+-- edgeList ('edge' x y)     == [(x,y)]+-- edgeList ('star' 2 [3,1]) == [(2,1), (2,3)]+-- edgeList . 'edges'        == 'Data.List.nub' . 'Data.List.sort'+-- @+edgeList :: IntAdjacencyMap -> [(Int, Int)]+edgeList (IntAdjacencyMap m) = [ (x, y) | (x, ys) <- IntMap.toAscList m, y <- IntSet.toAscList ys ]++-- | The sorted /adjacency list/ of a graph.+-- Complexity: /O(n + m)/ time and /O(m)/ memory.+--+-- @+-- adjacencyList 'empty'               == []+-- adjacencyList ('vertex' x)          == [(x, [])]+-- adjacencyList ('edge' 1 2)          == [(1, [2]), (2, [])]+-- adjacencyList ('star' 2 [3,1])      == [(1, []), (2, [1,3]), (3, [])]+-- 'fromAdjacencyList' . adjacencyList == id+-- @+adjacencyList :: IntAdjacencyMap -> [(Int, [Int])]+adjacencyList = map (fmap IntSet.toAscList) . IntMap.toAscList . adjacencyMap+ -- | The set of vertices of a given graph. -- Complexity: /O(n)/ time and memory. --@@ -214,7 +347,7 @@ -- edgeSet ('edge' x y) == Set.'Set.singleton' (x,y) -- edgeSet . 'edges'    == Set.'Set.fromList' -- @-edgeSet :: IntAdjacencyMap -> Set.Set (Int, Int)+edgeSet :: IntAdjacencyMap -> Set (Int, Int) edgeSet = IntMap.foldrWithKey combine Set.empty . adjacencyMap   where     combine u es = Set.union (Set.fromAscList [ (u, v) | v <- IntSet.toAscList es ])@@ -265,16 +398,23 @@ clique = C.clique  -- | The /biclique/ on a list of vertices.--- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.+-- Complexity: /O(n * log(n) + m)/ time and /O(n + m)/ memory. -- -- @ -- biclique []      []      == 'empty' -- biclique [x]     []      == 'vertex' x -- biclique []      [y]     == 'vertex' y -- biclique [x1,x2] [y1,y2] == 'edges' [(x1,y1), (x1,y2), (x2,y1), (x2,y2)]+-- biclique xs      ys      == 'connect' ('vertices' xs) ('vertices' ys) -- @ biclique :: [Int] -> [Int] -> IntAdjacencyMap-biclique = C.biclique+biclique xs ys = IntAdjacencyMap $ IntMap.fromSet adjacent (x `IntSet.union` y)+  where+    x = IntSet.fromList xs+    y = IntSet.fromList ys+    adjacent v+        | v `IntSet.member` x = y+        | otherwise        = IntSet.empty  -- | The /star/ formed by a centre vertex and a list of leaves. -- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.@@ -289,14 +429,51 @@  -- | The /tree graph/ constructed from a given 'Tree' data structure. -- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.+--+-- @+-- tree (Node x [])                                         == 'vertex' x+-- tree (Node x [Node y [Node z []]])                       == 'path' [x,y,z]+-- tree (Node x [Node y [], Node z []])                     == 'star' x [y,z]+-- tree (Node 1 [Node 2 [], Node 3 [Node 4 [], Node 5 []]]) == 'edges' [(1,2), (1,3), (3,4), (3,5)]+-- @ tree :: Tree Int -> IntAdjacencyMap tree = C.tree  -- | The /forest graph/ constructed from a given 'Forest' data structure. -- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.+--+-- @+-- forest []                                                  == 'empty'+-- forest [x]                                                 == 'tree' x+-- forest [Node 1 [Node 2 [], Node 3 []], Node 4 [Node 5 []]] == 'edges' [(1,2), (1,3), (4,5)]+-- forest                                                     == 'overlays' . map 'tree'+-- @ forest :: Forest Int -> IntAdjacencyMap forest = C.forest +-- | Remove a vertex from a given graph.+-- Complexity: /O(n*log(n))/ time.+--+-- @+-- removeVertex x ('vertex' x)       == 'empty'+-- removeVertex x . removeVertex x == removeVertex x+-- @+removeVertex :: Int -> IntAdjacencyMap -> IntAdjacencyMap+removeVertex x = IntAdjacencyMap . IntMap.map (IntSet.delete x) . IntMap.delete x . adjacencyMap++-- | Remove an edge from a given graph.+-- Complexity: /O(log(n))/ time.+--+-- @+-- removeEdge x y ('edge' x y)       == 'vertices' [x, y]+-- removeEdge x y . removeEdge x y == removeEdge x y+-- removeEdge x y . 'removeVertex' x == 'removeVertex' x+-- removeEdge 1 1 (1 * 1 * 2 * 2)  == 1 * 2 * 2+-- removeEdge 1 2 (1 * 1 * 2 * 2)  == 1 * 1 + 2 * 2+-- @+removeEdge :: Int -> Int -> IntAdjacencyMap -> IntAdjacencyMap+removeEdge x y = IntAdjacencyMap . IntMap.adjust (IntSet.delete y) x . adjacencyMap+ -- | The function @'replaceVertex' x y@ replaces vertex @x@ with vertex @y@ in a -- given 'IntAdjacencyMap'. If @y@ already exists, @x@ and @y@ will be merged. -- Complexity: /O((n + m) * log(n))/ time.@@ -322,37 +499,35 @@ mergeVertices :: (Int -> Bool) -> Int -> IntAdjacencyMap -> IntAdjacencyMap mergeVertices p v = gmap $ \u -> if p u then v else u --- | 'GraphKL' encapsulates King-Launchbury graphs, which are implemented in--- the "Data.Graph" module of the @containers@ library. If @graphKL g == h@ then--- the following holds:------ @--- map ('getVertex' h) ('Data.Graph.vertices' $ 'getGraph' h)                            == IntSet.'IntSet.toAscList' ('vertexSet' g)--- map (\\(x, y) -> ('getVertex' h x, 'getVertex' h y)) ('Data.Graph.edges' $ 'getGraph' h) == 'edgeList' g--- @-data GraphKL = GraphKL {-    -- | Array-based graph representation (King and Launchbury, 1995).-    getGraph :: KL.Graph,-    -- | A mapping of "Data.Graph.Vertex" to vertices of type @a@.-    getVertex :: KL.Vertex -> Int }---- | Build 'GraphKL' from the adjacency map of a graph.+-- | Transform a graph by applying a function to each of its vertices. This is+-- similar to @Functor@'s 'fmap' but can be used with non-fully-parametric+-- 'IntAdjacencyMap'.+-- Complexity: /O((n + m) * log(n))/ time. -- -- @--- 'fromGraphKL' . graphKL == id+-- gmap f 'empty'      == 'empty'+-- gmap f ('vertex' x) == 'vertex' (f x)+-- gmap f ('edge' x y) == 'edge' (f x) (f y)+-- gmap id           == id+-- gmap f . gmap g   == gmap (f . g) -- @-graphKL :: IntAdjacencyMap -> GraphKL-graphKL m = GraphKL g $ \u -> case r u of (_, v, _) -> v-  where-    (g, r) = KL.graphFromEdges' [ ((), v, us) | (v, us) <- adjacencyList m ]+gmap :: (Int -> Int) -> IntAdjacencyMap -> IntAdjacencyMap+gmap f = IntAdjacencyMap . IntMap.map (IntSet.map f) . IntMap.mapKeysWith IntSet.union f . adjacencyMap --- | Extract the adjacency map of a King-Launchbury graph.+-- | Construct the /induced subgraph/ of a given graph by removing the+-- vertices that do not satisfy a given predicate.+-- Complexity: /O(m)/ time, assuming that the predicate takes /O(1)/ to+-- be evaluated. -- -- @--- fromGraphKL . 'graphKL' == id+-- induce (const True)  x      == x+-- induce (const False) x      == 'empty'+-- induce (/= x)               == 'removeVertex' x+-- induce p . induce q         == induce (\\x -> p x && q x)+-- 'isSubgraphOf' (induce p x) x == True -- @-fromGraphKL :: GraphKL -> IntAdjacencyMap-fromGraphKL (GraphKL g r) = fromAdjacencyList $ map (\(x, ys) -> (r x, map r ys)) (assocs g)+induce :: (Int -> Bool) -> IntAdjacencyMap -> IntAdjacencyMap+induce p = IntAdjacencyMap . IntMap.map (IntSet.filter p) . IntMap.filterWithKey (\k _ -> p k) . adjacencyMap  -- | Compute the /depth-first search/ forest of a graph. --@@ -403,3 +578,34 @@     go seen (v:vs) = let newSeen = seen `seq` IntSet.insert v seen         in postset v m `IntSet.intersection` newSeen == IntSet.empty && go newSeen vs +-- | 'GraphKL' encapsulates King-Launchbury graphs, which are implemented in+-- the "Data.Graph" module of the @containers@ library. If @graphKL g == h@ then+-- the following holds:+--+-- @+-- map ('getVertex' h) ('Data.Graph.vertices' $ 'getGraph' h)                            == IntSet.'IntSet.toAscList' ('vertexSet' g)+-- map (\\(x, y) -> ('getVertex' h x, 'getVertex' h y)) ('Data.Graph.edges' $ 'getGraph' h) == 'edgeList' g+-- @+data GraphKL = GraphKL {+    -- | Array-based graph representation (King and Launchbury, 1995).+    getGraph :: KL.Graph,+    -- | A mapping of "Data.Graph.Vertex" to vertices of type @a@.+    getVertex :: KL.Vertex -> Int }++-- | Build 'GraphKL' from the adjacency map of a graph.+--+-- @+-- 'fromGraphKL' . graphKL == id+-- @+graphKL :: IntAdjacencyMap -> GraphKL+graphKL m = GraphKL g $ \u -> case r u of (_, v, _) -> v+  where+    (g, r) = KL.graphFromEdges' [ ((), v, us) | (v, us) <- adjacencyList m ]++-- | Extract the adjacency map of a King-Launchbury graph.+--+-- @+-- fromGraphKL . 'graphKL' == id+-- @+fromGraphKL :: GraphKL -> IntAdjacencyMap+fromGraphKL (GraphKL g r) = fromAdjacencyList $ map (\(x, ys) -> (r x, map r ys)) (assocs g)

@@ -7,34 +7,25 @@ -- Stability  : unstable -- -- This module exposes the implementation of adjacency maps. The API is unstable--- and unsafe. Where possible use non-internal module "Algebra.Graph.IntAdjacencyMap"--- instead.---+-- and unsafe. Where possible use non-internal module+-- "Algebra.Graph.IntAdjacencyMap" instead. ----------------------------------------------------------------------------- module Algebra.Graph.IntAdjacencyMap.Internal (-    -- * Adjacency map-    IntAdjacencyMap (..), consistent,--    -- * Basic graph construction primitives-    empty, vertex, overlay, connect, vertices, edges, fromAdjacencyList,--    -- * Graph properties-    edgeList, adjacencyList,--    -- * Graph transformation-    removeVertex, removeEdge, gmap, induce+    -- * Adjacency map implementation+    IntAdjacencyMap (..), consistent   ) where  import Data.IntMap.Strict (IntMap, keysSet, fromSet) import Data.IntSet (IntSet) -import qualified Algebra.Graph.Class as C-import qualified Data.IntMap.Strict  as IntMap-import qualified Data.IntSet         as IntSet+import Algebra.Graph.Class +import qualified Data.IntMap.Strict as IntMap+import qualified Data.IntSet        as IntSet+ {-| The 'IntAdjacencyMap' data type represents a graph by a map of vertices to-their adjacency sets. We define a law-abiding 'Num' instance as a convenient-notation for working with graphs:+their adjacency sets. We define a 'Num' instance as a convenient notation for+working with graphs:      > 0           == vertex 0     > 1 + 2       == overlay (vertex 1) (vertex 2)@@ -44,7 +35,7 @@  The 'Show' instance is defined using basic graph construction primitives: -@show ('empty'     :: IntAdjacencyMap Int) == "empty"+@show (empty     :: IntAdjacencyMap Int) == "empty" show (1         :: IntAdjacencyMap Int) == "vertex 1" show (1 + 2     :: IntAdjacencyMap Int) == "vertices [1,2]" show (1 * 2     :: IntAdjacencyMap Int) == "edge 1 2"@@ -53,35 +44,38 @@  The 'Eq' instance satisfies all axioms of algebraic graphs: -    * 'overlay' is commutative and associative:+    * 'Algebra.Graph.IntAdjacencyMap.overlay' is commutative and associative:          >       x + y == y + x         > x + (y + z) == (x + y) + z -    * 'connect' is associative and has 'empty' as the identity:+    * 'Algebra.Graph.IntAdjacencyMap.connect' is associative and has+    'Algebra.Graph.IntAdjacencyMap.empty' as the identity:          >   x * empty == x         >   empty * x == x         > x * (y * z) == (x * y) * z -    * 'connect' distributes over 'overlay':+    * 'Algebra.Graph.IntAdjacencyMap.connect' distributes over+    'Algebra.Graph.IntAdjacencyMap.overlay':          > x * (y + z) == x * y + x * z         > (x + y) * z == x * z + y * z -    * 'connect' can be decomposed:+    * 'Algebra.Graph.IntAdjacencyMap.connect' can be decomposed:          > x * y * z == x * y + x * z + y * z  The following useful theorems can be proved from the above set of axioms. -    * 'overlay' has 'empty' as the identity and is idempotent:+    * 'Algebra.Graph.IntAdjacencyMap.overlay' has+    'Algebra.Graph.IntAdjacencyMap.empty' as the identity and is idempotent:          >   x + empty == x         >   empty + x == x         >       x + x == x -    * Absorption and saturation of 'connect':+    * Absorption and saturation of 'Algebra.Graph.IntAdjacencyMap.connect':          > x * y + x + y == x * y         >     x * x * x == x * x@@ -96,26 +90,27 @@   } deriving Eq  instance Show IntAdjacencyMap where-    show a@(IntAdjacencyMap m)+    show (IntAdjacencyMap m)         | m == IntMap.empty = "empty"-        | es == []       = if IntSet.size vs > 1 then "vertices " ++ show (IntSet.toAscList vs)-                                              else "vertex "   ++ show v-        | vs == related  = if length es > 1 then "edges " ++ show es-                                            else "edge "  ++ show e ++ " " ++ show f-        | otherwise      = "graph " ++ show (IntSet.toAscList vs) ++ " " ++ show es+        | es == []          = if IntSet.size vs > 1 then "vertices " ++ show (IntSet.toAscList vs)+                                                    else "vertex "   ++ show v+        | vs == referred    = if length es > 1 then "edges " ++ show es+                                               else "edge "  ++ show e ++ " " ++ show f+        | otherwise         = "graph " ++ show (IntSet.toAscList vs) ++ " " ++ show es       where-        vs      = keysSet m-        es      = edgeList a-        v       = head $ IntSet.toList vs-        (e,f)   = head es-        related = IntSet.fromList . uncurry (++) $ unzip es+        vs       = keysSet m+        es       = internalEdgeList m+        v        = head $ IntSet.toList vs+        (e, f)   = head es+        referred = referredToVertexSet m -instance C.Graph IntAdjacencyMap where+instance Graph IntAdjacencyMap where     type Vertex IntAdjacencyMap = Int-    empty   = empty-    vertex  = vertex-    overlay = overlay-    connect = connect+    empty       = IntAdjacencyMap $ IntMap.empty+    vertex x    = IntAdjacencyMap $ IntMap.singleton x IntSet.empty+    overlay x y = IntAdjacencyMap $ IntMap.unionWith IntSet.union (adjacencyMap x) (adjacencyMap y)+    connect x y = IntAdjacencyMap $ IntMap.unionsWith IntSet.union [ adjacencyMap x, adjacencyMap y,+        fromSet (const . keysSet $ adjacencyMap y) (keysSet $ adjacencyMap x) ]  instance Num IntAdjacencyMap where     fromInteger = vertex . fromInteger@@ -128,204 +123,25 @@ -- | Check if the internal graph representation is consistent, i.e. that all -- edges refer to existing vertices. It should be impossible to create an -- inconsistent adjacency map, and we use this function in testing.+-- /Note: this function is for internal use only/. -- -- @--- consistent 'empty'                  == True--- consistent ('vertex' x)             == True--- consistent ('overlay' x y)          == True--- consistent ('connect' x y)          == True+-- consistent 'Algebra.Graph.IntAdjacencyMap.empty'                  == True+-- consistent ('Algebra.Graph.IntAdjacencyMap.vertex' x)             == True+-- consistent ('Algebra.Graph.IntAdjacencyMap.overlay' x y)          == True+-- consistent ('Algebra.Graph.IntAdjacencyMap.connect' x y)          == True -- consistent ('Algebra.Graph.IntAdjacencyMap.edge' x y)             == True--- consistent ('edges' xs)             == True+-- consistent ('Algebra.Graph.IntAdjacencyMap.edges' xs)             == True -- consistent ('Algebra.Graph.IntAdjacencyMap.graph' xs ys)          == True--- consistent ('fromAdjacencyList' xs) == True+-- consistent ('Algebra.Graph.IntAdjacencyMap.fromAdjacencyList' xs) == True -- @ consistent :: IntAdjacencyMap -> Bool-consistent m = IntSet.fromList (uncurry (++) $ unzip $ edgeList m)-    `IntSet.isSubsetOf` keysSet (adjacencyMap m)---- | Construct the /empty graph/.--- Complexity: /O(1)/ time and memory.------ @--- 'Algebra.Graph.IntAdjacencyMap.isEmpty'     empty == True--- 'Algebra.Graph.IntAdjacencyMap.hasVertex' x empty == False--- 'Algebra.Graph.IntAdjacencyMap.vertexCount' empty == 0--- 'Algebra.Graph.IntAdjacencyMap.edgeCount'   empty == 0--- @-empty :: IntAdjacencyMap-empty = IntAdjacencyMap $ IntMap.empty---- | Construct the graph comprising /a single isolated vertex/.--- Complexity: /O(1)/ time and memory.------ @--- 'Algebra.Graph.IntAdjacencyMap.isEmpty'     (vertex x) == False--- 'Algebra.Graph.IntAdjacencyMap.hasVertex' x (vertex x) == True--- 'Algebra.Graph.IntAdjacencyMap.hasVertex' 1 (vertex 2) == False--- 'Algebra.Graph.IntAdjacencyMap.vertexCount' (vertex x) == 1--- 'Algebra.Graph.IntAdjacencyMap.edgeCount'   (vertex x) == 0--- @-vertex :: Int -> IntAdjacencyMap-vertex x = IntAdjacencyMap $ IntMap.singleton x IntSet.empty---- | /Overlay/ two graphs. This is an idempotent, commutative and associative--- operation with the identity 'empty'.--- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.------ @--- 'Algebra.Graph.IntAdjacencyMap.isEmpty'     (overlay x y) == 'Algebra.Graph.IntAdjacencyMap.isEmpty'   x   && 'Algebra.Graph.IntAdjacencyMap.isEmpty'   y--- 'Algebra.Graph.IntAdjacencyMap.hasVertex' z (overlay x y) == 'Algebra.Graph.IntAdjacencyMap.hasVertex' z x || 'Algebra.Graph.IntAdjacencyMap.hasVertex' z y--- 'Algebra.Graph.IntAdjacencyMap.vertexCount' (overlay x y) >= 'Algebra.Graph.IntAdjacencyMap.vertexCount' x--- 'Algebra.Graph.IntAdjacencyMap.vertexCount' (overlay x y) <= 'Algebra.Graph.IntAdjacencyMap.vertexCount' x + 'Algebra.Graph.IntAdjacencyMap.vertexCount' y--- 'Algebra.Graph.IntAdjacencyMap.edgeCount'   (overlay x y) >= 'Algebra.Graph.IntAdjacencyMap.edgeCount' x--- 'Algebra.Graph.IntAdjacencyMap.edgeCount'   (overlay x y) <= 'Algebra.Graph.IntAdjacencyMap.edgeCount' x   + 'Algebra.Graph.IntAdjacencyMap.edgeCount' y--- 'Algebra.Graph.IntAdjacencyMap.vertexCount' (overlay 1 2) == 2--- 'Algebra.Graph.IntAdjacencyMap.edgeCount'   (overlay 1 2) == 0--- @-overlay :: IntAdjacencyMap -> IntAdjacencyMap -> IntAdjacencyMap-overlay x y = IntAdjacencyMap $ IntMap.unionWith IntSet.union (adjacencyMap x) (adjacencyMap y)---- | /Connect/ two graphs. This is an associative operation with the identity--- 'empty', which distributes over the overlay and obeys the decomposition axiom.--- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory. Note that the--- number of edges in the resulting graph is quadratic with respect to the number--- of vertices of the arguments: /m = O(m1 + m2 + n1 * n2)/.------ @--- 'Algebra.Graph.IntAdjacencyMap.isEmpty'     (connect x y) == 'Algebra.Graph.IntAdjacencyMap.isEmpty'   x   && 'Algebra.Graph.IntAdjacencyMap.isEmpty'   y--- 'Algebra.Graph.IntAdjacencyMap.hasVertex' z (connect x y) == 'Algebra.Graph.IntAdjacencyMap.hasVertex' z x || 'Algebra.Graph.IntAdjacencyMap.hasVertex' z y--- 'Algebra.Graph.IntAdjacencyMap.vertexCount' (connect x y) >= 'Algebra.Graph.IntAdjacencyMap.vertexCount' x--- 'Algebra.Graph.IntAdjacencyMap.vertexCount' (connect x y) <= 'Algebra.Graph.IntAdjacencyMap.vertexCount' x + 'Algebra.Graph.IntAdjacencyMap.vertexCount' y--- 'Algebra.Graph.IntAdjacencyMap.edgeCount'   (connect x y) >= 'Algebra.Graph.IntAdjacencyMap.edgeCount' x--- 'Algebra.Graph.IntAdjacencyMap.edgeCount'   (connect x y) >= 'Algebra.Graph.IntAdjacencyMap.edgeCount' y--- 'Algebra.Graph.IntAdjacencyMap.edgeCount'   (connect x y) >= 'Algebra.Graph.IntAdjacencyMap.vertexCount' x * 'Algebra.Graph.IntAdjacencyMap.vertexCount' y--- 'Algebra.Graph.IntAdjacencyMap.edgeCount'   (connect x y) <= 'Algebra.Graph.IntAdjacencyMap.vertexCount' x * 'Algebra.Graph.IntAdjacencyMap.vertexCount' y + 'Algebra.Graph.IntAdjacencyMap.edgeCount' x + 'Algebra.Graph.IntAdjacencyMap.edgeCount' y--- 'Algebra.Graph.IntAdjacencyMap.vertexCount' (connect 1 2) == 2--- 'Algebra.Graph.IntAdjacencyMap.edgeCount'   (connect 1 2) == 1--- @-connect :: IntAdjacencyMap -> IntAdjacencyMap -> IntAdjacencyMap-connect x y = IntAdjacencyMap $ IntMap.unionsWith IntSet.union [ adjacencyMap x, adjacencyMap y,-    fromSet (const . keysSet $ adjacencyMap y) (keysSet $ adjacencyMap x) ]---- | Construct the graph comprising a given list of isolated vertices.--- Complexity: /O(L * log(L))/ time and /O(L)/ memory, where /L/ is the length--- of the given list.------ @--- vertices []            == 'empty'--- vertices [x]           == 'vertex' x--- 'Algebra.Graph.IntAdjacencyMap.hasVertex' x . vertices == 'elem' x--- 'Algebra.Graph.IntAdjacencyMap.vertexCount' . vertices == 'length' . 'Data.List.nub'--- 'Algebra.Graph.IntAdjacencyMap.vertexSet'   . vertices == IntSet.'IntSet.fromList'--- @-vertices :: [Int] -> IntAdjacencyMap-vertices = IntAdjacencyMap . IntMap.fromList . map (\x -> (x, IntSet.empty))---- | Construct the graph from a list of edges.--- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.------ @--- edges []          == 'empty'--- edges [(x, y)]    == 'Algebra.Graph.IntAdjacencyMap.edge' x y--- 'Algebra.Graph.IntAdjacencyMap.edgeCount' . edges == 'length' . 'Data.List.nub'--- 'edgeList' . edges  == 'Data.List.nub' . 'Data.List.sort'--- @-edges :: [(Int, Int)] -> IntAdjacencyMap-edges = fromAdjacencyList . map (fmap return)---- | Construct a graph from an adjacency list.--- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.------ @--- fromAdjacencyList []                                  == 'empty'--- fromAdjacencyList [(x, [])]                           == 'vertex' x--- fromAdjacencyList [(x, [y])]                          == 'Algebra.Graph.IntAdjacencyMap.edge' x y--- fromAdjacencyList . 'adjacencyList'                     == id--- 'overlay' (fromAdjacencyList xs) (fromAdjacencyList ys) == fromAdjacencyList (xs ++ ys)--- @-fromAdjacencyList :: [(Int, [Int])] -> IntAdjacencyMap-fromAdjacencyList as = IntAdjacencyMap $ IntMap.unionWith IntSet.union vs es-  where-    ss = map (fmap IntSet.fromList) as-    vs = fromSet (const IntSet.empty) . IntSet.unions $ map snd ss-    es = IntMap.fromListWith IntSet.union ss---- | The sorted list of edges of a graph.--- Complexity: /O(n + m)/ time and /O(m)/ memory.------ @--- edgeList 'empty'          == []--- edgeList ('vertex' x)     == []--- edgeList ('Algebra.Graph.IntAdjacencyMap.edge' x y)     == [(x,y)]--- edgeList ('Algebra.Graph.IntAdjacencyMap.star' 2 [3,1]) == [(2,1), (2,3)]--- edgeList . 'edges'        == 'Data.List.nub' . 'Data.List.sort'--- @-edgeList :: IntAdjacencyMap -> [(Int, Int)]-edgeList = concatMap (\(x, ys) -> map (x,) ys) . adjacencyList---- | The sorted /adjacency list/ of a graph.--- Complexity: /O(n + m)/ time and /O(m)/ memory.------ @--- adjacencyList 'empty'               == []--- adjacencyList ('vertex' x)          == [(x, [])]--- adjacencyList ('Algebra.Graph.IntAdjacencyMap.edge' 1 2)          == [(1, [2]), (2, [])]--- adjacencyList ('Algebra.Graph.IntAdjacencyMap.star' 2 [3,1])      == [(1, []), (2, [1,3]), (3, [])]--- 'fromAdjacencyList' . adjacencyList == id--- @-adjacencyList :: IntAdjacencyMap -> [(Int, [Int])]-adjacencyList = map (fmap IntSet.toAscList) . IntMap.toAscList . adjacencyMap---- | Remove a vertex from a given graph.--- Complexity: /O(n*log(n))/ time.------ @--- removeVertex x ('vertex' x)       == 'empty'--- removeVertex x . removeVertex x == removeVertex x--- @-removeVertex :: Int -> IntAdjacencyMap -> IntAdjacencyMap-removeVertex x = IntAdjacencyMap . IntMap.map (IntSet.delete x) . IntMap.delete x . adjacencyMap---- | Remove an edge from a given graph.--- Complexity: /O(log(n))/ time.------ @--- removeEdge x y ('Algebra.Graph.IntAdjacencyMap.edge' x y)       == 'vertices' [x, y]--- removeEdge x y . removeEdge x y == removeEdge x y--- removeEdge x y . 'removeVertex' x == 'removeVertex' x--- removeEdge 1 1 (1 * 1 * 2 * 2)  == 1 * 2 * 2--- removeEdge 1 2 (1 * 1 * 2 * 2)  == 1 * 1 + 2 * 2--- @-removeEdge :: Int -> Int -> IntAdjacencyMap -> IntAdjacencyMap-removeEdge x y = IntAdjacencyMap . IntMap.adjust (IntSet.delete y) x . adjacencyMap---- | Transform a graph by applying a function to each of its vertices. This is--- similar to @Functor@'s 'fmap' but can be used with non-fully-parametric--- 'IntAdjacencyMap'.--- Complexity: /O((n + m) * log(n))/ time.------ @--- gmap f 'empty'      == 'empty'--- gmap f ('vertex' x) == 'vertex' (f x)--- gmap f ('Algebra.Graph.IntAdjacencyMap.edge' x y) == 'Algebra.Graph.IntAdjacencyMap.edge' (f x) (f y)--- gmap id           == id--- gmap f . gmap g   == gmap (f . g)--- @-gmap :: (Int -> Int) -> IntAdjacencyMap -> IntAdjacencyMap-gmap f = IntAdjacencyMap . IntMap.map (IntSet.map f) . IntMap.mapKeysWith IntSet.union f . adjacencyMap+consistent (IntAdjacencyMap m) = referredToVertexSet m `IntSet.isSubsetOf` keysSet m --- | Construct the /induced subgraph/ of a given graph by removing the--- vertices that do not satisfy a given predicate.--- Complexity: /O(m)/ time, assuming that the predicate takes /O(1)/ to--- be evaluated.------ @--- induce (const True)  x      == x--- induce (const False) x      == 'empty'--- induce (/= x)               == 'removeVertex' x--- induce p . induce q         == induce (\\x -> p x && q x)--- 'Algebra.Graph.IntAdjacencyMap.isSubgraphOf' (induce p x) x == True--- @-induce :: (Int -> Bool) -> IntAdjacencyMap -> IntAdjacencyMap-induce p = IntAdjacencyMap . IntMap.map (IntSet.filter p) . IntMap.filterWithKey (\k _ -> p k) . adjacencyMap+-- The set of vertices that are referred to by the edges+referredToVertexSet :: IntMap IntSet -> IntSet+referredToVertexSet = IntSet.fromList . uncurry (++) . unzip . internalEdgeList +-- The list of edges in adjacency map+internalEdgeList :: IntMap IntSet -> [(Int, Int)]+internalEdgeList m = [ (x, y) | (x, ys) <- IntMap.toAscList m, y <- IntSet.toAscList ys ]

@@ -33,12 +33,14 @@     path, circuit, clique, biclique, star, tree, forest,      -- * Graph transformation-    removeVertex, removeEdge, replaceVertex, mergeVertices, gmap, induce,+    removeVertex, removeEdge, replaceVertex, mergeVertices, transpose, gmap, induce,      -- * Operations on binary relations-    reflexiveClosure, symmetricClosure, transitiveClosure, preorderClosure+    compose, reflexiveClosure, symmetricClosure, transitiveClosure, preorderClosure   ) where +import Data.Tuple+ import Algebra.Graph.Relation.Internal  import qualified Algebra.Graph.Class as C@@ -46,6 +48,31 @@ import qualified Data.Set            as Set import qualified Data.Tree           as Tree +-- | Construct the /empty graph/.+-- Complexity: /O(1)/ time and memory.+--+-- @+-- 'isEmpty'     empty == True+-- 'hasVertex' x empty == False+-- 'vertexCount' empty == 0+-- 'edgeCount'   empty == 0+-- @+empty :: Ord a => Relation a+empty = C.empty++-- | Construct the graph comprising /a single isolated vertex/.+-- Complexity: /O(1)/ time and memory.+--+-- @+-- 'isEmpty'     (vertex x) == False+-- 'hasVertex' x (vertex x) == True+-- 'hasVertex' 1 (vertex 2) == False+-- 'vertexCount' (vertex x) == 1+-- 'edgeCount'   (vertex x) == 0+-- @+vertex :: Ord a => a -> Relation a+vertex = C.vertex+ -- | Construct the graph comprising /a single edge/. -- Complexity: /O(1)/ time, memory and size. --@@ -59,6 +86,69 @@ edge :: Ord a => a -> a -> Relation a edge = C.edge +-- | /Overlay/ two graphs. This is an idempotent, commutative and associative+-- operation with the identity 'empty'.+-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.+--+-- @+-- 'isEmpty'     (overlay x y) == 'isEmpty'   x   && 'isEmpty'   y+-- 'hasVertex' z (overlay x y) == 'hasVertex' z x || 'hasVertex' z y+-- 'vertexCount' (overlay x y) >= 'vertexCount' x+-- 'vertexCount' (overlay x y) <= 'vertexCount' x + 'vertexCount' y+-- 'edgeCount'   (overlay x y) >= 'edgeCount' x+-- 'edgeCount'   (overlay x y) <= 'edgeCount' x   + 'edgeCount' y+-- 'vertexCount' (overlay 1 2) == 2+-- 'edgeCount'   (overlay 1 2) == 0+-- @+overlay :: Ord a => Relation a -> Relation a -> Relation a+overlay = C.overlay++-- | /Connect/ two graphs. This is an associative operation with the identity+-- 'empty', which distributes over the overlay and obeys the decomposition axiom.+-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory. Note that the+-- number of edges in the resulting graph is quadratic with respect to the number+-- of vertices of the arguments: /m = O(m1 + m2 + n1 * n2)/.+--+-- @+-- 'isEmpty'     (connect x y) == 'isEmpty'   x   && 'isEmpty'   y+-- 'hasVertex' z (connect x y) == 'hasVertex' z x || 'hasVertex' z y+-- 'vertexCount' (connect x y) >= 'vertexCount' x+-- 'vertexCount' (connect x y) <= 'vertexCount' x + 'vertexCount' y+-- 'edgeCount'   (connect x y) >= 'edgeCount' x+-- 'edgeCount'   (connect x y) >= 'edgeCount' y+-- 'edgeCount'   (connect x y) >= 'vertexCount' x * 'vertexCount' y+-- 'edgeCount'   (connect x y) <= 'vertexCount' x * 'vertexCount' y + 'edgeCount' x + 'edgeCount' y+-- 'vertexCount' (connect 1 2) == 2+-- 'edgeCount'   (connect 1 2) == 1+-- @+connect :: Ord a => Relation a -> Relation a -> Relation a+connect = C.connect++-- | Construct the graph comprising a given list of isolated vertices.+-- Complexity: /O(L * log(L))/ time and /O(L)/ memory, where /L/ is the length+-- of the given list.+--+-- @+-- vertices []            == 'empty'+-- vertices [x]           == 'vertex' x+-- 'hasVertex' x . vertices == 'elem' x+-- 'vertexCount' . vertices == 'length' . 'Data.List.nub'+-- 'vertexSet'   . vertices == Set.'Set.fromList'+-- @+vertices :: Ord a => [a] -> Relation a+vertices xs = Relation (Set.fromList xs) Set.empty++-- | Construct the graph from a list of edges.+-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.+--+-- @+-- edges []          == 'empty'+-- edges [(x,y)]     == 'edge' x y+-- 'edgeCount' . edges == 'length' . 'Data.List.nub'+-- @+edges :: Ord a => [(a, a)] -> Relation a+edges es = Relation (Set.fromList $ uncurry (++) $ unzip es) (Set.fromList es)+ -- | Overlay a given list of graphs. -- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory. --@@ -97,6 +187,21 @@ graph :: Ord a => [a] -> [(a, a)] -> Relation a graph = C.graph +-- | Construct a graph from an adjacency list.+-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.+--+-- @+-- fromAdjacencyList []                                  == 'empty'+-- fromAdjacencyList [(x, [])]                           == 'vertex' x+-- fromAdjacencyList [(x, [y])]                          == 'edge' x y+-- 'overlay' (fromAdjacencyList xs) (fromAdjacencyList ys) == fromAdjacencyList (xs ++ ys)+-- @+fromAdjacencyList :: Ord a => [(a, [a])] -> Relation a+fromAdjacencyList as = Relation (Set.fromList vs) (Set.fromList es)+  where+    vs = concatMap (\(x, ys) -> x : ys) as+    es = [ (x, y) | (x, ys) <- as, y <- ys ]+ -- | The 'isSubgraphOf' function takes two graphs and returns 'True' if the -- first graph is a /subgraph/ of the second. -- Complexity: /O((n + m) * log(n))/ time.@@ -181,6 +286,20 @@ vertexList :: Ord a => Relation a -> [a] vertexList = Set.toAscList . domain +-- | The sorted list of edges of a graph.+-- Complexity: /O(n + m)/ time and /O(m)/ memory.+--+-- @+-- edgeList 'empty'          == []+-- edgeList ('vertex' x)     == []+-- edgeList ('edge' x y)     == [(x,y)]+-- edgeList ('star' 2 [3,1]) == [(2,1), (2,3)]+-- edgeList . 'edges'        == 'Data.List.nub' . 'Data.List.sort'+-- edgeList . 'transpose'    == 'Data.List.sort' . map 'Data.Tuple.swap' . edgeList+-- @+edgeList :: Ord a => Relation a -> [(a, a)]+edgeList = Set.toAscList . relation+ -- | The set of vertices of a given graph. -- Complexity: /O(1)/ time. --@@ -218,13 +337,42 @@ edgeSet :: Ord a => Relation a -> Set.Set (a, a) edgeSet = relation +-- | The /preset/ of an element @x@ is the set of elements that are related to+-- it on the /left/, i.e. @preset x == { a | aRx }@. In the context of directed+-- graphs, this corresponds to the set of /direct predecessors/ of vertex @x@.+-- Complexity: /O(n + m)/ time and /O(n)/ memory.+--+-- @+-- preset x 'empty'      == Set.empty+-- preset x ('vertex' x) == Set.empty+-- preset 1 ('edge' 1 2) == Set.empty+-- preset y ('edge' x y) == Set.fromList [x]+-- @+preset :: Ord a => a -> Relation a -> Set.Set a+preset x = Set.mapMonotonic fst . Set.filter ((== x) . snd) . relation++-- | The /postset/ of an element @x@ is the set of elements that are related to+-- it on the /right/, i.e. @postset x == { a | xRa }@. In the context of directed+-- graphs, this corresponds to the set of /direct successors/ of vertex @x@.+-- Complexity: /O(n + m)/ time and /O(n)/ memory.+--+-- @+-- postset x 'empty'      == Set.empty+-- postset x ('vertex' x) == Set.empty+-- postset x ('edge' x y) == Set.fromList [y]+-- postset 2 ('edge' 1 2) == Set.empty+-- @+postset :: Ord a => a -> Relation a -> Set.Set a+postset x = Set.mapMonotonic snd . Set.filter ((== x) . fst) . relation+ -- | The /path/ on a list of vertices. -- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory. -- -- @--- path []    == 'empty'--- path [x]   == 'vertex' x--- path [x,y] == 'edge' x y+-- path []        == 'empty'+-- path [x]       == 'vertex' x+-- path [x,y]     == 'edge' x y+-- path . 'reverse' == 'transpose' . path -- @ path :: Ord a => [a] -> Relation a path = C.path@@ -233,9 +381,10 @@ -- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory. -- -- @--- circuit []    == 'empty'--- circuit [x]   == 'edge' x x--- circuit [x,y] == 'edges' [(x,y), (y,x)]+-- circuit []        == 'empty'+-- circuit [x]       == 'edge' x x+-- circuit [x,y]     == 'edges' [(x,y), (y,x)]+-- circuit . 'reverse' == 'transpose' . circuit -- @ circuit :: Ord a => [a] -> Relation a circuit = C.circuit@@ -244,25 +393,30 @@ -- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory. -- -- @--- clique []      == 'empty'--- clique [x]     == 'vertex' x--- clique [x,y]   == 'edge' x y--- clique [x,y,z] == 'edges' [(x,y), (x,z), (y,z)]+-- clique []        == 'empty'+-- clique [x]       == 'vertex' x+-- clique [x,y]     == 'edge' x y+-- clique [x,y,z]   == 'edges' [(x,y), (x,z), (y,z)]+-- clique . 'reverse' == 'transpose' . clique -- @ clique :: Ord a => [a] -> Relation a clique = C.clique  -- | The /biclique/ on a list of vertices.--- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.+-- Complexity: /O(n * log(n) + m)/ time and /O(n + m)/ memory. -- -- @ -- biclique []      []      == 'empty' -- biclique [x]     []      == 'vertex' x -- biclique []      [y]     == 'vertex' y -- biclique [x1,x2] [y1,y2] == 'edges' [(x1,y1), (x1,y2), (x2,y1), (x2,y2)]+-- biclique xs      ys      == 'connect' ('vertices' xs) ('vertices' ys) -- @ biclique :: Ord a => [a] -> [a] -> Relation a-biclique = C.biclique+biclique xs ys = Relation (x `Set.union` y) (x `setProduct` y)+  where+    x = Set.fromList xs+    y = Set.fromList ys  -- | The /star/ formed by a centre vertex and a list of leaves. -- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.@@ -277,14 +431,53 @@  -- | The /tree graph/ constructed from a given 'Tree' data structure. -- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.+--+-- @+-- tree (Node x [])                                         == 'vertex' x+-- tree (Node x [Node y [Node z []]])                       == 'path' [x,y,z]+-- tree (Node x [Node y [], Node z []])                     == 'star' x [y,z]+-- tree (Node 1 [Node 2 [], Node 3 [Node 4 [], Node 5 []]]) == 'edges' [(1,2), (1,3), (3,4), (3,5)]+-- @ tree :: Ord a => Tree.Tree a -> Relation a tree = C.tree  -- | The /forest graph/ constructed from a given 'Forest' data structure. -- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.+--+-- @+-- forest []                                                  == 'empty'+-- forest [x]                                                 == 'tree' x+-- forest [Node 1 [Node 2 [], Node 3 []], Node 4 [Node 5 []]] == 'edges' [(1,2), (1,3), (4,5)]+-- forest                                                     == 'overlays' . map 'tree'+-- @ forest :: Ord a => Tree.Forest a -> Relation a forest = C.forest +-- | Remove a vertex from a given graph.+-- Complexity: /O(n + m)/ time.+--+-- @+-- removeVertex x ('vertex' x)       == 'empty'+-- removeVertex x . removeVertex x == removeVertex x+-- @+removeVertex :: Ord a => a -> Relation a -> Relation a+removeVertex x (Relation d r) = Relation (Set.delete x d) (Set.filter notx r)+  where+    notx (a, b) = a /= x && b /= x++-- | Remove an edge from a given graph.+-- Complexity: /O(log(m))/ time.+--+-- @+-- removeEdge x y ('AdjacencyMap.edge' x y)       == 'vertices' [x, y]+-- removeEdge x y . removeEdge x y == removeEdge x y+-- removeEdge x y . 'removeVertex' x == 'removeVertex' x+-- removeEdge 1 1 (1 * 1 * 2 * 2)  == 1 * 2 * 2+-- removeEdge 1 2 (1 * 1 * 2 * 2)  == 1 * 1 + 2 * 2+-- @+removeEdge :: Ord a => a -> a -> Relation a -> Relation a+removeEdge x y (Relation d r) = Relation d (Set.delete (x, y) r)+ -- | The function @'replaceVertex' x y@ replaces vertex @x@ with vertex @y@ in a -- given 'AdjacencyMap'. If @y@ already exists, @x@ and @y@ will be merged. -- Complexity: /O((n + m) * log(n))/ time.@@ -309,3 +502,119 @@ -- @ mergeVertices :: Ord a => (a -> Bool) -> a -> Relation a -> Relation a mergeVertices p v = gmap $ \u -> if p u then v else u++-- | Transpose a given graph.+-- Complexity: /O(m * log(m))/ time.+--+-- @+-- transpose 'empty'       == 'empty'+-- transpose ('vertex' x)  == 'vertex' x+-- transpose ('edge' x y)  == 'edge' y x+-- transpose . transpose == id+-- transpose . 'path'      == 'path'    . 'reverse'+-- transpose . 'circuit'   == 'circuit' . 'reverse'+-- transpose . 'clique'    == 'clique'  . 'reverse'+-- 'edgeList' . transpose  == 'Data.List.sort' . map 'Data.Tuple.swap' . 'edgeList'+-- @+transpose :: Ord a => Relation a -> Relation a+transpose (Relation d r) = Relation d (Set.map swap r)++-- | Transform a graph by applying a function to each of its vertices. This is+-- similar to @Functor@'s 'fmap' but can be used with non-fully-parametric+-- 'Relation'.+-- Complexity: /O((n + m) * log(n))/ time.+--+-- @+-- gmap f 'empty'      == 'empty'+-- gmap f ('vertex' x) == 'vertex' (f x)+-- gmap f ('edge' x y) == 'edge' (f x) (f y)+-- gmap id           == id+-- gmap f . gmap g   == gmap (f . g)+-- @+gmap :: (Ord a, Ord b) => (a -> b) -> Relation a -> Relation b+gmap f (Relation d r) = Relation (Set.map f d) (Set.map (\(x, y) -> (f x, f y)) r)++-- | Construct the /induced subgraph/ of a given graph by removing the+-- vertices that do not satisfy a given predicate.+-- Complexity: /O(m)/ time, assuming that the predicate takes /O(1)/ to+-- be evaluated.+--+-- @+-- induce (const True)  x      == x+-- induce (const False) x      == 'empty'+-- induce (/= x)               == 'removeVertex' x+-- induce p . induce q         == induce (\\x -> p x && q x)+-- 'isSubgraphOf' (induce p x) x == True+-- @+induce :: Ord a => (a -> Bool) -> Relation a -> Relation a+induce p (Relation d r) = Relation (Set.filter p d) (Set.filter pp r)+  where+    pp (x, y) = p x && p y++-- | /Compose/ two relations: @R = 'compose' Q P@. Two elements @x@ and @y@ are+-- related in the resulting relation, i.e. @xRy@, if there exists an element @z@,+-- such that @xPz@ and @zQy@. This is an associative operation which has 'empty'+-- as the /annihilating zero/.+-- Complexity: /O(n * m * log(m))/ time and /O(n + m)/ memory.+--+-- @+-- compose 'empty'            x                == 'empty'+-- compose x                'empty'            == 'empty'+-- compose x                (compose y z)    == compose (compose x y) z+-- compose ('edge' y z)       ('edge' x y)       == 'edge' x z+-- compose ('path'    [1..5]) ('path'    [1..5]) == 'edges' [(1,3),(2,4),(3,5)]+-- compose ('circuit' [1..5]) ('circuit' [1..5]) == 'circuit' [1,3,5,2,4]+-- @+compose :: Ord a => Relation a -> Relation a -> Relation a+compose x y = Relation (referredToVertexSet r) r+  where+    d = domain x `Set.union` domain y+    r = Set.unions [ preset z y `setProduct` postset z x | z <- Set.toAscList d ]++-- | Compute the /reflexive closure/ of a 'Relation'.+-- Complexity: /O(n * log(m))/ time.+--+-- @+-- reflexiveClosure 'empty'      == 'empty'+-- reflexiveClosure ('vertex' x) == 'edge' x x+-- @+reflexiveClosure :: Ord a => Relation a -> Relation a+reflexiveClosure (Relation d r) =+    Relation d $ r `Set.union` Set.fromDistinctAscList [ (a, a) | a <- Set.toAscList d ]++-- | Compute the /symmetric closure/ of a 'Relation'.+-- Complexity: /O(m * log(m))/ time.+--+-- @+-- symmetricClosure 'empty'      == 'empty'+-- symmetricClosure ('vertex' x) == 'vertex' x+-- symmetricClosure ('edge' x y) == 'edges' [(x, y), (y, x)]+-- @+symmetricClosure :: Ord a => Relation a -> Relation a+symmetricClosure (Relation d r) = Relation d $ r `Set.union` (Set.map swap r)++-- | Compute the /transitive closure/ of a 'Relation'.+-- Complexity: /O(n * m * log(n) * log(m))/ time.+--+-- @+-- transitiveClosure 'empty'           == 'empty'+-- transitiveClosure ('vertex' x)      == 'vertex' x+-- transitiveClosure ('path' $ 'Data.List.nub' xs) == 'clique' ('Data.List.nub' xs)+-- @+transitiveClosure :: Ord a => Relation a -> Relation a+transitiveClosure old+    | old == new = old+    | otherwise  = transitiveClosure new+  where+    new = overlay old (old `compose` old)++-- | Compute the /preorder closure/ of a 'Relation'.+-- Complexity: /O(n * m * log(m))/ time.+--+-- @+-- preorderClosure 'empty'           == 'empty'+-- preorderClosure ('vertex' x)      == 'edge' x x+-- preorderClosure ('path' $ 'Data.List.nub' xs) == 'reflexiveClosure' ('clique' $ 'Data.List.nub' xs)+-- @+preorderClosure :: Ord a => Relation a -> Relation a+preorderClosure = reflexiveClosure . transitiveClosure

@@ -6,51 +6,24 @@ -- Maintainer : andrey.mokhov@gmail.com -- Stability  : unstable ----- This module exposes the implementation of binary relations. The API is unstable--- and unsafe. Where possible use non-internal modules "Algebra.Graph.Relation",--- "Algebra.Graph.Relation.Reflexive", "Algebra.Graph.Relation.Symmetric",--- "Algebra.Graph.Relation.Transitive" and "Algebra.Graph.Relation.Preorder"--- instead.---+-- This module exposes the implementation of the 'Relation' data type. The API+-- is unstable and unsafe. Where possible use the non-internal module+-- "Algebra.Graph.Relation" instead. ----------------------------------------------------------------------------- module Algebra.Graph.Relation.Internal (-    -- * Data structure-    Relation (..), consistent,--    -- * Basic graph construction primitives-    empty, vertex, overlay, connect, vertices, edges, fromAdjacencyList,--    -- * Graph properties-    edgeList, preset, postset,--    -- * Graph transformation-    removeVertex, removeEdge, gmap, induce,--    -- * Operations on binary relations-    reflexiveClosure, symmetricClosure, transitiveClosure, preorderClosure,--    -- * Reflexive relations-    ReflexiveRelation (..),--    -- * Symmetric relations-    SymmetricRelation (..),--    -- * Transitive relations-    TransitiveRelation (..),--    -- * Preorders-    PreorderRelation (..)+    -- * Binary relation implementation+    Relation (..), consistent, setProduct, referredToVertexSet   ) where -import Data.Tuple import Data.Set (Set, union) -import qualified Algebra.Graph.Class as C-import qualified Data.Set            as Set+import Algebra.Graph.Class -{-| The 'Relation' data type represents a graph as a /binary relation/. We define-a law-abiding 'Num' instance as a convenient notation for working with graphs:+import qualified Data.Set as Set +{-| The 'Relation' data type represents a graph as a /binary relation/. We+define a 'Num' instance as a convenient notation for working with graphs:+     > 0           == vertex 0     > 1 + 2       == overlay (vertex 1) (vertex 2)     > 1 * 2       == connect (vertex 1) (vertex 2)@@ -59,7 +32,7 @@  The 'Show' instance is defined using basic graph construction primitives: -@show ('empty'     :: Relation Int) == "empty"+@show (empty     :: Relation Int) == "empty" show (1         :: Relation Int) == "vertex 1" show (1 + 2     :: Relation Int) == "vertices [1,2]" show (1 * 2     :: Relation Int) == "edge 1 2"@@ -68,35 +41,38 @@  The 'Eq' instance satisfies all axioms of algebraic graphs: -    * 'overlay' is commutative and associative:+    * 'Algebra.Graph.Relation.overlay' is commutative and associative:          >       x + y == y + x         > x + (y + z) == (x + y) + z -    * 'connect' is associative and has 'empty' as the identity:+    * 'Algebra.Graph.Relation.connect' is associative and has+    'Algebra.Graph.Relation.empty' as the identity:          >   x * empty == x         >   empty * x == x         > x * (y * z) == (x * y) * z -    * 'connect' distributes over 'overlay':+    * 'Algebra.Graph.Relation.connect' distributes over+    'Algebra.Graph.Relation.overlay':          > x * (y + z) == x * y + x * z         > (x + y) * z == x * z + y * z -    * 'connect' can be decomposed:+    * 'Algebra.Graph.Relation.connect' can be decomposed:          > x * y * z == x * y + x * z + y * z  The following useful theorems can be proved from the above set of axioms. -    * 'overlay' has 'empty' as the identity and is idempotent:+    * 'Algebra.Graph.Relation.overlay' has 'Algebra.Graph.Relation.empty' as the+    identity and is idempotent:          >   x + empty == x         >   empty + x == x         >       x + x == x -    * Absorption and saturation of 'connect':+    * Absorption and saturation of 'Algebra.Graph.Relation.connect':          > x * y + x + y == x * y         >     x * x * x == x * x@@ -114,26 +90,31 @@  instance (Ord a, Show a) => Show (Relation a) where     show (Relation d r)-        | vs == []     = "empty"-        | es == []     = if Set.size d > 1 then "vertices " ++ show vs-                                           else "vertex "   ++ show v-        | d == related = if Set.size r > 1 then "edges " ++ show es-                                           else "edge "  ++ show e ++ " " ++ show f-        | otherwise    = "graph " ++ show vs ++ " " ++ show es+        | vs == []      = "empty"+        | es == []      = if Set.size d > 1 then "vertices " ++ show vs+                                            else "vertex "   ++ show v+        | d == referred = if Set.size r > 1 then "edges " ++ show es+                                            else "edge "  ++ show e ++ " " ++ show f+        | otherwise     = "graph " ++ show vs ++ " " ++ show es       where-        vs      = Set.toAscList d-        es      = Set.toAscList r-        v       = head $ Set.toAscList d-        (e, f)  = head $ Set.toAscList r-        related = Set.fromList . uncurry (++) $ unzip es+        vs       = Set.toAscList d+        es       = Set.toAscList r+        v        = head vs+        (e, f)   = head es+        referred = referredToVertexSet r -instance Ord a => C.Graph (Relation a) where+instance Ord a => Graph (Relation a) where     type Vertex (Relation a) = a-    empty   = empty-    vertex  = vertex-    overlay = overlay-    connect = connect+    empty       = Relation Set.empty Set.empty+    vertex x    = Relation (Set.singleton x) Set.empty+    overlay x y = Relation (domain x `union` domain y) (relation x `union` relation y)+    connect x y = Relation (domain x `union` domain y) (relation x `union` relation y+        `union` (domain x `setProduct` domain y)) +-- | Compute the Cartesian product of two sets. /Note: this function is for internal use only/.+setProduct :: Set a -> Set b -> Set (a, b)+setProduct x y = Set.fromDistinctAscList [ (a, b) | a <- Set.toAscList x, b <- Set.toAscList y ]+ instance (Ord a, Num a) => Num (Relation a) where     fromInteger = vertex . fromInteger     (+)         = overlay@@ -146,411 +127,22 @@ -- pairs of elements in the 'relation' refer to existing elements in the 'domain'. -- It should be impossible to create an inconsistent 'Relation', and we use this -- function in testing.+-- /Note: this function is for internal use only/. -- -- @--- consistent 'empty'                  == True--- consistent ('vertex' x)             == True--- consistent ('overlay' x y)          == True--- consistent ('connect' x y)          == True+-- consistent 'Algebra.Graph.Relation.empty'                  == True+-- consistent ('Algebra.Graph.Relation.vertex' x)             == True+-- consistent ('Algebra.Graph.Relation.overlay' x y)          == True+-- consistent ('Algebra.Graph.Relation.connect' x y)          == True -- consistent ('Algebra.Graph.Relation.edge' x y)             == True--- consistent ('edges' xs)             == True+-- consistent ('Algebra.Graph.Relation.edges' xs)             == True -- consistent ('Algebra.Graph.Relation.graph' xs ys)          == True--- consistent ('fromAdjacencyList' xs) == True+-- consistent ('Algebra.Graph.Relation.fromAdjacencyList' xs) == True -- @ consistent :: Ord a => Relation a -> Bool-consistent r = Set.fromList (uncurry (++) $ unzip $ edgeList r)-    `Set.isSubsetOf` (domain r)---- | Construct the /empty graph/.--- Complexity: /O(1)/ time and memory.------ @--- 'Algebra.Graph.Relation.isEmpty'     empty == True--- 'Algebra.Graph.Relation.hasVertex' x empty == False--- 'Algebra.Graph.Relation.vertexCount' empty == 0--- 'Algebra.Graph.Relation.edgeCount'   empty == 0--- @-empty :: Relation a-empty = Relation Set.empty Set.empty---- | Construct the graph comprising /a single isolated vertex/.--- Complexity: /O(1)/ time and memory.------ @--- 'Algebra.Graph.Relation.isEmpty'     (vertex x) == False--- 'Algebra.Graph.Relation.hasVertex' x (vertex x) == True--- 'Algebra.Graph.Relation.hasVertex' 1 (vertex 2) == False--- 'Algebra.Graph.Relation.vertexCount' (vertex x) == 1--- 'Algebra.Graph.Relation.edgeCount'   (vertex x) == 0--- @-vertex :: a -> Relation a-vertex x = Relation (Set.singleton x) Set.empty---- | /Overlay/ two graphs. This is an idempotent, commutative and associative--- operation with the identity 'empty'.--- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.------ @--- 'Algebra.Graph.Relation.isEmpty'     (overlay x y) == 'Algebra.Graph.Relation.isEmpty'   x   && 'Algebra.Graph.Relation.isEmpty'   y--- 'Algebra.Graph.Relation.hasVertex' z (overlay x y) == 'Algebra.Graph.Relation.hasVertex' z x || 'Algebra.Graph.Relation.hasVertex' z y--- 'Algebra.Graph.Relation.vertexCount' (overlay x y) >= 'Algebra.Graph.Relation.vertexCount' x--- 'Algebra.Graph.Relation.vertexCount' (overlay x y) <= 'Algebra.Graph.Relation.vertexCount' x + 'Algebra.Graph.Relation.vertexCount' y--- 'Algebra.Graph.Relation.edgeCount'   (overlay x y) >= 'Algebra.Graph.Relation.edgeCount' x--- 'Algebra.Graph.Relation.edgeCount'   (overlay x y) <= 'Algebra.Graph.Relation.edgeCount' x   + 'Algebra.Graph.Relation.edgeCount' y--- 'Algebra.Graph.Relation.vertexCount' (overlay 1 2) == 2--- 'Algebra.Graph.Relation.edgeCount'   (overlay 1 2) == 0--- @-overlay :: Ord a => Relation a -> Relation a -> Relation a-overlay x y = Relation (domain x `union` domain y) (relation x `union` relation y)---- | /Connect/ two graphs. This is an associative operation with the identity--- 'empty', which distributes over the overlay and obeys the decomposition axiom.--- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory. Note that the--- number of edges in the resulting graph is quadratic with respect to the number--- of vertices of the arguments: /m = O(m1 + m2 + n1 * n2)/.------ @--- 'Algebra.Graph.Relation.isEmpty'     (connect x y) == 'Algebra.Graph.Relation.isEmpty'   x   && 'Algebra.Graph.Relation.isEmpty'   y--- 'Algebra.Graph.Relation.hasVertex' z (connect x y) == 'Algebra.Graph.Relation.hasVertex' z x || 'Algebra.Graph.Relation.hasVertex' z y--- 'Algebra.Graph.Relation.vertexCount' (connect x y) >= 'Algebra.Graph.Relation.vertexCount' x--- 'Algebra.Graph.Relation.vertexCount' (connect x y) <= 'Algebra.Graph.Relation.vertexCount' x + 'Algebra.Graph.Relation.vertexCount' y--- 'Algebra.Graph.Relation.edgeCount'   (connect x y) >= 'Algebra.Graph.Relation.edgeCount' x--- 'Algebra.Graph.Relation.edgeCount'   (connect x y) >= 'Algebra.Graph.Relation.edgeCount' y--- 'Algebra.Graph.Relation.edgeCount'   (connect x y) >= 'Algebra.Graph.Relation.vertexCount' x * 'Algebra.Graph.Relation.vertexCount' y--- 'Algebra.Graph.Relation.edgeCount'   (connect x y) <= 'Algebra.Graph.Relation.vertexCount' x * 'Algebra.Graph.Relation.vertexCount' y + 'Algebra.Graph.Relation.edgeCount' x + 'Algebra.Graph.Relation.edgeCount' y--- 'Algebra.Graph.Relation.vertexCount' (connect 1 2) == 2--- 'Algebra.Graph.Relation.edgeCount'   (connect 1 2) == 1--- @-connect :: Ord a => Relation a -> Relation a -> Relation a-connect x y = Relation (domain x `union` domain y) (relation x `union` relation y-    `union` (domain x >< domain y))--(><) :: Set a -> Set a -> Set (a, a)-x >< y = Set.fromDistinctAscList [ (a, b) | a <- Set.elems x, b <- Set.elems y ]---- | Construct the graph comprising a given list of isolated vertices.--- Complexity: /O(L * log(L))/ time and /O(L)/ memory, where /L/ is the length--- of the given list.------ @--- vertices []            == 'empty'--- vertices [x]           == 'vertex' x--- 'Algebra.Graph.Relation.hasVertex' x . vertices == 'elem' x--- 'Algebra.Graph.Relation.vertexCount' . vertices == 'length' . 'Data.List.nub'--- 'Algebra.Graph.Relation.vertexSet'   . vertices == Set.'Set.fromList'--- @-vertices :: Ord a => [a] -> Relation a-vertices xs = Relation (Set.fromList xs) Set.empty---- | Construct the graph from a list of edges.--- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.------ @--- edges []          == 'empty'--- edges [(x,y)]     == 'Algebra.Graph.Relation.edge' x y--- 'Algebra.Graph.Relation.edgeCount' . edges == 'length' . 'Data.List.nub'--- @-edges :: Ord a => [(a, a)] -> Relation a-edges es = Relation (Set.fromList $ uncurry (++) $ unzip es) (Set.fromList es)---- | Construct a graph from an adjacency list.--- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.------ @--- fromAdjacencyList []                                  == 'empty'--- fromAdjacencyList [(x, [])]                           == 'vertex' x--- fromAdjacencyList [(x, [y])]                          == 'Algebra.Graph.Relation.edge' x y--- 'overlay' (fromAdjacencyList xs) (fromAdjacencyList ys) == fromAdjacencyList (xs ++ ys)--- @-fromAdjacencyList :: Ord a => [(a, [a])] -> Relation a-fromAdjacencyList as = Relation (Set.fromList vs) (Set.fromList es)-  where-    vs = concatMap (\(x, ys) -> x : ys) as-    es = [ (x, y) | (x, ys) <- as, y <- ys ]---- | The sorted list of edges of a graph.--- Complexity: /O(n + m)/ time and /O(m)/ memory.------ @--- edgeList 'empty'          == []--- edgeList ('vertex' x)     == []--- edgeList ('Algebra.Graph.Relation.edge' x y)     == [(x,y)]--- edgeList ('Algebra.Graph.Relation.star' 2 [1,3]) == [(2,1), (2,3)]--- edgeList . 'edges'        == 'Data.List.nub' . 'Data.List.sort'--- @-edgeList :: Ord a => Relation a -> [(a, a)]-edgeList = Set.toAscList . relation---- | The /preset/ of an element @x@ is the set of elements that are related to--- it on the /left/, i.e. @preset x == { a | aRx }@. In the context of directed--- graphs, this corresponds to the set of /direct predecessors/ of vertex @x@.--- Complexity: /O(n + m)/ time and /O(n)/ memory.------ @--- preset x 'empty'      == Set.empty--- preset x ('vertex' x) == Set.empty--- preset 1 ('Algebra.Graph.Relation.edge' 1 2) == Set.empty--- preset y ('Algebra.Graph.Relation.edge' x y) == Set.fromList [x]--- @-preset :: Ord a => a -> Relation a -> Set a-preset x = Set.mapMonotonic fst . Set.filter ((== x) . snd) . relation---- | The /postset/ of an element @x@ is the set of elements that are related to--- it on the /right/, i.e. @postset x == { a | xRa }@. In the context of directed--- graphs, this corresponds to the set of /direct successors/ of vertex @x@.--- Complexity: /O(n + m)/ time and /O(n)/ memory.------ @--- postset x 'empty'      == Set.empty--- postset x ('vertex' x) == Set.empty--- postset x ('Algebra.Graph.Relation.edge' x y) == Set.fromList [y]--- postset 2 ('Algebra.Graph.Relation.edge' 1 2) == Set.empty--- @-postset :: Ord a => a -> Relation a -> Set a-postset x = Set.mapMonotonic snd . Set.filter ((== x) . fst) . relation---- | Remove a vertex from a given graph.--- Complexity: /O(n + m)/ time.------ @--- removeVertex x ('vertex' x)       == 'empty'--- removeVertex x . removeVertex x == removeVertex x--- @-removeVertex :: Ord a => a -> Relation a -> Relation a-removeVertex x (Relation d r) = Relation (Set.delete x d) (Set.filter notx r)-  where-    notx (a, b) = a /= x && b /= x---- | Remove an edge from a given graph.--- Complexity: /O(log(m))/ time.------ @--- removeEdge x y ('AdjacencyMap.edge' x y)       == 'vertices' [x, y]--- removeEdge x y . removeEdge x y == removeEdge x y--- removeEdge x y . 'removeVertex' x == 'removeVertex' x--- removeEdge 1 1 (1 * 1 * 2 * 2)  == 1 * 2 * 2--- removeEdge 1 2 (1 * 1 * 2 * 2)  == 1 * 1 + 2 * 2--- @-removeEdge :: Ord a => a -> a -> Relation a -> Relation a-removeEdge x y (Relation d r) = Relation d (Set.delete (x, y) r)---- | Transform a graph by applying a function to each of its vertices. This is--- similar to @Functor@'s 'fmap' but can be used with non-fully-parametric--- 'Relation'.--- Complexity: /O((n + m) * log(n))/ time.------ @--- gmap f 'empty'      == 'empty'--- gmap f ('vertex' x) == 'vertex' (f x)--- gmap f ('Algebra.Graph.Relation.edge' x y) == 'Algebra.Graph.Relation.edge' (f x) (f y)--- gmap id           == id--- gmap f . gmap g   == gmap (f . g)--- @-gmap :: (Ord a, Ord b) => (a -> b) -> Relation a -> Relation b-gmap f (Relation d r) = Relation (Set.map f d) (Set.map (\(x, y) -> (f x, f y)) r)---- | Construct the /induced subgraph/ of a given graph by removing the--- vertices that do not satisfy a given predicate.--- Complexity: /O(m)/ time, assuming that the predicate takes /O(1)/ to--- be evaluated.------ @--- induce (const True)  x      == x--- induce (const False) x      == 'empty'--- induce (/= x)               == 'removeVertex' x--- induce p . induce q         == induce (\\x -> p x && q x)--- 'Algebra.Graph.Relation.isSubgraphOf' (induce p x) x == True--- @-induce :: Ord a => (a -> Bool) -> Relation a -> Relation a-induce p (Relation d r) = Relation (Set.filter p d) (Set.filter pp r)-  where-    pp (x, y) = p x && p y---- | Compute the /reflexive closure/ of a 'Relation'.--- Complexity: /O(n*log(m))/ time.------ @--- reflexiveClosure 'empty'      == 'empty'--- reflexiveClosure ('vertex' x) == 'Algebra.Graph.Relation.edge' x x--- @-reflexiveClosure :: Ord a => Relation a -> Relation a-reflexiveClosure (Relation d r) =-    Relation d $ r `union` Set.fromDistinctAscList [ (a, a) | a <- Set.elems d ]---- | Compute the /symmetric closure/ of a 'Relation'.--- Complexity: /O(m*log(m))/ time.------ @--- symmetricClosure 'empty'      == 'empty'--- symmetricClosure ('vertex' x) == 'vertex' x--- symmetricClosure ('Algebra.Graph.Relation.edge' x y) == 'Algebra.Graph.Relation.edges' [(x, y), (y, x)]--- @-symmetricClosure :: Ord a => Relation a -> Relation a-symmetricClosure (Relation d r) = Relation d $ r `union` (Set.map swap r)---- | Compute the /transitive closure/ of a 'Relation'.--- Complexity: /O(n * m * log(m))/ time.------ @--- transitiveClosure 'empty'           == 'empty'--- transitiveClosure ('vertex' x)      == 'vertex' x--- transitiveClosure ('Algebra.Graph.Relation.path' $ 'Data.List.nub' xs) == 'Algebra.Graph.Relation.clique' ('Data.List.nub' xs)--- @-transitiveClosure :: Ord a => Relation a -> Relation a-transitiveClosure old@(Relation d r)-    | r == newR = old-    | otherwise = transitiveClosure $ Relation d newR-  where-    newR = Set.unions $ r : [ preset x old >< postset x old | x <- Set.elems d ]---- | Compute the /preorder closure/ of a 'Relation'.--- Complexity: /O(n * m * log(m))/ time.------ @--- preorderClosure 'empty'           == 'empty'--- preorderClosure ('vertex' x)      == 'Algebra.Graph.Relation.edge' x x--- preorderClosure ('Algebra.Graph.Relation.path' $ 'Data.List.nub' xs) == 'reflexiveClosure' ('Algebra.Graph.Relation.clique' $ 'Data.List.nub' xs)--- @-preorderClosure :: Ord a => Relation a -> Relation a-preorderClosure = reflexiveClosure . transitiveClosure---- TODO: Optimise the implementation by caching the results of reflexive closure.-{-| The 'ReflexiveRelation' data type represents a /reflexive binary relation/-over a set of elements. Reflexive relations satisfy all laws of the-'C.Reflexive' type class and, in particular, the /self-loop/ axiom:--@'C.vertex' x == 'C.vertex' x * 'C.vertex' x@--The 'Show' instance produces reflexively closed expressions:--@show (1     :: ReflexiveRelation Int) == "edge 1 1"-show (1 * 2 :: ReflexiveRelation Int) == "edges [(1,1),(1,2),(2,2)]"@--}-newtype ReflexiveRelation a = ReflexiveRelation { fromReflexive :: Relation a }-    deriving Num--instance Ord a => Eq (ReflexiveRelation a) where-    x == y = reflexiveClosure (fromReflexive x) == reflexiveClosure (fromReflexive y)--instance (Ord a, Show a) => Show (ReflexiveRelation a) where-    show = show . reflexiveClosure . fromReflexive---- TODO: To be derived automatically using GeneralizedNewtypeDeriving in GHC 8.2-instance Ord a => C.Graph (ReflexiveRelation a) where-    type Vertex (ReflexiveRelation a) = a-    empty       = ReflexiveRelation empty-    vertex      = ReflexiveRelation . vertex-    overlay x y = ReflexiveRelation $ fromReflexive x `overlay` fromReflexive y-    connect x y = ReflexiveRelation $ fromReflexive x `connect` fromReflexive y--instance Ord a => C.Reflexive (ReflexiveRelation a)---- TODO: Optimise the implementation by caching the results of symmetric closure.-{-|  The 'SymmetricRelation' data type represents a /symmetric binary relation/-over a set of elements. Symmetric relations satisfy all laws of the-'C.Undirected' type class and, in particular, the-commutativity of connect:--@'C.connect' x y == 'C.connect' y x@--The 'Show' instance produces symmetrically closed expressions:--@show (1     :: SymmetricRelation Int) == "vertex 1"-show (1 * 2 :: SymmetricRelation Int) == "edges [(1,2),(2,1)]"@--}-newtype SymmetricRelation a = SymmetricRelation { fromSymmetric :: Relation a }-    deriving Num--instance Ord a => Eq (SymmetricRelation a) where-    x == y = symmetricClosure (fromSymmetric x) == symmetricClosure (fromSymmetric y)--instance (Ord a, Show a) => Show (SymmetricRelation a) where-    show = show . symmetricClosure . fromSymmetric---- TODO: To be derived automatically using GeneralizedNewtypeDeriving in GHC 8.2-instance Ord a => C.Graph (SymmetricRelation a) where-    type Vertex (SymmetricRelation a) = a-    empty       = SymmetricRelation empty-    vertex      = SymmetricRelation . vertex-    overlay x y = SymmetricRelation $ fromSymmetric x `overlay` fromSymmetric y-    connect x y = SymmetricRelation $ fromSymmetric x `connect` fromSymmetric y--instance Ord a => C.Undirected (SymmetricRelation a)---- TODO: Optimise the implementation by caching the results of transitive closure.-{-| The 'TransitiveRelation' data type represents a /transitive binary relation/-over a set of elements. Transitive relations satisfy all laws of the-'C.Transitive' type class and, in particular, the /closure/ axiom:--@y /= 'C.empty' ==> x * y + x * z + y * z == x * y + y * z@--For example, the following holds:--@'C.path' xs == 'C.clique' xs@--The 'Show' instance produces transitively closed expressions:--@show (1 * 2         :: TransitiveRelation Int) == "edge 1 2"-show (1 * 2 + 2 * 3 :: TransitiveRelation Int) == "edges [(1,2),(1,3),(2,3)]"@--}-newtype TransitiveRelation a = TransitiveRelation { fromTransitive :: Relation a }-    deriving Num--instance Ord a => Eq (TransitiveRelation a) where-    x == y = transitiveClosure (fromTransitive x) == transitiveClosure (fromTransitive y)--instance (Ord a, Show a) => Show (TransitiveRelation a) where-    show = show . transitiveClosure . fromTransitive---- To be derived automatically using GeneralizedNewtypeDeriving in GHC 8.2-instance Ord a => C.Graph (TransitiveRelation a) where-    type Vertex (TransitiveRelation a) = a-    empty       = TransitiveRelation empty-    vertex      = TransitiveRelation . vertex-    overlay x y = TransitiveRelation $ fromTransitive x `overlay` fromTransitive y-    connect x y = TransitiveRelation $ fromTransitive x `connect` fromTransitive y--instance Ord a => C.Transitive (TransitiveRelation a)---- TODO: Optimise the implementation by caching the results of preorder closure.-{-| The 'PreorderRelation' data type represents a binary relation over a set of-elements that is both transitive and reflexive. Preorders satisfy all laws of the-'Algebra.Graph.Class.Preorder' type class and, in particular, the /closure/-axiom:--@y /= 'C.empty' ==> x * y + x * z + y * z == x * y + y * z@--and the /self-loop/ axiom:--@'C.vertex' x == 'C.vertex' x * 'C.vertex' x@--For example, the following holds:--@'C.path' xs == 'C.clique' xs@--The 'Show' instance produces reflexively and transitively closed expressions:--@show (1             :: PreorderRelation Int) == "edge 1 1"-show (1 * 2         :: PreorderRelation Int) == "edges [(1,1),(1,2),(2,2)]"-show (1 * 2 + 2 * 3 :: PreorderRelation Int) == "edges [(1,1),(1,2),(1,3),(2,2),(2,3),(3,3)]"@--}-newtype PreorderRelation a = PreorderRelation { fromPreorder :: Relation a }-    deriving Num--instance (Ord a, Show a) => Show (PreorderRelation a) where-    show = show . preorderClosure . fromPreorder--instance Ord a => Eq (PreorderRelation a) where-    x == y = preorderClosure (fromPreorder x) == preorderClosure (fromPreorder y)---- To be derived automatically using GeneralizedNewtypeDeriving in GHC 8.2-instance Ord a => C.Graph (PreorderRelation a) where-    type Vertex (PreorderRelation a) = a-    empty       = PreorderRelation empty-    vertex      = PreorderRelation . vertex-    overlay x y = PreorderRelation $ fromPreorder x `overlay` fromPreorder y-    connect x y = PreorderRelation $ fromPreorder x `connect` fromPreorder y+consistent (Relation d r) = referredToVertexSet r `Set.isSubsetOf` d -instance Ord a => C.Reflexive  (PreorderRelation a)-instance Ord a => C.Transitive (PreorderRelation a)-instance Ord a => C.Preorder   (PreorderRelation a)+-- | The set of elements that appear in a given set of pairs.+-- /Note: this function is for internal use only/.+referredToVertexSet :: Ord a => Set (a, a) -> Set a+referredToVertexSet = Set.fromList . uncurry (++) . unzip . Set.toAscList

@@ -0,0 +1,161 @@+-----------------------------------------------------------------------------+-- |+-- Module     : Algebra.Graph.Relation.InternalDerived+-- Copyright  : (c) Andrey Mokhov 2016-2017+-- License    : MIT (see the file LICENSE)+-- Maintainer : andrey.mokhov@gmail.com+-- Stability  : unstable+--+-- This module exposes the implementation of derived binary relation data types.+-- The API is unstable and unsafe. Where possible use the non-internal modules+-- "Algebra.Graph.Relation.Reflexive", "Algebra.Graph.Relation.Symmetric",+-- "Algebra.Graph.Relation.Transitive" and "Algebra.Graph.Relation.Preorder"+-- instead.+-----------------------------------------------------------------------------+module Algebra.Graph.Relation.InternalDerived (+    -- * Implementation of derived binary relations+    ReflexiveRelation (..), SymmetricRelation (..), TransitiveRelation (..),+    PreorderRelation (..)+  ) where++import Algebra.Graph.Class+import Algebra.Graph.Relation (Relation, reflexiveClosure, symmetricClosure,+                               transitiveClosure, preorderClosure)++{-| The 'ReflexiveRelation' data type represents a /reflexive binary relation/+over a set of elements. Reflexive relations satisfy all laws of the+'Reflexive' type class and, in particular, the /self-loop/ axiom:++@'vertex' x == 'vertex' x * 'vertex' x@++The 'Show' instance produces reflexively closed expressions:++@show (1     :: ReflexiveRelation Int) == "edge 1 1"+show (1 * 2 :: ReflexiveRelation Int) == "edges [(1,1),(1,2),(2,2)]"@+-}+newtype ReflexiveRelation a = ReflexiveRelation { fromReflexive :: Relation a }+    deriving Num++instance Ord a => Eq (ReflexiveRelation a) where+    x == y = reflexiveClosure (fromReflexive x) == reflexiveClosure (fromReflexive y)++instance (Ord a, Show a) => Show (ReflexiveRelation a) where+    show = show . reflexiveClosure . fromReflexive++instance Ord a => Graph (ReflexiveRelation a) where+    type Vertex (ReflexiveRelation a) = a+    empty       = ReflexiveRelation empty+    vertex      = ReflexiveRelation . vertex+    overlay x y = ReflexiveRelation $ fromReflexive x `overlay` fromReflexive y+    connect x y = ReflexiveRelation $ fromReflexive x `connect` fromReflexive y++instance Ord a => Reflexive (ReflexiveRelation a)++-- TODO: Optimise the implementation by caching the results of symmetric closure.+{-|  The 'SymmetricRelation' data type represents a /symmetric binary relation/+over a set of elements. Symmetric relations satisfy all laws of the+'Undirected' type class and, in particular, the+commutativity of connect:++@'connect' x y == 'connect' y x@++The 'Show' instance produces symmetrically closed expressions:++@show (1     :: SymmetricRelation Int) == "vertex 1"+show (1 * 2 :: SymmetricRelation Int) == "edges [(1,2),(2,1)]"@+-}+newtype SymmetricRelation a = SymmetricRelation { fromSymmetric :: Relation a }+    deriving Num++instance Ord a => Eq (SymmetricRelation a) where+    x == y = symmetricClosure (fromSymmetric x) == symmetricClosure (fromSymmetric y)++instance (Ord a, Show a) => Show (SymmetricRelation a) where+    show = show . symmetricClosure . fromSymmetric++-- TODO: To be derived automatically using GeneralizedNewtypeDeriving in GHC 8.2+instance Ord a => Graph (SymmetricRelation a) where+    type Vertex (SymmetricRelation a) = a+    empty       = SymmetricRelation empty+    vertex      = SymmetricRelation . vertex+    overlay x y = SymmetricRelation $ fromSymmetric x `overlay` fromSymmetric y+    connect x y = SymmetricRelation $ fromSymmetric x `connect` fromSymmetric y++instance Ord a => Undirected (SymmetricRelation a)++-- TODO: Optimise the implementation by caching the results of transitive closure.+{-| The 'TransitiveRelation' data type represents a /transitive binary relation/+over a set of elements. Transitive relations satisfy all laws of the+'Transitive' type class and, in particular, the /closure/ axiom:++@y /= 'empty' ==> x * y + x * z + y * z == x * y + y * z@++For example, the following holds:++@'path' xs == ('clique' xs :: TransitiveRelation Int)@++The 'Show' instance produces transitively closed expressions:++@show (1 * 2         :: TransitiveRelation Int) == "edge 1 2"+show (1 * 2 + 2 * 3 :: TransitiveRelation Int) == "edges [(1,2),(1,3),(2,3)]"@+-}+newtype TransitiveRelation a = TransitiveRelation { fromTransitive :: Relation a }+    deriving Num++instance Ord a => Eq (TransitiveRelation a) where+    x == y = transitiveClosure (fromTransitive x) == transitiveClosure (fromTransitive y)++instance (Ord a, Show a) => Show (TransitiveRelation a) where+    show = show . transitiveClosure . fromTransitive++-- TODO: To be derived automatically using GeneralizedNewtypeDeriving in GHC 8.2+instance Ord a => Graph (TransitiveRelation a) where+    type Vertex (TransitiveRelation a) = a+    empty       = TransitiveRelation empty+    vertex      = TransitiveRelation . vertex+    overlay x y = TransitiveRelation $ fromTransitive x `overlay` fromTransitive y+    connect x y = TransitiveRelation $ fromTransitive x `connect` fromTransitive y++instance Ord a => Transitive (TransitiveRelation a)++-- TODO: Optimise the implementation by caching the results of preorder closure.+{-| The 'PreorderRelation' data type represents a+/binary relation that is both reflexive and transitive/. Preorders satisfy all+laws of the 'Preorder' type class and, in particular, the /self-loop/ axiom:++@'vertex' x == 'vertex' x * 'vertex' x@++and the /closure/ axiom:++@y /= 'empty' ==> x * y + x * z + y * z == x * y + y * z@++For example, the following holds:++@'path' xs == ('clique' xs :: PreorderRelation Int)@++The 'Show' instance produces reflexively and transitively closed expressions:++@show (1             :: PreorderRelation Int) == "edge 1 1"+show (1 * 2         :: PreorderRelation Int) == "edges [(1,1),(1,2),(2,2)]"+show (1 * 2 + 2 * 3 :: PreorderRelation Int) == "edges [(1,1),(1,2),(1,3),(2,2),(2,3),(3,3)]"@+-}+newtype PreorderRelation a = PreorderRelation { fromPreorder :: Relation a }+    deriving Num++instance (Ord a, Show a) => Show (PreorderRelation a) where+    show = show . preorderClosure . fromPreorder++instance Ord a => Eq (PreorderRelation a) where+    x == y = preorderClosure (fromPreorder x) == preorderClosure (fromPreorder y)++-- TODO: To be derived automatically using GeneralizedNewtypeDeriving in GHC 8.2+instance Ord a => Graph (PreorderRelation a) where+    type Vertex (PreorderRelation a) = a+    empty       = PreorderRelation empty+    vertex      = PreorderRelation . vertex+    overlay x y = PreorderRelation $ fromPreorder x `overlay` fromPreorder y+    connect x y = PreorderRelation $ fromPreorder x `connect` fromPreorder y++instance Ord a => Reflexive  (PreorderRelation a)+instance Ord a => Transitive (PreorderRelation a)+instance Ord a => Preorder   (PreorderRelation a)

@@ -14,7 +14,8 @@     PreorderRelation, fromRelation, toRelation   ) where -import Algebra.Graph.Relation.Internal+import Algebra.Graph.Relation+import Algebra.Graph.Relation.InternalDerived  -- | Construct a preorder relation from a 'Relation'. -- Complexity: /O(1)/ time.

@@ -14,7 +14,8 @@     ReflexiveRelation, fromRelation, toRelation   ) where -import Algebra.Graph.Relation.Internal+import Algebra.Graph.Relation+import Algebra.Graph.Relation.InternalDerived  -- | Construct a reflexive relation from a 'Relation'. -- Complexity: /O(1)/ time.

@@ -17,7 +17,8 @@     neighbours   ) where -import Algebra.Graph.Relation.Internal+import Algebra.Graph.Relation+import Algebra.Graph.Relation.InternalDerived  import qualified Data.Set as Set 

@@ -14,7 +14,8 @@     TransitiveRelation, fromRelation, toRelation   ) where -import Algebra.Graph.Relation.Internal+import Algebra.Graph.Relation+import Algebra.Graph.Relation.InternalDerived  -- | Construct a transitive relation from a 'Relation'. -- Complexity: /O(1)/ time.

@@ -39,7 +39,7 @@     test "Consistency of fromAdjacencyList" $ \xs ->         consistent (fromAdjacencyList xs :: AI) -    putStrLn "\n============ Show ============"+    putStrLn "\n============ AdjacencyMap.Show ============"     test "show (empty     :: AdjacencyMap Int) == \"empty\"" $           show (empty     :: AdjacencyMap Int) == "empty" @@ -58,7 +58,7 @@     test "show (1 * 2 + 3 :: AdjacencyMap Int) == \"graph [1,2,3] [(1,2)]\"" $           show (1 * 2 + 3 :: AdjacencyMap Int) == "graph [1,2,3] [(1,2)]" -    putStrLn "\n============ empty ============"+    putStrLn "\n============ AdjacencyMap.empty ============"     test "isEmpty     empty == True" $           isEmpty    (empty :: AI) == True @@ -71,7 +71,7 @@     test "edgeCount   empty == 0" $           edgeCount  (empty :: AI) == 0 -    putStrLn "\n============ vertex ============"+    putStrLn "\n============ AdjacencyMap.vertex ============"     test "isEmpty     (vertex x) == False" $ \(x :: Int) ->           isEmpty     (vertex x) == False @@ -87,7 +87,7 @@     test "edgeCount   (vertex x) == 0" $ \(x :: Int) ->           edgeCount   (vertex x) == 0 -    putStrLn "\n============ edge ============"+    putStrLn "\n============ AdjacencyMap.edge ============"     test "edge x y               == connect (vertex x) (vertex y)" $ \(x :: Int) y ->          (edge x y :: AI)        == connect (vertex x) (vertex y) @@ -103,7 +103,7 @@     test "vertexCount (edge 1 2) == 2" $           vertexCount (edge 1 2 :: AI) == 2 -    putStrLn "\n============ overlay ============"+    putStrLn "\n============ AdjacencyMap.overlay ============"     test "isEmpty     (overlay x y) == isEmpty   x   && isEmpty   y" $ \(x :: AI) y ->           isEmpty     (overlay x y) == (isEmpty   x   && isEmpty   y) @@ -128,7 +128,7 @@     test "edgeCount   (overlay 1 2) == 0" $           edgeCount   (overlay 1 2 :: AI) == 0 -    putStrLn "\n============ connect ============"+    putStrLn "\n============ AdjacencyMap.connect ============"     test "isEmpty     (connect x y) == isEmpty   x   && isEmpty   y" $ \(x :: AI) y ->           isEmpty     (connect x y) == (isEmpty   x   && isEmpty   y) @@ -159,7 +159,7 @@     test "edgeCount   (connect 1 2) == 1" $           edgeCount   (connect 1 2 :: AI) == 1 -    putStrLn "\n============ vertices ============"+    putStrLn "\n============ AdjacencyMap.vertices ============"     test "vertices []            == empty" $           vertices []            == (empty :: AI) @@ -175,7 +175,7 @@     test "vertexSet   . vertices == Set.fromList" $ \(xs :: [Int]) ->          (vertexSet   . vertices) xs == Set.fromList xs -    putStrLn "\n============ edges ============"+    putStrLn "\n============ AdjacencyMap.edges ============"     test "edges []          == empty" $           edges []          == (empty :: AI) @@ -185,7 +185,7 @@     test "edgeCount . edges == length . nub" $ \(xs :: [(Int, Int)]) ->          (edgeCount . edges) xs == (length . nubOrd) xs -    putStrLn "\n============ overlays ============"+    putStrLn "\n============ AdjacencyMap.overlays ============"     test "overlays []        == empty" $           overlays []        == (empty :: AI) @@ -198,7 +198,7 @@     test "isEmpty . overlays == all isEmpty" $ mapSize (min 10) $ \(xs :: [AI]) ->          (isEmpty . overlays) xs == all isEmpty xs -    putStrLn "\n============ connects ============"+    putStrLn "\n============ AdjacencyMap.connects ============"     test "connects []        == empty" $           connects []        == (empty :: AI) @@ -211,7 +211,7 @@     test "isEmpty . connects == all isEmpty" $ mapSize (min 10) $ \(xs :: [AI]) ->          (isEmpty . connects) xs == all isEmpty xs -    putStrLn "\n============ graph ============"+    putStrLn "\n============ AdjacencyMap.graph ============"     test "graph []  []      == empty" $           graph []  []      == (empty :: AI) @@ -224,7 +224,7 @@     test "graph vs  es      == overlay (vertices vs) (edges es)" $ \(vs :: [Int]) es ->           graph vs  es      == (overlay (vertices vs) (edges es) :: AI) -    putStrLn "\n============ fromAdjacencyList ============"+    putStrLn "\n============ AdjacencyMap.fromAdjacencyList ============"     test "fromAdjacencyList []                                  == empty" $           fromAdjacencyList []                                  == (empty :: AI) @@ -240,7 +240,7 @@     test "overlay (fromAdjacencyList xs) (fromAdjacencyList ys) == fromAdjacencyList (xs ++ ys)" $ \xs ys ->           overlay (fromAdjacencyList xs) (fromAdjacencyList ys) ==(fromAdjacencyList (xs ++ ys) :: AI) -    putStrLn "\n============ isSubgraphOf ============"+    putStrLn "\n============ AdjacencyMap.isSubgraphOf ============"     test "isSubgraphOf empty         x             == True" $ \(x :: AI) ->           isSubgraphOf empty         x             == True @@ -256,7 +256,7 @@     test "isSubgraphOf (path xs)     (circuit xs)  == True" $ \xs ->           isSubgraphOf (path xs :: AI)(circuit xs)  == True -    putStrLn "\n============ isEmpty ============"+    putStrLn "\n============ AdjacencyMap.isEmpty ============"     test "isEmpty empty                       == True" $           isEmpty (empty :: AI)                == True @@ -272,7 +272,7 @@     test "isEmpty (removeEdge x y $ edge x y) == False" $ \(x :: Int) y ->           isEmpty (removeEdge x y $ edge x y) == False -    putStrLn "\n============ hasVertex ============"+    putStrLn "\n============ AdjacencyMap.hasVertex ============"     test "hasVertex x empty            == False" $ \(x :: Int) ->           hasVertex x empty            == False @@ -282,7 +282,7 @@     test "hasVertex x . removeVertex x == const False" $ \(x :: Int) y ->           hasVertex x (removeVertex x y)==const False y -    putStrLn "\n============ hasEdge ============"+    putStrLn "\n============ AdjacencyMap.hasEdge ============"     test "hasEdge x y empty            == False" $ \(x :: Int) y ->           hasEdge x y empty            == False @@ -295,7 +295,7 @@     test "hasEdge x y . removeEdge x y == const False" $ \(x :: Int) y z ->           hasEdge x y (removeEdge x y z)==const False z -    putStrLn "\n============ vertexCount ============"+    putStrLn "\n============ AdjacencyMap.vertexCount ============"     test "vertexCount empty      == 0" $           vertexCount (empty :: AI) == 0 @@ -305,7 +305,7 @@     test "vertexCount            == length . vertexList" $ \(x :: AI) ->           vertexCount x          == (length . vertexList) x -    putStrLn "\n============ edgeCount ============"+    putStrLn "\n============ AdjacencyMap.edgeCount ============"     test "edgeCount empty      == 0" $           edgeCount (empty :: AI) == 0 @@ -318,7 +318,7 @@     test "edgeCount            == length . edgeList" $ \(x :: AI) ->           edgeCount x          == (length . edgeList) x -    putStrLn "\n============ vertexList ============"+    putStrLn "\n============ AdjacencyMap.vertexList ============"     test "vertexList empty      == []" $           vertexList (empty :: AI) == [] @@ -328,7 +328,7 @@     test "vertexList . vertices == nub . sort" $ \(xs :: [Int]) ->          (vertexList . vertices) xs == (nubOrd . sort) xs -    putStrLn "\n============ edgeList ============"+    putStrLn "\n============ AdjacencyMap.edgeList ============"     test "edgeList empty          == []" $           edgeList (empty :: AI )  == [] @@ -344,7 +344,7 @@     test "edgeList . edges        == nub . sort" $ \(xs :: [(Int, Int)]) ->          (edgeList . edges) xs    == (nubOrd . sort) xs -    putStrLn "\n============ adjacencyList ============"+    putStrLn "\n============ AdjacencyMap.adjacencyList ============"     test "adjacencyList empty          == []" $           adjacencyList (empty :: AI)  == [] @@ -357,7 +357,7 @@     test "adjacencyList (star 2 [3,1]) == [(1, []), (2, [1,3]), (3, [])]" $           adjacencyList (star 2 [3,1::Int]) == [(1, []), (2, [1,3]), (3, [])] -    putStrLn "\n============ vertexSet ============"+    putStrLn "\n============ AdjacencyMap.vertexSet ============"     test "vertexSet empty      == Set.empty" $           vertexSet(empty :: AI)== Set.empty @@ -370,7 +370,7 @@     test "vertexSet . clique   == Set.fromList" $ \(xs :: [Int]) ->          (vertexSet . clique) xs == Set.fromList xs -    putStrLn "\n============ edgeSet ============"+    putStrLn "\n============ AdjacencyMap.edgeSet ============"     test "edgeSet empty      == Set.empty" $           edgeSet (empty :: AI) == Set.empty @@ -383,7 +383,7 @@     test "edgeSet . edges    == Set.fromList" $ \(xs :: [(Int, Int)]) ->          (edgeSet . edges) xs== Set.fromList xs -    putStrLn "\n============ postset ============"+    putStrLn "\n============ AdjacencyMap.postset ============"     test "postset x empty      == Set.empty" $ \(x :: Int) ->           postset x empty      == Set.empty @@ -396,7 +396,7 @@     test "postset 2 (edge 1 2) == Set.empty" $           postset 2 (edge 1 2) ==(Set.empty :: Set.Set Int) -    putStrLn "\n============ path ============"+    putStrLn "\n============ AdjacencyMap.path ============"     test "path []    == empty" $           path []    == (empty :: AI) @@ -406,7 +406,7 @@     test "path [x,y] == edge x y" $ \(x :: Int) y ->           path [x,y] == (edge x y :: AI) -    putStrLn "\n============ circuit ============"+    putStrLn "\n============ AdjacencyMap.circuit ============"     test "circuit []    == empty" $           circuit []    == (empty :: AI) @@ -416,7 +416,7 @@     test "circuit [x,y] == edges [(x,y), (y,x)]" $ \(x :: Int) y ->           circuit [x,y] == (edges [(x,y), (y,x)] :: AI) -    putStrLn "\n============ clique ============"+    putStrLn "\n============ AdjacencyMap.clique ============"     test "clique []      == empty" $           clique []      == (empty :: AI) @@ -429,7 +429,7 @@     test "clique [x,y,z] == edges [(x,y), (x,z), (y,z)]" $ \(x :: Int) y z ->           clique [x,y,z] == (edges [(x,y), (x,z), (y,z)] :: AI) -    putStrLn "\n============ biclique ============"+    putStrLn "\n============ AdjacencyMap.biclique ============"     test "biclique []      []      == empty" $           biclique []      []      == (empty :: AI) @@ -442,7 +442,10 @@     test "biclique [x1,x2] [y1,y2] == edges [(x1,y1), (x1,y2), (x2,y1), (x2,y2)]" $ \(x1 :: Int) x2 y1 y2 ->           biclique [x1,x2] [y1,y2] == (edges [(x1,y1), (x1,y2), (x2,y1), (x2,y2)] :: AI) -    putStrLn "\n============ star ============"+    test "biclique xs      ys      == connect (vertices xs) (vertices ys)" $ \(xs :: [Int]) ys ->+          biclique xs      ys      == connect (vertices xs) (vertices ys)++    putStrLn "\n============ AdjacencyMap.star ============"     test "star x []    == vertex x" $ \(x :: Int) ->           star x []    == (vertex x :: AI) @@ -452,14 +455,40 @@     test "star x [y,z] == edges [(x,y), (x,z)]" $ \(x :: Int) y z ->           star x [y,z] == (edges [(x,y), (x,z)] :: AI) -    putStrLn "\n============ removeVertex ============"+    putStrLn "\n============ AdjacencyMap.tree ============"+    test "tree (Node x [])                                         == vertex x" $ \(x :: Int) ->+          tree (Node x [])                                         == vertex x++    test "tree (Node x [Node y [Node z []]])                       == path [x,y,z]" $ \(x :: Int) y z ->+          tree (Node x [Node y [Node z []]])                       == path [x,y,z]++    test "tree (Node x [Node y [], Node z []])                     == star x [y,z]" $ \(x :: Int) y z ->+          tree (Node x [Node y [], Node z []])                     == star x [y,z]++    test "tree (Node 1 [Node 2 [], Node 3 [Node 4 [], Node 5 []]]) == edges [(1,2), (1,3), (3,4), (3,5)]" $+          tree (Node 1 [Node 2 [], Node 3 [Node 4 [], Node 5 []]]) == edges [(1,2), (1,3), (3,4), (3,5::Int)]++    putStrLn "\n============ AdjacencyMap.forest ============"+    test "forest []                                                  == empty" $+          forest []                                                  == (empty :: AI)++    test "forest [x]                                                 == tree x" $ \(x :: Tree Int) ->+          forest [x]                                                 == tree x++    test "forest [Node 1 [Node 2 [], Node 3 []], Node 4 [Node 5 []]] == edges [(1,2), (1,3), (4,5)]" $+          forest [Node 1 [Node 2 [], Node 3 []], Node 4 [Node 5 []]] == edges [(1,2), (1,3), (4,5::Int)]++    test "forest                                                     == overlays . map tree" $ \(x :: Forest Int) ->+         (forest x)                                                  ==(overlays . map tree) x++    putStrLn "\n============ AdjacencyMap.removeVertex ============"     test "removeVertex x (vertex x)       == empty" $ \(x :: Int) ->           removeVertex x (vertex x)       == (empty :: AI)      test "removeVertex x . removeVertex x == removeVertex x" $ \x (y :: AI) ->          (removeVertex x . removeVertex x)y==(removeVertex x y :: AI) -    putStrLn "\n============ removeEdge ============"+    putStrLn "\n============ AdjacencyMap.removeEdge ============"     test "removeEdge x y (edge x y)       == vertices [x, y]" $ \(x :: Int) y ->           removeEdge x y (edge x y)       == (vertices [x, y] :: AI) @@ -475,7 +504,7 @@     test "removeEdge 1 2 (1 * 1 * 2 * 2)  == 1 * 1 + 2 * 2" $           removeEdge 1 2 (1 * 1 * 2 * 2)  == (1 * 1 + 2 * (2 :: AI)) -    putStrLn "\n============ replaceVertex ============"+    putStrLn "\n============ AdjacencyMap.replaceVertex ============"     test "replaceVertex x x            == id" $ \x (y :: AI) ->           replaceVertex x x y          == y @@ -485,7 +514,7 @@     test "replaceVertex x y            == mergeVertices (== x) y" $ \x y z ->           replaceVertex x y z          == (mergeVertices (== x) y z :: AI) -    putStrLn "\n============ mergeVertices ============"+    putStrLn "\n============ AdjacencyMap.mergeVertices ============"     test "mergeVertices (const False) x    == id" $ \x (y :: AI) ->           mergeVertices (const False) x y  == y @@ -498,7 +527,7 @@     test "mergeVertices odd  1 (3 + 4 * 5) == 4 * 1" $           mergeVertices odd  1 (3 + 4 * 5) == (4 * 1 :: AI) -    putStrLn "\n============ gmap ============"+    putStrLn "\n============ AdjacencyMap.gmap ============"     test "gmap f empty      == empty" $ \(apply -> f :: II) ->           gmap f empty      == empty @@ -514,7 +543,7 @@     test "gmap f . gmap g   == gmap (f . g)" $ \(apply -> f :: II) (apply -> g :: II) x ->          (gmap f . gmap g) x== gmap (f . g) x -    putStrLn "\n============ induce ============"+    putStrLn "\n============ AdjacencyMap.induce ============"     test "induce (const True)  x      == x" $ \(x :: AI) ->           induce (const True)  x      == x @@ -530,7 +559,7 @@     test "isSubgraphOf (induce p x) x == True" $ \(apply -> p :: IB) (x :: AI) ->           isSubgraphOf (induce p x) x == True -    putStrLn "\n============ dfsForest ============"+    putStrLn "\n============ AdjacencyMap.dfsForest ============"     test "forest (dfsForest $ edge 1 1)         == vertex 1" $           forest (dfsForest $ edge 1 (1 :: Int))==(vertex 1 :: AI) @@ -554,7 +583,7 @@                                                    , subForest = [ Node { rootLabel = 4                                                                         , subForest = [] }]}] -    putStrLn "\n============ topSort ============"+    putStrLn "\n============ AdjacencyMap.topSort ============"     test "topSort (1 * 2 + 3 * 1)             == Just [3,1,2]" $           topSort (1 * 2 + 3 * 1)             == Just [3,1,2 :: Int] @@ -564,7 +593,7 @@     test "fmap (flip isTopSort x) (topSort x) /= Just False" $ \(x :: AI) ->           fmap (flip isTopSort x) (topSort x) /= Just False -    putStrLn "\n============ isTopSort  ============"+    putStrLn "\n============ AdjacencyMap.isTopSort  ============"     test "isTopSort [3, 1, 2] (1 * 2 + 3 * 1) == True" $           isTopSort [3, 1, 2] (1 * 2 + 3 * 1 :: AI) == True @@ -583,7 +612,7 @@     test "isTopSort [x]       (edge x x)      == False" $ \(x :: Int) ->           isTopSort [x]       (edge x x)      == False -    putStrLn "\n============ scc ============"+    putStrLn "\n============ AdjacencyMap.scc ============"     test "scc empty               == empty" $           scc(empty :: AI)        == empty @@ -602,7 +631,7 @@                                            , (Set.fromList [3]  , Set.fromList [1,4])                                            , (Set.fromList [3]  , Set.fromList [5 :: Int])] -    putStrLn "\n============ GraphKL ============"+    putStrLn "\n============ AdjacencyMap.GraphKL ============"     test "map (getVertex h) (vertices $ getGraph h) == Set.toAscList (vertexSet g)"       $ \(g :: AI) -> let h = graphKL g in         map (getVertex h) (KL.vertices $ getGraph h) == Set.toAscList (vertexSet g)

@@ -7,26 +7,28 @@ -- Maintainer : andrey.mokhov@gmail.com -- Stability  : experimental ----- Generators and orphan Arbitrary instances for various graph data types.---+-- Generators and orphan Arbitrary instances for various data types. ----------------------------------------------------------------------------- module Algebra.Graph.Test.Arbitrary (     -- * Generators of arbitrary graph instances     arbitraryGraph, arbitraryRelation, arbitraryAdjacencyMap, arbitraryIntAdjacencyMap   ) where +import Control.Monad+import Data.Tree import Test.QuickCheck  import Algebra.Graph-import Algebra.Graph.AdjacencyMap.Internal (AdjacencyMap (..))+import Algebra.Graph.AdjacencyMap.Internal import Algebra.Graph.Fold (Fold)-import Algebra.Graph.IntAdjacencyMap.Internal (IntAdjacencyMap (..))-import Algebra.Graph.Relation.Internal (Relation (..))+import Algebra.Graph.IntAdjacencyMap.Internal+import Algebra.Graph.Relation.Internal+import Algebra.Graph.Relation.InternalDerived -import qualified Algebra.Graph.Class                    as C-import qualified Algebra.Graph.AdjacencyMap.Internal    as AdjacencyMap-import qualified Algebra.Graph.IntAdjacencyMap.Internal as IntAdjacencyMap-import qualified Algebra.Graph.Relation.Internal        as Relation+import qualified Algebra.Graph.Class             as C+import qualified Algebra.Graph.AdjacencyMap      as AdjacencyMap+import qualified Algebra.Graph.IntAdjacencyMap   as IntAdjacencyMap+import qualified Algebra.Graph.Relation          as Relation  -- | Generate an arbitrary 'Graph' value of a specified size. arbitraryGraph :: (C.Graph g, Arbitrary (C.Vertex g)) => Gen g@@ -67,17 +69,17 @@ instance (Arbitrary a, Ord a) => Arbitrary (Relation a) where     arbitrary = arbitraryRelation -instance (Arbitrary a, Ord a) => Arbitrary (Relation.ReflexiveRelation a) where-    arbitrary = Relation.ReflexiveRelation <$> arbitraryRelation+instance (Arbitrary a, Ord a) => Arbitrary (ReflexiveRelation a) where+    arbitrary = ReflexiveRelation <$> arbitraryRelation -instance (Arbitrary a, Ord a) => Arbitrary (Relation.SymmetricRelation a) where-    arbitrary = Relation.SymmetricRelation <$> arbitraryRelation+instance (Arbitrary a, Ord a) => Arbitrary (SymmetricRelation a) where+    arbitrary = SymmetricRelation <$> arbitraryRelation -instance (Arbitrary a, Ord a) => Arbitrary (Relation.TransitiveRelation a) where-    arbitrary = Relation.TransitiveRelation <$> arbitraryRelation+instance (Arbitrary a, Ord a) => Arbitrary (TransitiveRelation a) where+    arbitrary = TransitiveRelation <$> arbitraryRelation -instance (Arbitrary a, Ord a) => Arbitrary (Relation.PreorderRelation a) where-    arbitrary = Relation.PreorderRelation <$> arbitraryRelation+instance (Arbitrary a, Ord a) => Arbitrary (PreorderRelation a) where+    arbitrary = PreorderRelation <$> arbitraryRelation  instance (Arbitrary a, Ord a) => Arbitrary (AdjacencyMap a) where     arbitrary = arbitraryAdjacencyMap@@ -87,3 +89,16 @@  instance Arbitrary a => Arbitrary (Fold a) where     arbitrary = arbitraryGraph++instance Arbitrary a => Arbitrary (Tree a) where+    arbitrary = sized go+      where+        go 0 = do+            root <- arbitrary+            return $ Node root []+        go n = do+            subTrees <- choose (0, n - 1)+            let subSize = (n - 1) `div` subTrees+            root     <- arbitrary+            children <- replicateM subTrees (go subSize)+            return $ Node root children

@@ -17,6 +17,8 @@   ) where  import Data.Foldable+import Data.Tree+import Data.Tuple  import Algebra.Graph.Fold import Algebra.Graph.Test@@ -34,7 +36,7 @@     putStrLn "\n============ Fold ============"     test "Axioms of graphs"   $ (axioms   :: GraphTestsuite F) -    putStrLn "\n============ Show ============"+    putStrLn "\n============ Fold.Show ============"     test "show (empty     :: Fold Int) == \"empty\"" $           show (empty     :: Fold Int) == "empty" @@ -53,7 +55,7 @@     test "show (1 * 2 + 3 :: Fold Int) == \"graph [1,2,3] [(1,2)]\"" $           show (1 * 2 + 3 :: Fold Int) == "graph [1,2,3] [(1,2)]" -    putStrLn "\n============ empty ============"+    putStrLn "\n============ Fold.empty ============"     test "isEmpty     empty == True" $           isEmpty    (empty :: F) == True @@ -69,7 +71,7 @@     test "size        empty == 1" $           size       (empty :: F) == 1 -    putStrLn "\n============ vertex ============"+    putStrLn "\n============ Fold.vertex ============"     test "isEmpty     (vertex x) == False" $ \(x :: Int) ->           isEmpty     (vertex x) == False @@ -88,7 +90,7 @@     test "size        (vertex x) == 1" $ \(x :: Int) ->           size        (vertex x) == 1 -    putStrLn "\n============ edge ============"+    putStrLn "\n============ Fold.edge ============"     test "edge x y               == connect (vertex x) (vertex y)" $ \(x :: Int) y ->          (edge x y :: F)         == connect (vertex x) (vertex y) @@ -104,7 +106,7 @@     test "vertexCount (edge 1 2) == 2" $           vertexCount (edge 1 2 :: F) == 2 -    putStrLn "\n============ overlay ============"+    putStrLn "\n============ Fold.overlay ============"     test "isEmpty     (overlay x y) == isEmpty   x   && isEmpty   y" $ \(x :: F) y ->           isEmpty     (overlay x y) == (isEmpty   x   && isEmpty   y) @@ -132,7 +134,7 @@     test "edgeCount   (overlay 1 2) == 0" $           edgeCount   (overlay 1 2 :: F) == 0 -    putStrLn "\n============ connect ============"+    putStrLn "\n============ Fold.connect ============"     test "isEmpty     (connect x y) == isEmpty   x   && isEmpty   y" $ \(x :: F) y ->           isEmpty     (connect x y) == (isEmpty   x   && isEmpty   y) @@ -166,7 +168,7 @@     test "edgeCount   (connect 1 2) == 1" $           edgeCount   (connect 1 2 :: F) == 1 -    putStrLn "\n============ vertices ============"+    putStrLn "\n============ Fold.vertices ============"     test "vertices []            == empty" $           vertices []            == (empty :: F) @@ -182,7 +184,7 @@     test "vertexSet   . vertices == Set.fromList" $ \(xs :: [Int]) ->          (vertexSet   . vertices) xs == Set.fromList xs -    putStrLn "\n============ edges ============"+    putStrLn "\n============ Fold.edges ============"     test "edges []          == empty" $           edges []          == (empty :: F) @@ -192,7 +194,7 @@     test "edgeCount . edges == length . nub" $ \(xs :: [(Int, Int)]) ->          (edgeCount . edges) xs == (length . nubOrd) xs -    putStrLn "\n============ overlays ============"+    putStrLn "\n============ Fold.overlays ============"     test "overlays []        == empty" $           overlays []        == (empty :: F) @@ -205,7 +207,7 @@     test "isEmpty . overlays == all isEmpty" $ \(xs :: [F]) ->          (isEmpty . overlays) xs == all isEmpty xs -    putStrLn "\n============ connects ============"+    putStrLn "\n============ Fold.connects ============"     test "connects []        == empty" $           connects []        == (empty :: F) @@ -218,7 +220,7 @@     test "isEmpty . connects == all isEmpty" $ \(xs :: [F]) ->          (isEmpty . connects) xs == all isEmpty xs -    putStrLn "\n============ graph ============"+    putStrLn "\n============ Fold.graph ============"     test "graph []  []      == empty" $           graph []  []      == (empty :: F) @@ -231,7 +233,7 @@     test "graph vs  es      == overlay (vertices vs) (edges es)" $ \(vs :: [Int]) es ->           graph vs  es      == (overlay (vertices vs) (edges es) :: F) -    putStrLn "\n============ foldg ============"+    putStrLn "\n============ Fold.foldg ============"     test "foldg empty vertex        overlay connect        == id" $ \(x :: F) ->           foldg empty vertex        overlay connect x      == x @@ -250,7 +252,7 @@     test "foldg True  (const False) (&&)    (&&)           == isEmpty" $ \(x :: F) ->           foldg True  (const False) (&&)    (&&) x         == isEmpty x -    putStrLn "\n============ isSubgraphOf ============"+    putStrLn "\n============ Fold.isSubgraphOf ============"     test "isSubgraphOf empty         x             == True" $ \(x :: F) ->           isSubgraphOf empty         x             == True @@ -266,7 +268,7 @@     test "isSubgraphOf (path xs)     (circuit xs)  == True" $ \xs ->           isSubgraphOf (path xs :: F)(circuit xs)  == True -    putStrLn "\n============ isEmpty ============"+    putStrLn "\n============ Fold.isEmpty ============"     test "isEmpty empty                       == True" $           isEmpty (empty :: F)                == True @@ -282,7 +284,7 @@     test "isEmpty (removeEdge x y $ edge x y) == False" $ \(x :: Int) y ->           isEmpty (removeEdge x y $ edge x y) == False -    putStrLn "\n============ size ============"+    putStrLn "\n============ Fold.size ============"     test "size empty         == 1" $           size (empty :: F)  == 1 @@ -301,7 +303,7 @@     test "size x             >= vertexCount x" $ \(x :: F) ->           size x             >= vertexCount x -    putStrLn "\n============ hasVertex ============"+    putStrLn "\n============ Fold.hasVertex ============"     test "hasVertex x empty            == False" $ \(x :: Int) ->           hasVertex x empty            == False @@ -311,7 +313,7 @@     test "hasVertex x . removeVertex x == const False" $ \(x :: Int) y ->           hasVertex x (removeVertex x y)==const False y -    putStrLn "\n============ hasEdge ============"+    putStrLn "\n============ Fold.hasEdge ============"     test "hasEdge x y empty            == False" $ \(x :: Int) y ->           hasEdge x y empty            == False @@ -324,7 +326,7 @@     test "hasEdge x y . removeEdge x y == const False" $ \(x :: Int) y z ->           hasEdge x y (removeEdge x y z)==const False z -    putStrLn "\n============ vertexCount ============"+    putStrLn "\n============ Fold.vertexCount ============"     test "vertexCount empty      == 0" $           vertexCount (empty :: F) == 0 @@ -334,7 +336,7 @@     test "vertexCount            == length . vertexList" $ \(x :: F) ->           vertexCount x          == (length . vertexList) x -    putStrLn "\n============ edgeCount ============"+    putStrLn "\n============ Fold.edgeCount ============"     test "edgeCount empty      == 0" $           edgeCount (empty :: F) == 0 @@ -347,7 +349,7 @@     test "edgeCount            == length . edgeList" $ \(x :: F) ->           edgeCount x          == (length . edgeList) x -    putStrLn "\n============ vertexList ============"+    putStrLn "\n============ Fold.vertexList ============"     test "vertexList empty      == []" $           vertexList (empty :: F) == [] @@ -357,7 +359,7 @@     test "vertexList . vertices == nub . sort" $ \(xs :: [Int]) ->          (vertexList . vertices) xs == (nubOrd . sort) xs -    putStrLn "\n============ edgeList ============"+    putStrLn "\n============ Fold.edgeList ============"     test "edgeList empty          == []" $           edgeList (empty :: F )  == [] @@ -373,7 +375,7 @@     test "edgeList . edges        == nub . sort" $ \(xs :: [(Int, Int)]) ->          (edgeList . edges) xs    == (nubOrd . sort) xs -    putStrLn "\n============ vertexSet ============"+    putStrLn "\n============ Fold.vertexSet ============"     test "vertexSet empty      == Set.empty" $           vertexSet(empty :: F)== Set.empty @@ -386,7 +388,7 @@     test "vertexSet . clique   == Set.fromList" $ \(xs :: [Int]) ->          (vertexSet . clique) xs == Set.fromList xs -    putStrLn "\n============ vertexIntSet ============"+    putStrLn "\n============ Fold.vertexIntSet ============"     test "vertexIntSet empty      == IntSet.empty" $           vertexIntSet(empty :: F)== IntSet.empty @@ -399,7 +401,7 @@     test "vertexIntSet . clique   == IntSet.fromList" $ \(xs :: [Int]) ->          (vertexIntSet . clique) xs == IntSet.fromList xs -    putStrLn "\n============ edgeSet ============"+    putStrLn "\n============ Fold.edgeSet ============"     test "edgeSet empty      == Set.empty" $           edgeSet (empty :: F) == Set.empty @@ -412,7 +414,7 @@     test "edgeSet . edges    == Set.fromList" $ \(xs :: [(Int, Int)]) ->          (edgeSet . edges) xs== Set.fromList xs -    putStrLn "\n============ path ============"+    putStrLn "\n============ Fold.path ============"     test "path []    == empty" $           path []    == (empty :: F) @@ -422,7 +424,7 @@     test "path [x,y] == edge x y" $ \(x :: Int) y ->           path [x,y] == (edge x y :: F) -    putStrLn "\n============ circuit ============"+    putStrLn "\n============ Fold.circuit ============"     test "circuit []    == empty" $           circuit []    == (empty :: F) @@ -432,7 +434,7 @@     test "circuit [x,y] == edges [(x,y), (y,x)]" $ \(x :: Int) y ->           circuit [x,y] == (edges [(x,y), (y,x)] :: F) -    putStrLn "\n============ clique ============"+    putStrLn "\n============ Fold.clique ============"     test "clique []      == empty" $           clique []      == (empty :: F) @@ -445,20 +447,23 @@     test "clique [x,y,z] == edges [(x,y), (x,z), (y,z)]" $ \(x :: Int) y z ->           clique [x,y,z] == (edges [(x,y), (x,z), (y,z)] :: F) -    putStrLn "\n============ biclique ============"+    putStrLn "\n============ Fold.biclique ============"     test "biclique []      []      == empty" $           biclique []      []      == (empty :: F) -    test "biclique [x]     []      == vertex x" $ \(x :: Int) ->+    test "biclique [x]     []      == vertex x" $ \x ->           biclique [x]     []      == (vertex x :: F) -    test "biclique []      [y]     == vertex y" $ \(y :: Int) ->+    test "biclique []      [y]     == vertex y" $ \y ->           biclique []      [y]     == (vertex y :: F) -    test "biclique [x1,x2] [y1,y2] == edges [(x1,y1), (x1,y2), (x2,y1), (x2,y2)]" $ \(x1 :: Int) x2 y1 y2 ->+    test "biclique [x1,x2] [y1,y2] == edges [(x1,y1), (x1,y2), (x2,y1), (x2,y2)]" $ \x1 x2 y1 y2 ->           biclique [x1,x2] [y1,y2] == (edges [(x1,y1), (x1,y2), (x2,y1), (x2,y2)] :: F) -    putStrLn "\n============ star ============"+    test "biclique xs      ys      == connect (vertices xs) (vertices ys)" $ \xs ys ->+          biclique xs      ys      == (connect (vertices xs) (vertices ys) :: F)++    putStrLn "\n============ Fold.star ============"     test "star x []    == vertex x" $ \(x :: Int) ->           star x []    == (vertex x :: F) @@ -468,7 +473,33 @@     test "star x [y,z] == edges [(x,y), (x,z)]" $ \(x :: Int) y z ->           star x [y,z] == (edges [(x,y), (x,z)] :: F) -    putStrLn "\n============ mesh ============"+    putStrLn "\n============ Fold.tree ============"+    test "tree (Node x [])                                         == vertex x" $ \x ->+          tree (Node x [])                                         ==(vertex x :: F)++    test "tree (Node x [Node y [Node z []]])                       == path [x,y,z]" $ \x y z ->+          tree (Node x [Node y [Node z []]])                       ==(path [x,y,z] :: F)++    test "tree (Node x [Node y [], Node z []])                     == star x [y,z]" $ \x y z ->+          tree (Node x [Node y [], Node z []])                     ==(star x [y,z] :: F)++    test "tree (Node 1 [Node 2 [], Node 3 [Node 4 [], Node 5 []]]) == edges [(1,2), (1,3), (3,4), (3,5)]" $+          tree (Node 1 [Node 2 [], Node 3 [Node 4 [], Node 5 []]]) ==(edges [(1,2), (1,3), (3,4), (3,5)] :: F)++    putStrLn "\n============ Fold.forest ============"+    test "forest []                                                  == empty" $+          forest []                                                  == (empty :: F)++    test "forest [x]                                                 == tree x" $ \x ->+          forest [x]                                                 == (tree x :: F)++    test "forest [Node 1 [Node 2 [], Node 3 []], Node 4 [Node 5 []]] == edges [(1,2), (1,3), (4,5)]" $+          forest [Node 1 [Node 2 [], Node 3 []], Node 4 [Node 5 []]] ==(edges [(1,2), (1,3), (4,5)] :: F)++    test "forest                                                     == overlays . map tree" $ \x ->+         (forest x)                                                  ==((overlays . map tree) x :: F)++    putStrLn "\n============ Fold.mesh ============"     test "mesh xs     []   == empty" $ \xs ->           mesh xs     []   == (empty :: Fold (Int, Int)) @@ -485,7 +516,7 @@          (mesh [1..3] "ab" :: Fold (Int, Char)) == edges [ ((1,'a'),(1,'b')), ((1,'a'),(2,'a')), ((1,'b'),(2,'b')), ((2,'a'),(2,'b'))                                                          , ((2,'a'),(3,'a')), ((2,'b'),(3,'b')), ((3,'a'),(3,'b')) ] -    putStrLn "\n============ torus ============"+    putStrLn "\n============ Fold.torus ============"     test "torus xs    []   == empty" $ \xs ->           torus xs    []   == (empty :: Fold (Int, Int)) @@ -502,28 +533,37 @@          (torus [1,2] "ab" :: Fold (Int, Char)) == edges [ ((1,'a'),(1,'b')), ((1,'a'),(2,'a')), ((1,'b'),(1,'a')), ((1,'b'),(2,'b'))                                                          , ((2,'a'),(1,'a')), ((2,'a'),(2,'b')), ((2,'b'),(1,'b')), ((2,'b'),(2,'a')) ] -    putStrLn "\n============ deBruijn ============"-    test "deBruijn k []    == empty" $ \k ->-          deBruijn k []    == (empty :: Fold [Int])+    putStrLn "\n============ Fold.deBruijn ============"+    test "          deBruijn 0 xs               == edge [] []" $ \(xs :: [Int]) ->+                    deBruijn 0 xs               ==(edge [] [] :: Fold [Int]) -    test "deBruijn 1 [0,1] == edges [ ([0],[0]), ([0],[1]), ([1],[0]), ([1],[1]) ]" $-          deBruijn 1 [0,1] == (edges [ ([0],[0]), ([0],[1]), ([1],[0]), ([1],[1]) ] :: Fold [Int])+    test "n > 0 ==> deBruijn n []               == empty" $ \n ->+          n > 0 ==> deBruijn n []               == (empty :: Fold [Int]) -    test "deBruijn 2 \"0\"   == edge \"00\" \"00\"" $-          deBruijn 2 "0"   == (edge "00" "00" :: Fold String)+    test "          deBruijn 1 [0,1]            == edges [ ([0],[0]), ([0],[1]), ([1],[0]), ([1],[1]) ]" $+                    deBruijn 1 [0,1]            ==(edges [ ([0],[0]), ([0],[1]), ([1],[0]), ([1],[1]) ] :: Fold [Int]) -    test ("deBruijn 2 \"01\"  == <correct result>") $-          (deBruijn 2 "01" :: Fold String) == edges [ ("00","00"), ("00","01"), ("01","10"), ("01","11")-                                                    , ("10","00"), ("10","01"), ("11","10"), ("11","11") ]+    test "          deBruijn 2 \"0\"              == edge \"00\" \"00\"" $+                    deBruijn 2 "0"              ==(edge "00" "00" :: Fold String) -    putStrLn "\n============ removeVertex ============"+    test "          deBruijn 2 \"01\"             == <correct result>" $+                    deBruijn 2 "01"             ==(edges [ ("00","00"), ("00","01"), ("01","10"), ("01","11")+                                                         , ("10","00"), ("10","01"), ("11","10"), ("11","11") ] :: Fold String)++    test "          vertexCount (deBruijn n xs) == (length $ nub xs)^n" $ mapSize (min 5) $ \(NonNegative n) (xs :: [Int]) ->+                    vertexCount (deBruijn n xs) == (length $ nubOrd xs)^n++    test "n > 0 ==> edgeCount   (deBruijn n xs) == (length $ nub xs)^(n + 1)" $ mapSize (min 5) $ \(NonNegative n) (xs :: [Int]) ->+          n > 0 ==> edgeCount   (deBruijn n xs) == (length $ nubOrd xs)^(n + 1)++    putStrLn "\n============ Fold.removeVertex ============"     test "removeVertex x (vertex x)       == empty" $ \(x :: Int) ->           removeVertex x (vertex x)       == (empty :: F)      test "removeVertex x . removeVertex x == removeVertex x" $ \x (y :: F) ->          (removeVertex x . removeVertex x)y==(removeVertex x y :: F) -    putStrLn "\n============ removeEdge ============"+    putStrLn "\n============ Fold.removeEdge ============"     test "removeEdge x y (edge x y)       == vertices [x, y]" $ \(x :: Int) y ->           removeEdge x y (edge x y)       == (vertices [x, y] :: F) @@ -539,7 +579,7 @@     test "removeEdge 1 2 (1 * 1 * 2 * 2)  == 1 * 1 + 2 * 2" $           removeEdge 1 2 (1 * 1 * 2 * 2)  == (1 * 1 + 2 * (2 :: F)) -    putStrLn "\n============ replaceVertex ============"+    putStrLn "\n============ Fold.replaceVertex ============"     test "replaceVertex x x            == id" $ \x (y :: F) ->           replaceVertex x x y          == y @@ -549,7 +589,7 @@     test "replaceVertex x y            == mergeVertices (== x) y" $ \x y z ->           replaceVertex x y z          == (mergeVertices (== x) y z :: F) -    putStrLn "\n============ mergeVertices ============"+    putStrLn "\n============ Fold.mergeVertices ============"     test "mergeVertices (const False) x    == id" $ \x (y :: F) ->           mergeVertices (const False) x y  == y @@ -562,7 +602,7 @@     test "mergeVertices odd  1 (3 + 4 * 5) == 4 * 1" $           mergeVertices odd  1 (3 + 4 * 5) == (4 * 1 :: F) -    putStrLn "\n============ splitVertex ============"+    putStrLn "\n============ Fold.splitVertex ============"     test "splitVertex x []                   == removeVertex x" $ \x (y :: F) ->          (splitVertex x []) y                == (removeVertex x y :: F) @@ -575,7 +615,7 @@     test "splitVertex 1 [0, 1] $ 1 * (2 + 3) == (0 + 1) * (2 + 3)" $          (splitVertex 1 [0, 1] $ 1 * (2 + 3))== ((0 + 1) * (2 + 3 :: F)) -    putStrLn "\n============ transpose ============"+    putStrLn "\n============ Fold.transpose ============"     test "transpose empty       == empty" $           transpose empty       == (empty :: F) @@ -588,7 +628,22 @@     test "transpose . transpose == id" $ \(x :: F) ->          (transpose . transpose) x == x -    putStrLn "\n============ gmap ============"+    test "transpose . path      == path    . reverse" $ \(xs :: [Int]) ->+         (transpose . path) xs  == ((path . reverse) xs :: F)++    test "transpose . circuit   == circuit . reverse" $ \(xs :: [Int]) ->+         (transpose . circuit) xs == ((circuit . reverse) xs :: F)++    test "transpose . clique    == clique  . reverse" $ \(xs :: [Int]) ->+         (transpose . clique) xs == ((clique . reverse) xs :: F)++    test "transpose (box x y)   == box (transpose x) (transpose y)" $ mapSize (min 10) $ \(x :: F) (y :: F) ->+          transpose (box x y)   == (box (transpose x) (transpose y) :: Fold (Int, Int))++    test "edgeList . transpose  == sort . map swap . edgeList" $ \(x :: F) ->+         (edgeList . transpose) x == (sort . map swap . edgeList) x++    putStrLn "\n============ Fold.gmap ============"     test "gmap f empty      == empty" $ \(apply -> f :: II) ->           gmap f empty      == (empty :: F) @@ -604,7 +659,7 @@     test "gmap f . gmap g   == gmap (f . g)" $ \(apply -> f :: II) (apply -> g :: II) (x :: F) ->          (gmap f . gmap g) x== (gmap (f . g) x :: F) -    putStrLn "\n============ bind ============"+    putStrLn "\n============ Fold.bind ============"     test "bind empty f         == empty" $ \(apply -> f :: IF) ->           bind empty f         == empty @@ -626,7 +681,7 @@     test "bind (bind x f) g    == bind x (\\y -> bind (f y) g)" $ mapSize (min 10) $ \x (apply -> f :: IF) (apply -> g :: IF) ->           bind (bind x f) g    == bind x (\y -> bind (f y) g) -    putStrLn "\n============ induce ============"+    putStrLn "\n============ Fold.induce ============"     test "induce (const True)  x      == x" $ \(x :: F) ->           induce (const True)  x      == x @@ -642,14 +697,14 @@     test "isSubgraphOf (induce p x) x == True" $ \(apply -> p :: IB) (x :: F) ->           isSubgraphOf (induce p x) x == True -    putStrLn "\n============ simplify ============"+    putStrLn "\n============ Fold.simplify ============"     test "simplify              == id" $ \(x :: F) ->           simplify x            == x      test "size (simplify x)     <= size x" $ \(x :: F) ->           size (simplify x)     <= size x -    putStrLn "\n============ box ============"+    putStrLn "\n============ Fold.box ============"     let unit = fmap $ \(a, ()) -> a         comm = fmap $ \(a,  b) -> (b, a)     test "box x y             ~~ box y x" $ mapSize (min 10) $ \(x :: F) (y :: F) ->@@ -667,3 +722,9 @@     let assoc = fmap $ \(a, (b, c)) -> ((a, b), c)     test "box x (box y z)     ~~ box (box x y) z" $ mapSize (min 10) $ \(x :: F) (y :: F) (z :: F) ->       assoc (box x (box y z)) == (box (box x y) z :: Fold ((Int, Int), Int))++    test "vertexCount (box x y) == vertexCount x * vertexCount y" $ mapSize (min 10) $ \(x :: F) (y :: F) ->+          vertexCount (box x y) == vertexCount x * vertexCount y++    test "edgeCount   (box x y) <= vertexCount x * edgeCount y + edgeCount x * vertexCount y" $ mapSize (min 10) $ \(x :: F) (y :: F) ->+          edgeCount   (box x y) <= vertexCount x * edgeCount y + edgeCount x * vertexCount y

@@ -17,6 +17,8 @@   ) where  import Data.Foldable+import Data.Tree+import Data.Tuple  import Algebra.Graph import Algebra.Graph.Test@@ -35,7 +37,7 @@     test "Axioms of graphs"   $ (axioms   :: GraphTestsuite G)     test "Theorems of graphs" $ (theorems :: GraphTestsuite G) -    putStrLn "\n============ empty ============"+    putStrLn "\n============ Graph.empty ============"     test "isEmpty     empty == True" $           isEmpty    (empty :: G) == True @@ -51,7 +53,7 @@     test "size        empty == 1" $           size       (empty :: G) == 1 -    putStrLn "\n============ vertex ============"+    putStrLn "\n============ Graph.vertex ============"     test "isEmpty     (vertex x) == False" $ \(x :: Int) ->           isEmpty     (vertex x) == False @@ -70,7 +72,7 @@     test "size        (vertex x) == 1" $ \(x :: Int) ->           size        (vertex x) == 1 -    putStrLn "\n============ edge ============"+    putStrLn "\n============ Graph.edge ============"     test "edge x y               == connect (vertex x) (vertex y)" $ \(x :: Int) y ->           edge x y               == connect (vertex x) (vertex y) @@ -86,7 +88,7 @@     test "vertexCount (edge 1 2) == 2" $           vertexCount (edge 1 2 :: G) == 2 -    putStrLn "\n============ overlay ============"+    putStrLn "\n============ Graph.overlay ============"     test "isEmpty     (overlay x y) == isEmpty   x   && isEmpty   y" $ \(x :: G) y ->           isEmpty     (overlay x y) ==(isEmpty   x   && isEmpty   y) @@ -114,7 +116,7 @@     test "edgeCount   (overlay 1 2) == 0" $           edgeCount   (overlay 1 2 :: G) == 0 -    putStrLn "\n============ connect ============"+    putStrLn "\n============ Graph.connect ============"     test "isEmpty     (connect x y) == isEmpty   x   && isEmpty   y" $ \(x :: G) y ->           isEmpty     (connect x y) ==(isEmpty   x   && isEmpty   y) @@ -148,7 +150,7 @@     test "edgeCount   (connect 1 2) == 1" $           edgeCount   (connect 1 2 :: G) == 1 -    putStrLn "\n============ vertices ============"+    putStrLn "\n============ Graph.vertices ============"     test "vertices []            == empty" $           vertices []            == (empty :: G) @@ -164,7 +166,7 @@     test "vertexSet   . vertices == Set.fromList" $ \(xs :: [Int]) ->          (vertexSet   . vertices) xs == Set.fromList xs -    putStrLn "\n============ edges ============"+    putStrLn "\n============ Graph.edges ============"     test "edges []          == empty" $           edges []          ==(empty :: G) @@ -174,7 +176,7 @@     test "edgeCount . edges == length . nub" $ \(xs :: [(Int, Int)]) ->          (edgeCount . edges) xs == (length . nubOrd) xs -    putStrLn "\n============ overlays ============"+    putStrLn "\n============ Graph.overlays ============"     test "overlays []        == empty" $           overlays []        ==(empty :: G) @@ -187,7 +189,7 @@     test "isEmpty . overlays == all isEmpty" $ \(xs :: [G]) ->          (isEmpty . overlays) xs == all isEmpty xs -    putStrLn "\n============ connects ============"+    putStrLn "\n============ Graph.connects ============"     test "connects []        == empty" $           connects []        ==(empty :: G) @@ -200,7 +202,7 @@     test "isEmpty . connects == all isEmpty" $ \(xs :: [G]) ->          (isEmpty . connects) xs == all isEmpty xs -    putStrLn "\n============ graph ============"+    putStrLn "\n============ Graph.graph ============"     test "graph []  []      == empty" $           graph []  []      ==(empty :: G) @@ -213,7 +215,7 @@     test "graph vs  es      == overlay (vertices vs) (edges es)" $ \(vs :: [Int]) es ->           graph vs  es      == overlay (vertices vs) (edges es) -    putStrLn "\n============ foldg ============"+    putStrLn "\n============ Graph.foldg ============"     test "foldg empty vertex        overlay connect        == id" $ \(x :: G) ->           foldg empty vertex        overlay connect x      == x @@ -232,7 +234,7 @@     test "foldg True  (const False) (&&)    (&&)           == isEmpty" $ \(x :: G) ->           foldg True  (const False) (&&)    (&&) x         == isEmpty x -    putStrLn "\n============ isSubgraphOf ============"+    putStrLn "\n============ Graph.isSubgraphOf ============"     test "isSubgraphOf empty         x             == True" $ \(x :: G) ->           isSubgraphOf empty         x             == True @@ -248,7 +250,7 @@     test "isSubgraphOf (path xs)     (circuit xs)  == True" $ \xs ->           isSubgraphOf (path xs :: G)(circuit xs)  == True -    putStrLn "\n============ (===) ============"+    putStrLn "\n============ Graph.(===) ============"     test "    x === x         == True" $ \(x :: G) ->              (x === x)        == True @@ -264,7 +266,7 @@     test "x + y === x * y     == False" $ \(x :: G) y ->          (x + y === x * y)    == False -    putStrLn "\n============ isEmpty ============"+    putStrLn "\n============ Graph.isEmpty ============"     test "isEmpty empty                       == True" $           isEmpty (empty :: G)                == True @@ -280,7 +282,7 @@     test "isEmpty (removeEdge x y $ edge x y) == False" $ \(x :: Int) y ->           isEmpty (removeEdge x y $ edge x y) == False -    putStrLn "\n============ size ============"+    putStrLn "\n============ Graph.size ============"     test "size empty         == 1" $           size (empty :: G)  == 1 @@ -299,7 +301,7 @@     test "size x             >= vertexCount x" $ \(x :: G) ->           size x             >= vertexCount x -    putStrLn "\n============ hasVertex ============"+    putStrLn "\n============ Graph.hasVertex ============"     test "hasVertex x empty            == False" $ \(x :: Int) ->           hasVertex x empty            == False @@ -309,7 +311,7 @@     test "hasVertex x . removeVertex x == const False" $ \(x :: Int) y ->           hasVertex x (removeVertex x y)==const False y -    putStrLn "\n============ hasEdge ============"+    putStrLn "\n============ Graph.hasEdge ============"     test "hasEdge x y empty            == False" $ \(x :: Int) y ->           hasEdge x y empty            == False @@ -322,7 +324,7 @@     test "hasEdge x y . removeEdge x y == const False" $ \(x :: Int) y z ->           hasEdge x y (removeEdge x y z)==const False z -    putStrLn "\n============ vertexCount ============"+    putStrLn "\n============ Graph.vertexCount ============"     test "vertexCount empty      == 0" $           vertexCount (empty :: G) == 0 @@ -332,7 +334,7 @@     test "vertexCount            == length . vertexList" $ \(x :: G) ->           vertexCount x          ==(length . vertexList) x -    putStrLn "\n============ edgeCount ============"+    putStrLn "\n============ Graph.edgeCount ============"     test "edgeCount empty      == 0" $           edgeCount (empty :: G) == 0 @@ -345,7 +347,7 @@     test "edgeCount            == length . edgeList" $ \(x :: G) ->           edgeCount x          == (length . edgeList) x -    putStrLn "\n============ vertexList ============"+    putStrLn "\n============ Graph.vertexList ============"     test "vertexList empty      == []" $           vertexList (empty :: G) == [] @@ -355,7 +357,7 @@     test "vertexList . vertices == nub . sort" $ \(xs :: [Int]) ->          (vertexList . vertices) xs == (nubOrd . sort) xs -    putStrLn "\n============ edgeList ============"+    putStrLn "\n============ Graph.edgeList ============"     test "edgeList empty          == []" $           edgeList (empty :: G )  == [] @@ -371,7 +373,7 @@     test "edgeList . edges        == nub . sort" $ \(xs :: [(Int, Int)]) ->          (edgeList . edges) xs    ==(nubOrd . sort) xs -    putStrLn "\n============ vertexSet ============"+    putStrLn "\n============ Graph.vertexSet ============"     test "vertexSet empty      == Set.empty" $           vertexSet(empty :: G)== Set.empty @@ -384,7 +386,7 @@     test "vertexSet . clique   == Set.fromList" $ \(xs :: [Int]) ->          (vertexSet . clique) xs == Set.fromList xs -    putStrLn "\n============ vertexIntSet ============"+    putStrLn "\n============ Graph.vertexIntSet ============"     test "vertexIntSet empty      == IntSet.empty" $           vertexIntSet(empty :: G)== IntSet.empty @@ -397,7 +399,7 @@     test "vertexIntSet . clique   == IntSet.fromList" $ \(xs :: [Int]) ->          (vertexIntSet . clique) xs == IntSet.fromList xs -    putStrLn "\n============ edgeSet ============"+    putStrLn "\n============ Graph.edgeSet ============"     test "edgeSet empty      == Set.empty" $           edgeSet (empty :: G) == Set.empty @@ -410,7 +412,7 @@     test "edgeSet . edges    == Set.fromList" $ \(xs :: [(Int, Int)]) ->          (edgeSet . edges) xs== Set.fromList xs -    putStrLn "\n============ path ============"+    putStrLn "\n============ Graph.path ============"     test "path []    == empty" $           path []    ==(empty :: G) @@ -420,7 +422,7 @@     test "path [x,y] == edge x y" $ \(x :: Int) y ->           path [x,y] == edge x y -    putStrLn "\n============ circuit ============"+    putStrLn "\n============ Graph.circuit ============"     test "circuit []    == empty" $           circuit []    ==(empty :: G) @@ -430,7 +432,7 @@     test "circuit [x,y] == edges [(x,y), (y,x)]" $ \(x :: Int) y ->           circuit [x,y] == edges [(x,y), (y,x)] -    putStrLn "\n============ clique ============"+    putStrLn "\n============ Graph.clique ============"     test "clique []      == empty" $           clique []      ==(empty :: G) @@ -443,7 +445,7 @@     test "clique [x,y,z] == edges [(x,y), (x,z), (y,z)]" $ \(x :: Int) y z ->           clique [x,y,z] == edges [(x,y), (x,z), (y,z)] -    putStrLn "\n============ biclique ============"+    putStrLn "\n============ Graph.biclique ============"     test "biclique []      []      == empty" $           biclique []      []      ==(empty :: G) @@ -456,7 +458,10 @@     test "biclique [x1,x2] [y1,y2] == edges [(x1,y1), (x1,y2), (x2,y1), (x2,y2)]" $ \(x1 :: Int) x2 y1 y2 ->           biclique [x1,x2] [y1,y2] == edges [(x1,y1), (x1,y2), (x2,y1), (x2,y2)] -    putStrLn "\n============ star ============"+    test "biclique xs      ys      == connect (vertices xs) (vertices ys)" $ \(xs :: [Int]) ys ->+          biclique xs      ys      == connect (vertices xs) (vertices ys)++    putStrLn "\n============ Graph.star ============"     test "star x []    == vertex x" $ \(x :: Int) ->           star x []    == vertex x @@ -466,7 +471,33 @@     test "star x [y,z] == edges [(x,y), (x,z)]" $ \(x :: Int) y z ->           star x [y,z] == edges [(x,y), (x,z)] -    putStrLn "\n============ mesh ============"+    putStrLn "\n============ Graph.tree ============"+    test "tree (Node x [])                                         == vertex x" $ \(x :: Int) ->+          tree (Node x [])                                         == vertex x++    test "tree (Node x [Node y [Node z []]])                       == path [x,y,z]" $ \(x :: Int) y z ->+          tree (Node x [Node y [Node z []]])                       == path [x,y,z]++    test "tree (Node x [Node y [], Node z []])                     == star x [y,z]" $ \(x :: Int) y z ->+          tree (Node x [Node y [], Node z []])                     == star x [y,z]++    test "tree (Node 1 [Node 2 [], Node 3 [Node 4 [], Node 5 []]]) == edges [(1,2), (1,3), (3,4), (3,5)]" $+          tree (Node 1 [Node 2 [], Node 3 [Node 4 [], Node 5 []]]) == edges [(1,2), (1,3), (3,4), (3,5::Int)]++    putStrLn "\n============ Graph.forest ============"+    test "forest []                                                  == empty" $+          forest []                                                  == (empty :: G)++    test "forest [x]                                                 == tree x" $ \(x :: Tree Int) ->+          forest [x]                                                 == tree x++    test "forest [Node 1 [Node 2 [], Node 3 []], Node 4 [Node 5 []]] == edges [(1,2), (1,3), (4,5)]" $+          forest [Node 1 [Node 2 [], Node 3 []], Node 4 [Node 5 []]] == edges [(1,2), (1,3), (4,5::Int)]++    test "forest                                                     == overlays . map tree" $ \(x :: Forest Int) ->+         (forest x)                                                  ==(overlays . map tree) x++    putStrLn "\n============ Graph.mesh ============"     test "mesh xs     []   == empty" $ \xs ->           mesh xs     []   == (empty :: Graph (Int, Int)) @@ -483,7 +514,7 @@          mesh [1..3] "ab"  == edges [ ((1,'a'),(1,'b')), ((1,'a'),(2,'a')), ((1,'b'),(2,'b')), ((2,'a'),(2,'b'))                                     , ((2,'a'),(3,'a')), ((2,'b'),(3,'b')), ((3,'a'),(3 :: Int,'b')) ] -    putStrLn "\n============ torus ============"+    putStrLn "\n============ Graph.torus ============"     test "torus xs    []   == empty" $ \xs ->           torus xs    []   == (empty :: Graph (Int, Int)) @@ -500,28 +531,37 @@          torus [1,2] "ab"  == edges [ ((1,'a'),(1,'b')), ((1,'a'),(2,'a')), ((1,'b'),(1,'a')), ((1,'b'),(2,'b'))                                     , ((2,'a'),(1,'a')), ((2,'a'),(2,'b')), ((2,'b'),(1,'b')), ((2,'b'),(2 :: Int,'a')) ] -    putStrLn "\n============ deBruijn ============"-    test "deBruijn k []    == empty" $ \k ->-          deBruijn k []    == (empty :: Graph [Int])+    putStrLn "\n============ Graph.deBruijn ============"+    test "          deBruijn 0 xs               == edge [] []" $ \(xs :: [Int]) ->+                    deBruijn 0 xs               ==(edge [] [] :: Graph [Int]) -    test "deBruijn 1 [0,1] == edges [ ([0],[0]), ([0],[1]), ([1],[0]), ([1],[1]) ]" $-          deBruijn 1 [0,1] == edges [ ([0],[0]), ([0],[1]), ([1],[0]), ([1],[1 :: Int]) ]+    test "n > 0 ==> deBruijn n []               == empty" $ \n ->+          n > 0 ==> deBruijn n []               == (empty :: Graph [Int]) -    test "deBruijn 2 \"0\"   == edge \"00\" \"00\"" $-          deBruijn 2 "0"   == edge "00" "00"+    test "          deBruijn 1 [0,1]            == edges [ ([0],[0]), ([0],[1]), ([1],[0]), ([1],[1]) ]" $+                    deBruijn 1 [0,1::Int]       == edges [ ([0],[0]), ([0],[1]), ([1],[0]), ([1],[1]) ] -    test ("deBruijn 2 \"01\"  == <correct result>") $-          deBruijn 2 "01"  == edges [ ("00","00"), ("00","01"), ("01","10"), ("01","11")-                                    , ("10","00"), ("10","01"), ("11","10"), ("11","11") ]+    test "          deBruijn 2 \"0\"              == edge \"00\" \"00\"" $+                    deBruijn 2 "0"              == edge "00" "00" -    putStrLn "\n============ removeVertex ============"+    test "          deBruijn 2 \"01\"             == <correct result>" $+                    deBruijn 2 "01"             == edges [ ("00","00"), ("00","01"), ("01","10"), ("01","11")+                                                         , ("10","00"), ("10","01"), ("11","10"), ("11","11") ]++    test "          vertexCount (deBruijn n xs) == (length $ nub xs)^n" $ mapSize (min 5) $ \(NonNegative n) (xs :: [Int]) ->+                    vertexCount (deBruijn n xs) == (length $ nubOrd xs)^n++    test "n > 0 ==> edgeCount   (deBruijn n xs) == (length $ nub xs)^(n + 1)" $ mapSize (min 5) $ \(NonNegative n) (xs :: [Int]) ->+          n > 0 ==> edgeCount   (deBruijn n xs) == (length $ nubOrd xs)^(n + 1)++    putStrLn "\n============ Graph.removeVertex ============"     test "removeVertex x (vertex x)       == empty" $ \(x :: Int) ->           removeVertex x (vertex x)       == empty      test "removeVertex x . removeVertex x == removeVertex x" $ \x (y :: G) ->          (removeVertex x . removeVertex x)y==removeVertex x y -    putStrLn "\n============ removeEdge ============"+    putStrLn "\n============ Graph.removeEdge ============"     test "removeEdge x y (edge x y)       == vertices [x, y]" $ \(x :: Int) y ->           removeEdge x y (edge x y)       == vertices [x, y] @@ -537,7 +577,7 @@     test "removeEdge 1 2 (1 * 1 * 2 * 2)  == 1 * 1 + 2 * 2" $           removeEdge 1 2 (1 * 1 * 2 * 2)  ==(1 * 1 + 2 * (2 :: G)) -    putStrLn "\n============ replaceVertex ============"+    putStrLn "\n============ Graph.replaceVertex ============"     test "replaceVertex x x            == id" $ \x (y :: G) ->           replaceVertex x x y          == y @@ -547,7 +587,7 @@     test "replaceVertex x y            == mergeVertices (== x) y" $ \x y z ->           replaceVertex x y z          == mergeVertices (== x) y (z :: G) -    putStrLn "\n============ mergeVertices ============"+    putStrLn "\n============ Graph.mergeVertices ============"     test "mergeVertices (const False) x    == id" $ \x (y :: G) ->           mergeVertices (const False) x y  == y @@ -560,7 +600,7 @@     test "mergeVertices odd  1 (3 + 4 * 5) == 4 * 1" $           mergeVertices odd  1 (3 + 4 * 5) ==(4 * 1 :: G) -    putStrLn "\n============ splitVertex ============"+    putStrLn "\n============ Graph.splitVertex ============"     test "splitVertex x []                   == removeVertex x" $ \x (y :: G) ->          (splitVertex x []) y                == removeVertex x y @@ -573,7 +613,7 @@     test "splitVertex 1 [0, 1] $ 1 * (2 + 3) == (0 + 1) * (2 + 3)" $          (splitVertex 1 [0, 1] $ 1 * (2 + 3))==((0 + 1) * (2 + 3 :: G)) -    putStrLn "\n============ transpose ============"+    putStrLn "\n============ Graph.transpose ============"     test "transpose empty       == empty" $           transpose empty       ==(empty :: G) @@ -586,7 +626,22 @@     test "transpose . transpose == id" $ \(x :: G) ->          (transpose . transpose) x == x -    putStrLn "\n============ fmap ============"+    test "transpose . path      == path    . reverse" $ \(xs :: [Int]) ->+         (transpose . path) xs  == (path . reverse) xs++    test "transpose . circuit   == circuit . reverse" $ \(xs :: [Int]) ->+         (transpose . circuit) xs == (circuit . reverse) xs++    test "transpose . clique    == clique  . reverse" $ \(xs :: [Int]) ->+         (transpose . clique) xs == (clique . reverse) xs++    test "transpose (box x y)   == box (transpose x) (transpose y)" $ mapSize (min 10) $ \(x :: G) (y :: G) ->+          transpose (box x y)   == box (transpose x) (transpose y)++    test "edgeList . transpose  == sort . map swap . edgeList" $ \(x :: G) ->+         (edgeList . transpose) x == (sort . map swap . edgeList) x++    putStrLn "\n============ Graph.fmap ============"     test "fmap f empty      == empty" $ \(apply -> f :: II) ->           fmap f empty      == empty @@ -602,7 +657,7 @@     test "fmap f . fmap g   == fmap (f . g)" $ \(apply -> f :: II) (apply -> g :: II) (x :: G) ->          (fmap f . fmap g) x== fmap (f . g) x -    putStrLn "\n============ >>= ============"+    putStrLn "\n============ Graph.>>= ============"     test "empty >>= f       == empty" $ \(apply -> f :: IG) ->          (empty >>= f)      == empty @@ -624,7 +679,7 @@     test "(x >>= f) >>= g   == x >>= (\\y -> f y >>= g)" $ mapSize (min 10) $ \x (apply -> f :: IG) (apply -> g :: IG) ->          ((x >>= f) >>= g)  ==(x >>= (\y  -> f y >>= g)) -    putStrLn "\n============ induce ============"+    putStrLn "\n============ Graph.induce ============"     test "induce (const True)  x      == x" $ \(x :: G) ->           induce (const True)  x      == x @@ -640,7 +695,7 @@     test "isSubgraphOf (induce p x) x == True" $ \(apply -> p :: IB) (x :: G) ->           isSubgraphOf (induce p x) x == True -    putStrLn "\n============ simplify ============"+    putStrLn "\n============ Graph.simplify ============"     test "simplify              == id" $ \(x :: G) ->           simplify x            == x @@ -662,21 +717,29 @@     test "simplify (1 * 1 * 1) === 1 * 1" $           simplify (1 * 1 * 1) === (1 * 1 :: G) -    putStrLn "\n============ box ============"+    putStrLn "\n============ Graph.box ============"     let unit = fmap $ \(a, ()) -> a         comm = fmap $ \(a,  b) -> (b, a)-    test "box x y             ~~ box y x" $ mapSize (min 10) $ \(x :: G) (y :: G) ->-          comm (box x y)      == box y x+    test "box x y               ~~ box y x" $ mapSize (min 10) $ \(x :: G) (y :: G) ->+          comm (box x y)        == box y x -    test "box x (overlay y z) == overlay (box x y) (box x z)" $ mapSize (min 10) $ \(x :: G) (y :: G) z ->-          box x (overlay y z) == overlay (box x y) (box x z)+    test "box x (overlay y z)   == overlay (box x y) (box x z)" $ mapSize (min 10) $ \(x :: G) (y :: G) z ->+          box x (overlay y z)   == overlay (box x y) (box x z) -    test "box x (vertex ())   ~~ x" $ mapSize (min 10) $ \(x :: G) ->-     unit(box x (vertex ()))  == x+    test "box x (vertex ())     ~~ x" $ mapSize (min 10) $ \(x :: G) ->+     unit(box x (vertex ()))    == x -    test "box x empty         ~~ empty" $ mapSize (min 10) $ \(x :: G) ->-     unit(box x empty)        == empty+    test "box x empty           ~~ empty" $ mapSize (min 10) $ \(x :: G) ->+     unit(box x empty)          == empty      let assoc = fmap $ \(a, (b, c)) -> ((a, b), c)-    test "box x (box y z)     ~~ box (box x y) z" $ mapSize (min 10) $ \(x :: G) (y :: G) (z :: G) ->-      assoc (box x (box y z)) == box (box x y) z+    test "box x (box y z)       ~~ box (box x y) z" $ mapSize (min 10) $ \(x :: G) (y :: G) (z :: G) ->+      assoc (box x (box y z))   == box (box x y) z++    test "vertexCount (box x y) == vertexCount x * vertexCount y" $ mapSize (min 10) $ \(x :: G) (y :: G) ->+          vertexCount (box x y) == vertexCount x * vertexCount y++    test "edgeCount   (box x y) <= vertexCount x * edgeCount y + edgeCount x * vertexCount y" $ mapSize (min 10) $ \(x :: G) (y :: G) ->+          edgeCount   (box x y) <= vertexCount x * edgeCount y + edgeCount x * vertexCount y++

@@ -36,7 +36,7 @@     test "Consistency of fromAdjacencyList" $ \xs ->         consistent (fromAdjacencyList xs) -    putStrLn "\n============ Show ============"+    putStrLn "\n============ IntAdjacencyMap.Show ============"     test "show (empty     :: IntAdjacencyMap) == \"empty\"" $           show (empty     :: IntAdjacencyMap) == "empty" @@ -55,7 +55,7 @@     test "show (1 * 2 + 3 :: IntAdjacencyMap) == \"graph [1,2,3] [(1,2)]\"" $           show (1 * 2 + 3 :: IntAdjacencyMap) == "graph [1,2,3] [(1,2)]" -    putStrLn "\n============ empty ============"+    putStrLn "\n============ IntAdjacencyMap.empty ============"     test "isEmpty     empty == True" $           isEmpty     empty == True @@ -68,7 +68,7 @@     test "edgeCount   empty == 0" $           edgeCount   empty == 0 -    putStrLn "\n============ vertex ============"+    putStrLn "\n============ IntAdjacencyMap.vertex ============"     test "isEmpty     (vertex x) == False" $ \x ->           isEmpty     (vertex x) == False @@ -84,7 +84,7 @@     test "edgeCount   (vertex x) == 0" $ \x ->           edgeCount   (vertex x) == 0 -    putStrLn "\n============ edge ============"+    putStrLn "\n============ IntAdjacencyMap.edge ============"     test "edge x y               == connect (vertex x) (vertex y)" $ \x y ->           edge x y               == connect (vertex x) (vertex y) @@ -100,7 +100,7 @@     test "vertexCount (edge 1 2) == 2" $           vertexCount (edge 1 2) == 2 -    putStrLn "\n============ overlay ============"+    putStrLn "\n============ IntAdjacencyMap.overlay ============"     test "isEmpty     (overlay x y) == isEmpty   x   && isEmpty   y" $ \x y ->           isEmpty     (overlay x y) == (isEmpty  x   && isEmpty   y) @@ -125,7 +125,7 @@     test "edgeCount   (overlay 1 2) == 0" $           edgeCount   (overlay 1 2) == 0 -    putStrLn "\n============ connect ============"+    putStrLn "\n============ IntAdjacencyMap.connect ============"     test "isEmpty     (connect x y) == isEmpty   x   && isEmpty   y" $ \x y ->           isEmpty     (connect x y) == (isEmpty  x   && isEmpty   y) @@ -156,7 +156,7 @@     test "edgeCount   (connect 1 2) == 1" $           edgeCount   (connect 1 2) == 1 -    putStrLn "\n============ vertices ============"+    putStrLn "\n============ IntAdjacencyMap.vertices ============"     test "vertices []            == empty" $           vertices []            == empty @@ -172,7 +172,7 @@     test "vertexSet   . vertices == IntSet.fromList" $ \xs ->          (vertexSet   . vertices) xs == IntSet.fromList xs -    putStrLn "\n============ edges ============"+    putStrLn "\n============ IntAdjacencyMap.edges ============"     test "edges []          == empty" $           edges []          ==  empty @@ -182,7 +182,7 @@     test "edgeCount . edges == length . nub" $ \xs ->          (edgeCount . edges) xs == (length . nubOrd) xs -    putStrLn "\n============ overlays ============"+    putStrLn "\n============ IntAdjacencyMap.overlays ============"     test "overlays []        == empty" $           overlays []        == empty @@ -195,7 +195,7 @@     test "isEmpty . overlays == all isEmpty" $ mapSize (min 10) $ \xs ->          (isEmpty . overlays) xs == all isEmpty xs -    putStrLn "\n============ connects ============"+    putStrLn "\n============ IntAdjacencyMap.connects ============"     test "connects []        == empty" $           connects []        == empty @@ -208,7 +208,7 @@     test "isEmpty . connects == all isEmpty" $ mapSize (min 10) $ \xs ->          (isEmpty . connects) xs == all isEmpty xs -    putStrLn "\n============ graph ============"+    putStrLn "\n============ IntAdjacencyMap.graph ============"     test "graph []  []      == empty" $           graph []  []      == empty @@ -221,7 +221,7 @@     test "graph vs  es      == overlay (vertices vs) (edges es)" $ \(vs :: [Int]) es ->           graph vs  es      == overlay (vertices vs) (edges es) -    putStrLn "\n============ fromAdjacencyList ============"+    putStrLn "\n============ IntAdjacencyMap.fromAdjacencyList ============"     test "fromAdjacencyList []                                  == empty" $           fromAdjacencyList []                                  == empty @@ -237,7 +237,7 @@     test "overlay (fromAdjacencyList xs) (fromAdjacencyList ys) == fromAdjacencyList (xs ++ ys)" $ \xs ys ->           overlay (fromAdjacencyList xs) (fromAdjacencyList ys) == fromAdjacencyList (xs ++ ys) -    putStrLn "\n============ isSubgraphOf ============"+    putStrLn "\n============ IntAdjacencyMap.isSubgraphOf ============"     test "isSubgraphOf empty         x             == True" $ \x ->           isSubgraphOf empty         x             == True @@ -253,7 +253,7 @@     test "isSubgraphOf (path xs)     (circuit xs)  == True" $ \xs ->           isSubgraphOf (path xs)     (circuit xs)  == True -    putStrLn "\n============ isEmpty ============"+    putStrLn "\n============ IntAdjacencyMap.isEmpty ============"     test "isEmpty empty                       == True" $           isEmpty empty                       == True @@ -269,7 +269,7 @@     test "isEmpty (removeEdge x y $ edge x y) == False" $ \x y ->           isEmpty (removeEdge x y $ edge x y) == False -    putStrLn "\n============ hasVertex ============"+    putStrLn "\n============ IntAdjacencyMap.hasVertex ============"     test "hasVertex x empty            == False" $ \x ->           hasVertex x empty            == False @@ -279,7 +279,7 @@     test "hasVertex x . removeVertex x == const False" $ \x y ->           hasVertex x (removeVertex x y)==const False y -    putStrLn "\n============ hasEdge ============"+    putStrLn "\n============ IntAdjacencyMap.hasEdge ============"     test "hasEdge x y empty            == False" $ \x y ->           hasEdge x y empty            == False @@ -292,7 +292,7 @@     test "hasEdge x y . removeEdge x y == const False" $ \x y z ->           hasEdge x y (removeEdge x y z)==const False z -    putStrLn "\n============ vertexCount ============"+    putStrLn "\n============ IntAdjacencyMap.vertexCount ============"     test "vertexCount empty      == 0" $           vertexCount empty      == 0 @@ -302,7 +302,7 @@     test "vertexCount            == length . vertexList" $ \x ->           vertexCount x          == (length . vertexList) x -    putStrLn "\n============ edgeCount ============"+    putStrLn "\n============ IntAdjacencyMap.edgeCount ============"     test "edgeCount empty      == 0" $           edgeCount empty      == 0 @@ -315,7 +315,7 @@     test "edgeCount            == length . edgeList" $ \x ->           edgeCount x          == (length . edgeList) x -    putStrLn "\n============ vertexList ============"+    putStrLn "\n============ IntAdjacencyMap.vertexList ============"     test "vertexList empty      == []" $           vertexList empty      == [] @@ -325,7 +325,7 @@     test "vertexList . vertices == nub . sort" $ \xs ->          (vertexList . vertices) xs == (nubOrd . sort) xs -    putStrLn "\n============ edgeList ============"+    putStrLn "\n============ IntAdjacencyMap.edgeList ============"     test "edgeList empty          == []" $           edgeList empty          == [] @@ -341,7 +341,7 @@     test "edgeList . edges        == nub . sort" $ \xs ->          (edgeList . edges) xs    == (nubOrd . sort) xs -    putStrLn "\n============ adjacencyList ============"+    putStrLn "\n============ IntAdjacencyMap.adjacencyList ============"     test "adjacencyList empty          == []" $           adjacencyList empty          == [] @@ -354,7 +354,7 @@     test "adjacencyList (star 2 [3,1]) == [(1, []), (2, [1,3]), (3, [])]" $           adjacencyList (star 2 [3,1]) == [(1, []), (2, [1,3]), (3, [])] -    putStrLn "\n============ vertexSet ============"+    putStrLn "\n============ IntAdjacencyMap.vertexSet ============"     test "vertexSet empty      == IntSet.empty" $           vertexSet empty      == IntSet.empty @@ -367,7 +367,7 @@     test "vertexSet . clique   == IntSet.fromList" $ \xs ->          (vertexSet . clique) xs == IntSet.fromList xs -    putStrLn "\n============ edgeSet ============"+    putStrLn "\n============ IntAdjacencyMap.edgeSet ============"     test "edgeSet empty      == Set.empty" $           edgeSet empty      == Set.empty @@ -380,7 +380,7 @@     test "edgeSet . edges    == Set.fromList" $ \xs ->          (edgeSet . edges) xs== Set.fromList xs -    putStrLn "\n============ postset ============"+    putStrLn "\n============ IntAdjacencyMap.postset ============"     test "postset x empty      == IntSet.empty" $ \x ->           postset x empty      == IntSet.empty @@ -393,7 +393,7 @@     test "postset 2 (edge 1 2) == IntSet.empty" $           postset 2 (edge 1 2) == IntSet.empty -    putStrLn "\n============ path ============"+    putStrLn "\n============ IntAdjacencyMap.path ============"     test "path []    == empty" $           path []    == empty @@ -403,7 +403,7 @@     test "path [x,y] == edge x y" $ \x y ->           path [x,y] == edge x y -    putStrLn "\n============ circuit ============"+    putStrLn "\n============ IntAdjacencyMap.circuit ============"     test "circuit []    == empty" $           circuit []    == empty @@ -413,7 +413,7 @@     test "circuit [x,y] == edges [(x,y), (y,x)]" $ \x y ->           circuit [x,y] == edges [(x,y), (y,x)] -    putStrLn "\n============ clique ============"+    putStrLn "\n============ IntAdjacencyMap.clique ============"     test "clique []      == empty" $           clique []      == empty @@ -426,7 +426,7 @@     test "clique [x,y,z] == edges [(x,y), (x,z), (y,z)]" $ \x y z ->           clique [x,y,z] == edges [(x,y), (x,z), (y,z)] -    putStrLn "\n============ biclique ============"+    putStrLn "\n============ IntAdjacencyMap.biclique ============"     test "biclique []      []      == empty" $           biclique []      []      == empty @@ -439,7 +439,10 @@     test "biclique [x1,x2] [y1,y2] == edges [(x1,y1), (x1,y2), (x2,y1), (x2,y2)]" $ \(x1) x2 y1 y2 ->           biclique [x1,x2] [y1,y2] == edges [(x1,y1), (x1,y2), (x2,y1), (x2,y2)] -    putStrLn "\n============ star ============"+    test "biclique xs      ys      == connect (vertices xs) (vertices ys)" $ \xs ys ->+          biclique xs      ys      == connect (vertices xs) (vertices ys)++    putStrLn "\n============ IntAdjacencyMap.star ============"     test "star x []    == vertex x" $ \x ->           star x []    == vertex x @@ -449,14 +452,40 @@     test "star x [y,z] == edges [(x,y), (x,z)]" $ \x y z ->           star x [y,z] == edges [(x,y), (x,z)] -    putStrLn "\n============ removeVertex ============"+    putStrLn "\n============ IntAdjacencyMap.tree ============"+    test "tree (Node x [])                                         == vertex x" $ \x ->+          tree (Node x [])                                         == vertex x++    test "tree (Node x [Node y [Node z []]])                       == path [x,y,z]" $ \x y z ->+          tree (Node x [Node y [Node z []]])                       == path [x,y,z]++    test "tree (Node x [Node y [], Node z []])                     == star x [y,z]" $ \x y z ->+          tree (Node x [Node y [], Node z []])                     == star x [y,z]++    test "tree (Node 1 [Node 2 [], Node 3 [Node 4 [], Node 5 []]]) == edges [(1,2), (1,3), (3,4), (3,5)]" $+          tree (Node 1 [Node 2 [], Node 3 [Node 4 [], Node 5 []]]) == edges [(1,2), (1,3), (3,4), (3,5)]++    putStrLn "\n============ IntAdjacencyMap.forest ============"+    test "forest []                                                  == empty" $+          forest []                                                  == empty++    test "forest [x]                                                 == tree x" $ \x ->+          forest [x]                                                 == tree x++    test "forest [Node 1 [Node 2 [], Node 3 []], Node 4 [Node 5 []]] == edges [(1,2), (1,3), (4,5)]" $+          forest [Node 1 [Node 2 [], Node 3 []], Node 4 [Node 5 []]] == edges [(1,2), (1,3), (4,5)]++    test "forest                                                     == overlays . map tree" $ \x ->+         (forest x)                                                  ==(overlays . map tree) x++    putStrLn "\n============ IntAdjacencyMap.removeVertex ============"     test "removeVertex x (vertex x)       == empty" $ \x ->           removeVertex x (vertex x)       == empty      test "removeVertex x . removeVertex x == removeVertex x" $ \x (y) ->          (removeVertex x . removeVertex x)y==removeVertex x y -    putStrLn "\n============ removeEdge ============"+    putStrLn "\n============ IntAdjacencyMap.removeEdge ============"     test "removeEdge x y (edge x y)       == vertices [x, y]" $ \x y ->           removeEdge x y (edge x y)       == vertices [x, y] @@ -472,7 +501,7 @@     test "removeEdge 1 2 (1 * 1 * 2 * 2)  == 1 * 1 + 2 * 2" $           removeEdge 1 2 (1 * 1 * 2 * 2)  == 1 * 1 + 2 * 2 -    putStrLn "\n============ replaceVertex ============"+    putStrLn "\n============ IntAdjacencyMap.replaceVertex ============"     test "replaceVertex x x            == id" $ \x (y) ->           replaceVertex x x y          == y @@ -482,7 +511,7 @@     test "replaceVertex x y            == mergeVertices (== x) y" $ \x y z ->           replaceVertex x y z          == mergeVertices (== x) y z -    putStrLn "\n============ mergeVertices ============"+    putStrLn "\n============ IntAdjacencyMap.mergeVertices ============"     test "mergeVertices (const False) x    == id" $ \x (y) ->           mergeVertices (const False) x y  == y @@ -495,7 +524,7 @@     test "mergeVertices odd  1 (3 + 4 * 5) == 4 * 1" $           mergeVertices odd  1 (3 + 4 * 5) == 4 * 1 -    putStrLn "\n============ gmap ============"+    putStrLn "\n============ IntAdjacencyMap.gmap ============"     test "gmap f empty      == empty" $ \(apply -> f) ->           gmap f empty      == empty @@ -511,7 +540,7 @@     test "gmap f . gmap g   == gmap (f . g)" $ \(apply -> f) (apply -> g) x ->          (gmap f . gmap g) x== gmap (f . g) x -    putStrLn "\n============ induce ============"+    putStrLn "\n============ IntAdjacencyMap.induce ============"     test "induce (const True)  x      == x" $ \x ->           induce (const True)  x      == x @@ -527,7 +556,7 @@     test "isSubgraphOf (induce p x) x == True" $ \(apply -> p) x ->           isSubgraphOf (induce p x) x == True -    putStrLn "\n============ dfsForest ============"+    putStrLn "\n============ IntAdjacencyMap.dfsForest ============"     test "forest (dfsForest $ edge 1 1)         == vertex 1" $           forest (dfsForest $ edge 1 1)         == vertex 1 @@ -551,7 +580,7 @@                                                    , subForest = [ Node { rootLabel = 4                                                                         , subForest = [] }]}] -    putStrLn "\n============ topSort ============"+    putStrLn "\n============ IntAdjacencyMap.topSort ============"     test "topSort (1 * 2 + 3 * 1)             == Just [3,1,2]" $           topSort (1 * 2 + 3 * 1)             == Just [3,1,2] @@ -561,7 +590,7 @@     test "fmap (flip isTopSort x) (topSort x) /= Just False" $ \x ->           fmap (flip isTopSort x) (topSort x) /= Just False -    putStrLn "\n============ isTopSort  ============"+    putStrLn "\n============ IntAdjacencyMap.isTopSort  ============"     test "isTopSort [3, 1, 2] (1 * 2 + 3 * 1) == True" $           isTopSort [3, 1, 2] (1 * 2 + 3 * 1) == True @@ -580,7 +609,7 @@     test "isTopSort [x]       (edge x x)      == False" $ \x ->           isTopSort [x]       (edge x x)      == False -    putStrLn "\n============ GraphKL ============"+    putStrLn "\n============ IntAdjacencyMap.GraphKL ============"     test "map (getVertex h) (vertices $ getGraph h) == IntSet.toAscList (vertexSet g)"       $ \g -> let h = graphKL g in         map (getVertex h) (KL.vertices $ getGraph h) == IntSet.toAscList (vertexSet g)

@@ -15,9 +15,15 @@     testRelation   ) where +import Data.Tree+import Data.Tuple+ import Algebra.Graph.Relation import Algebra.Graph.Relation.Internal+import Algebra.Graph.Relation.Preorder+import Algebra.Graph.Relation.Reflexive import Algebra.Graph.Relation.Symmetric+import Algebra.Graph.Relation.Transitive import Algebra.Graph.Test  import qualified Algebra.Graph.Class as C@@ -41,7 +47,7 @@     test "Consistency of fromAdjacencyList" $ \xs ->         consistent (fromAdjacencyList xs :: RI) -    putStrLn "\n============ Show ============"+    putStrLn "\n============ Relation.Show ============"     test "show (empty     :: Relation Int) == \"empty\"" $           show (empty     :: Relation Int) == "empty" @@ -60,7 +66,7 @@     test "show (1 * 2 + 3 :: Relation Int) == \"graph [1,2,3] [(1,2)]\"" $           show (1 * 2 + 3 :: Relation Int) == "graph [1,2,3] [(1,2)]" -    putStrLn "\n============ empty ============"+    putStrLn "\n============ Relation.empty ============"     test "isEmpty     empty == True" $           isEmpty    (empty :: RI) == True @@ -73,7 +79,7 @@     test "edgeCount   empty == 0" $           edgeCount  (empty :: RI) == 0 -    putStrLn "\n============ vertex ============"+    putStrLn "\n============ Relation.vertex ============"     test "isEmpty     (vertex x) == False" $ \(x :: Int) ->           isEmpty     (vertex x) == False @@ -89,7 +95,7 @@     test "edgeCount   (vertex x) == 0" $ \(x :: Int) ->           edgeCount   (vertex x) == 0 -    putStrLn "\n============ edge ============"+    putStrLn "\n============ Relation.edge ============"     test "edge x y               == connect (vertex x) (vertex y)" $ \(x :: Int) y ->          (edge x y :: RI)        == connect (vertex x) (vertex y) @@ -105,7 +111,7 @@     test "vertexCount (edge 1 2) == 2" $           vertexCount (edge 1 2 :: RI) == 2 -    putStrLn "\n============ overlay ============"+    putStrLn "\n============ Relation.overlay ============"     test "isEmpty     (overlay x y) == isEmpty   x   && isEmpty   y" $ \(x :: RI) y ->           isEmpty     (overlay x y) == (isEmpty   x   && isEmpty   y) @@ -130,7 +136,7 @@     test "edgeCount   (overlay 1 2) == 0" $           edgeCount   (overlay 1 2 :: RI) == 0 -    putStrLn "\n============ connect ============"+    putStrLn "\n============ Relation.connect ============"     test "isEmpty     (connect x y) == isEmpty   x   && isEmpty   y" $ \(x :: RI) y ->           isEmpty     (connect x y) == (isEmpty   x   && isEmpty   y) @@ -161,7 +167,7 @@     test "edgeCount   (connect 1 2) == 1" $           edgeCount   (connect 1 2 :: RI) == 1 -    putStrLn "\n============ vertices ============"+    putStrLn "\n============ Relation.vertices ============"     test "vertices []            == empty" $           vertices []            == (empty :: RI) @@ -177,7 +183,7 @@     test "vertexSet   . vertices == Set.fromList" $ \(xs :: [Int]) ->          (vertexSet   . vertices) xs == Set.fromList xs -    putStrLn "\n============ edges ============"+    putStrLn "\n============ Relation.edges ============"     test "edges []          == empty" $           edges []          == (empty :: RI) @@ -187,7 +193,7 @@     test "edgeCount . edges == length . nub" $ \(xs :: [(Int, Int)]) ->          (edgeCount . edges) xs == (length . nubOrd) xs -    putStrLn "\n============ overlays ============"+    putStrLn "\n============ Relation.overlays ============"     test "overlays []        == empty" $           overlays []        == (empty :: RI) @@ -200,7 +206,7 @@     test "isEmpty . overlays == all isEmpty" $ mapSize (min 10) $ \(xs :: [RI]) ->          (isEmpty . overlays) xs == all isEmpty xs -    putStrLn "\n============ connects ============"+    putStrLn "\n============ Relation.connects ============"     test "connects []        == empty" $           connects []        == (empty :: RI) @@ -213,7 +219,7 @@     test "isEmpty . connects == all isEmpty" $ mapSize (min 10) $ \(xs :: [RI]) ->          (isEmpty . connects) xs == all isEmpty xs -    putStrLn "\n============ graph ============"+    putStrLn "\n============ Relation.graph ============"     test "graph []  []      == empty" $           graph []  []      == (empty :: RI) @@ -226,7 +232,7 @@     test "graph vs  es      == overlay (vertices vs) (edges es)" $ \(vs :: [Int]) es ->           graph vs  es      == (overlay (vertices vs) (edges es) :: RI) -    putStrLn "\n============ fromAdjacencyList ============"+    putStrLn "\n============ Relation.fromAdjacencyList ============"     test "fromAdjacencyList []                                  == empty" $           fromAdjacencyList []                                  == (empty :: RI) @@ -239,7 +245,7 @@     test "overlay (fromAdjacencyList xs) (fromAdjacencyList ys) == fromAdjacencyList (xs ++ ys)" $ \xs ys ->           overlay (fromAdjacencyList xs) (fromAdjacencyList ys) ==(fromAdjacencyList (xs ++ ys) :: RI) -    putStrLn "\n============ isSubgraphOf ============"+    putStrLn "\n============ Relation.isSubgraphOf ============"     test "isSubgraphOf empty         x             == True" $ \(x :: RI) ->           isSubgraphOf empty         x             == True @@ -255,7 +261,7 @@     test "isSubgraphOf (path xs)     (circuit xs)  == True" $ \xs ->           isSubgraphOf (path xs :: RI)(circuit xs)  == True -    putStrLn "\n============ isEmpty ============"+    putStrLn "\n============ Relation.isEmpty ============"     test "isEmpty empty                       == True" $           isEmpty (empty :: RI)                == True @@ -271,7 +277,7 @@     test "isEmpty (removeEdge x y $ edge x y) == False" $ \(x :: Int) y ->           isEmpty (removeEdge x y $ edge x y) == False -    putStrLn "\n============ hasVertex ============"+    putStrLn "\n============ Relation.hasVertex ============"     test "hasVertex x empty            == False" $ \(x :: Int) ->           hasVertex x empty            == False @@ -281,7 +287,7 @@     test "hasVertex x . removeVertex x == const False" $ \(x :: Int) y ->           hasVertex x (removeVertex x y)==const False y -    putStrLn "\n============ hasEdge ============"+    putStrLn "\n============ Relation.hasEdge ============"     test "hasEdge x y empty            == False" $ \(x :: Int) y ->           hasEdge x y empty            == False @@ -294,7 +300,7 @@     test "hasEdge x y . removeEdge x y == const False" $ \(x :: Int) y z ->           hasEdge x y (removeEdge x y z)==const False z -    putStrLn "\n============ vertexCount ============"+    putStrLn "\n============ Relation.vertexCount ============"     test "vertexCount empty      == 0" $           vertexCount (empty :: RI) == 0 @@ -304,7 +310,7 @@     test "vertexCount            == length . vertexList" $ \(x :: RI) ->           vertexCount x          == (length . vertexList) x -    putStrLn "\n============ edgeCount ============"+    putStrLn "\n============ Relation.edgeCount ============"     test "edgeCount empty      == 0" $           edgeCount (empty :: RI) == 0 @@ -317,7 +323,7 @@     test "edgeCount            == length . edgeList" $ \(x :: RI) ->           edgeCount x          == (length . edgeList) x -    putStrLn "\n============ vertexList ============"+    putStrLn "\n============ Relation.vertexList ============"     test "vertexList empty      == []" $           vertexList (empty :: RI) == [] @@ -327,7 +333,7 @@     test "vertexList . vertices == nub . sort" $ \(xs :: [Int]) ->          (vertexList . vertices) xs == (nubOrd . sort) xs -    putStrLn "\n============ edgeList ============"+    putStrLn "\n============ Relation.edgeList ============"     test "edgeList empty          == []" $           edgeList (empty :: RI )  == [] @@ -343,7 +349,7 @@     test "edgeList . edges        == nub . sort" $ \(xs :: [(Int, Int)]) ->          (edgeList . edges) xs    == (nubOrd . sort) xs -    putStrLn "\n============ vertexSet ============"+    putStrLn "\n============ Relation.vertexSet ============"     test "vertexSet empty      == Set.empty" $           vertexSet(empty :: RI)== Set.empty @@ -356,7 +362,7 @@     test "vertexSet . clique   == Set.fromList" $ \(xs :: [Int]) ->          (vertexSet . clique) xs == Set.fromList xs -    putStrLn "\n============ edgeSet ============"+    putStrLn "\n============ Relation.edgeSet ============"     test "edgeSet empty      == Set.empty" $           edgeSet (empty :: RI) == Set.empty @@ -369,7 +375,7 @@     test "edgeSet . edges    == Set.fromList" $ \(xs :: [(Int, Int)]) ->          (edgeSet . edges) xs== Set.fromList xs -    putStrLn "\n============ preset ============"+    putStrLn "\n============ Relation.preset ============"     test "preset x empty      == Set.empty" $ \(x :: Int) ->           preset x empty      == Set.empty @@ -382,7 +388,7 @@     test "preset y (edge x y) == Set.fromList [x]" $ \(x :: Int) y ->           preset y (edge x y) ==(Set.fromList [x] :: Set.Set Int) -    putStrLn "\n============ postset ============"+    putStrLn "\n============ Relation.postset ============"     test "postset x empty      == Set.empty" $ \(x :: Int) ->           postset x empty      == Set.empty @@ -395,7 +401,7 @@     test "postset 2 (edge 1 2) == Set.empty" $           postset 2 (edge 1 2) ==(Set.empty :: Set.Set Int) -    putStrLn "\n============ path ============"+    putStrLn "\n============ Relation.path ============"     test "path []    == empty" $           path []    == (empty :: RI) @@ -405,7 +411,7 @@     test "path [x,y] == edge x y" $ \(x :: Int) y ->           path [x,y] == (edge x y :: RI) -    putStrLn "\n============ circuit ============"+    putStrLn "\n============ Relation.circuit ============"     test "circuit []    == empty" $           circuit []    == (empty :: RI) @@ -415,7 +421,7 @@     test "circuit [x,y] == edges [(x,y), (y,x)]" $ \(x :: Int) y ->           circuit [x,y] == (edges [(x,y), (y,x)] :: RI) -    putStrLn "\n============ clique ============"+    putStrLn "\n============ Relation.clique ============"     test "clique []      == empty" $           clique []      == (empty :: RI) @@ -428,7 +434,7 @@     test "clique [x,y,z] == edges [(x,y), (x,z), (y,z)]" $ \(x :: Int) y z ->           clique [x,y,z] == (edges [(x,y), (x,z), (y,z)] :: RI) -    putStrLn "\n============ biclique ============"+    putStrLn "\n============ Relation.biclique ============"     test "biclique []      []      == empty" $           biclique []      []      == (empty :: RI) @@ -441,7 +447,10 @@     test "biclique [x1,x2] [y1,y2] == edges [(x1,y1), (x1,y2), (x2,y1), (x2,y2)]" $ \(x1 :: Int) x2 y1 y2 ->           biclique [x1,x2] [y1,y2] == (edges [(x1,y1), (x1,y2), (x2,y1), (x2,y2)] :: RI) -    putStrLn "\n============ star ============"+    test "biclique xs      ys      == connect (vertices xs) (vertices ys)" $ \(xs :: [Int]) ys ->+          biclique xs      ys      == connect (vertices xs) (vertices ys)++    putStrLn "\n============ Relation.star ============"     test "star x []    == vertex x" $ \(x :: Int) ->           star x []    == (vertex x :: RI) @@ -451,14 +460,40 @@     test "star x [y,z] == edges [(x,y), (x,z)]" $ \(x :: Int) y z ->           star x [y,z] == (edges [(x,y), (x,z)] :: RI) -    putStrLn "\n============ removeVertex ============"+    putStrLn "\n============ Relation.tree ============"+    test "tree (Node x [])                                         == vertex x" $ \(x :: Int) ->+          tree (Node x [])                                         == vertex x++    test "tree (Node x [Node y [Node z []]])                       == path [x,y,z]" $ \(x :: Int) y z ->+          tree (Node x [Node y [Node z []]])                       == path [x,y,z]++    test "tree (Node x [Node y [], Node z []])                     == star x [y,z]" $ \(x :: Int) y z ->+          tree (Node x [Node y [], Node z []])                     == star x [y,z]++    test "tree (Node 1 [Node 2 [], Node 3 [Node 4 [], Node 5 []]]) == edges [(1,2), (1,3), (3,4), (3,5)]" $+          tree (Node 1 [Node 2 [], Node 3 [Node 4 [], Node 5 []]]) == edges [(1,2), (1,3), (3,4), (3,5::Int)]++    putStrLn "\n============ Relation.forest ============"+    test "forest []                                                  == empty" $+          forest []                                                  == (empty :: RI)++    test "forest [x]                                                 == tree x" $ \(x :: Tree Int) ->+          forest [x]                                                 == tree x++    test "forest [Node 1 [Node 2 [], Node 3 []], Node 4 [Node 5 []]] == edges [(1,2), (1,3), (4,5)]" $+          forest [Node 1 [Node 2 [], Node 3 []], Node 4 [Node 5 []]] == edges [(1,2), (1,3), (4,5::Int)]++    test "forest                                                     == overlays . map tree" $ \(x :: Forest Int) ->+         (forest x)                                                  ==(overlays . map tree) x++    putStrLn "\n============ Relation.removeVertex ============"     test "removeVertex x (vertex x)       == empty" $ \(x :: Int) ->           removeVertex x (vertex x)       == (empty :: RI)      test "removeVertex x . removeVertex x == removeVertex x" $ \x (y :: RI) ->          (removeVertex x . removeVertex x)y==(removeVertex x y :: RI) -    putStrLn "\n============ removeEdge ============"+    putStrLn "\n============ Relation.removeEdge ============"     test "removeEdge x y (edge x y)       == vertices [x, y]" $ \(x :: Int) y ->           removeEdge x y (edge x y)       == (vertices [x, y] :: RI) @@ -474,7 +509,7 @@     test "removeEdge 1 2 (1 * 1 * 2 * 2)  == 1 * 1 + 2 * 2" $           removeEdge 1 2 (1 * 1 * 2 * 2)  == (1 * 1 + 2 * (2 :: RI)) -    putStrLn "\n============ replaceVertex ============"+    putStrLn "\n============ Relation.replaceVertex ============"     test "replaceVertex x x            == id" $ \x (y :: RI) ->           replaceVertex x x y          == y @@ -484,7 +519,7 @@     test "replaceVertex x y            == mergeVertices (== x) y" $ \x y z ->           replaceVertex x y z          == (mergeVertices (== x) y z :: RI) -    putStrLn "\n============ mergeVertices ============"+    putStrLn "\n============ Relation.mergeVertices ============"     test "mergeVertices (const False) x    == id" $ \x (y :: RI) ->           mergeVertices (const False) x y  == y @@ -497,7 +532,32 @@     test "mergeVertices odd  1 (3 + 4 * 5) == 4 * 1" $           mergeVertices odd  1 (3 + 4 * 5) == (4 * 1 :: RI) -    putStrLn "\n============ gmap ============"+    putStrLn "\n============ Relation.transpose ============"+    test "transpose empty       == empty" $+          transpose empty       ==(empty :: RI)++    test "transpose (vertex x)  == vertex x" $ \(x :: Int) ->+          transpose (vertex x)  == vertex x++    test "transpose (edge x y)  == edge y x" $ \(x :: Int) y ->+          transpose (edge x y)  == edge y x++    test "transpose . transpose == id" $ \(x :: RI) ->+         (transpose . transpose) x == x++    test "transpose . path      == path    . reverse" $ \(xs :: [Int]) ->+         (transpose . path) xs  == (path . reverse) xs++    test "transpose . circuit   == circuit . reverse" $ \(xs :: [Int]) ->+         (transpose . circuit) xs == (circuit . reverse) xs++    test "transpose . clique    == clique  . reverse" $ \(xs :: [Int]) ->+         (transpose . clique) xs == (clique . reverse) xs++    test "edgeList . transpose  == sort . map swap . edgeList" $ \(x :: RI) ->+         (edgeList . transpose) x == (sort . map swap . edgeList) x++    putStrLn "\n============ Relation.gmap ============"     test "gmap f empty      == empty" $ \(apply -> f :: II) ->           gmap f empty      == empty @@ -513,7 +573,7 @@     test "gmap f . gmap g   == gmap (f . g)" $ \(apply -> f :: II) (apply -> g :: II) x ->          (gmap f . gmap g) x== gmap (f . g) x -    putStrLn "\n============ induce ============"+    putStrLn "\n============ Relation.induce ============"     test "induce (const True)  x      == x" $ \(x :: RI) ->           induce (const True)  x      == x @@ -529,14 +589,33 @@     test "isSubgraphOf (induce p x) x == True" $ \(apply -> p :: IB) (x :: RI) ->           isSubgraphOf (induce p x) x == True -    putStrLn "\n============ reflexiveClosure ============"+    putStrLn "\n============ Relation.compose ============"+    test "compose empty            x                == empty" $ \(x :: RI) ->+          compose empty            x                == empty++    test "compose x                empty            == empty" $ \(x :: RI) ->+          compose x                empty            == empty++    test "compose x                (compose y z)    == compose (compose x y) z" $ sizeLimit $ \(x :: RI) y z ->+          compose x                (compose y z)    == compose (compose x y) z++    test "compose (edge y z)       (edge x y)       == edge x z" $ \(x :: Int) y z ->+          compose (edge y z)       (edge x y)       == edge x z++    test "compose (path    [1..5]) (path    [1..5]) == edges [(1,3),(2,4),(3,5)]" $+          compose (path    [1..5]) (path    [1..5]) == edges [(1,3),(2,4),(3,5::Int)]++    test "compose (circuit [1..5]) (circuit [1..5]) == circuit [1,3,5,2,4]" $+          compose (circuit [1..5]) (circuit [1..5]) == circuit [1,3,5,2,4::Int]++    putStrLn "\n============ Relation.reflexiveClosure ============"     test "reflexiveClosure empty      == empty" $           reflexiveClosure empty      ==(empty :: RI)      test "reflexiveClosure (vertex x) == edge x x" $ \(x :: Int) ->           reflexiveClosure (vertex x) == edge x x -    putStrLn "\n============ symmetricClosure ============"+    putStrLn "\n============ Relation.symmetricClosure ============"      test "symmetricClosure empty      == empty" $           symmetricClosure empty      ==(empty :: RI)@@ -547,7 +626,7 @@     test "symmetricClosure (edge x y) == edges [(x, y), (y, x)]" $ \(x :: Int) y ->           symmetricClosure (edge x y) == edges [(x, y), (y, x)] -    putStrLn "\n============ transitiveClosure ============"+    putStrLn "\n============ Relation.transitiveClosure ============"     test "transitiveClosure empty           == empty" $           transitiveClosure empty           ==(empty :: RI) @@ -557,7 +636,7 @@     test "transitiveClosure (path $ nub xs) == clique (nub $ xs)" $ \(xs :: [Int]) ->           transitiveClosure (path $ nubOrd xs) == clique (nubOrd $ xs) -    putStrLn "\n============ preorderClosure ============"+    putStrLn "\n============ Relation.preorderClosure ============"     test "preorderClosure empty           == empty" $           preorderClosure empty           ==(empty :: RI) @@ -575,7 +654,7 @@     test "Axioms of undirected graphs" $ sizeLimit         (undirectedAxioms :: GraphTestsuite (SymmetricRelation Int)) -    putStrLn "\n============ neighbours ============"+    putStrLn "\n============ SymmetricRelation.neighbours ============"     test "neighbours x empty      == Set.empty" $ \(x :: Int) ->           neighbours x C.empty      == Set.empty