algebraic-graphs 0.0.4 → 0.0.5

raw patch · 26 files changed

+2406/−3215 lines, 26 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGES.md +10/−0
• algebraic-graphs.cabal +29/−6
• src/Algebra/Graph.hs +15/−11
• src/Algebra/Graph/AdjacencyMap.hs +109/−77
• src/Algebra/Graph/AdjacencyMap/Internal.hs +58/−10
• src/Algebra/Graph/Class.hs +5/−4
• src/Algebra/Graph/Export.hs +160/−0
• src/Algebra/Graph/Export/Dot.hs +174/−0
• src/Algebra/Graph/Fold.hs +8/−8
• src/Algebra/Graph/HigherKinded/Class.hs +22/−8
• src/Algebra/Graph/IntAdjacencyMap.hs +111/−79
• src/Algebra/Graph/IntAdjacencyMap/Internal.hs +58/−10
• src/Algebra/Graph/Relation.hs +31/−29
• src/Algebra/Graph/Relation/Internal.hs +4/−0
• src/Algebra/Graph/Relation/Symmetric.hs +1/−1
• test/Algebra/Graph/Test.hs +2/−2
• test/Algebra/Graph/Test/API.hs +340/−0
• test/Algebra/Graph/Test/AdjacencyMap.hs +26/−589
• test/Algebra/Graph/Test/Arbitrary.hs +8/−4
• test/Algebra/Graph/Test/Export.hs +162/−0
• test/Algebra/Graph/Test/Fold.hs +24/−621
• test/Algebra/Graph/Test/Generic.hs +983/−0
• test/Algebra/Graph/Test/Graph.hs +23/−619
• test/Algebra/Graph/Test/IntAdjacencyMap.hs +26/−588
• test/Algebra/Graph/Test/Relation.hs +15/−549
• test/Main.hs +2/−0

@@ -0,0 +1,10 @@+# Change log
+
+## 0.0.5
+
+* Add `dfs`.
+* #19: Move `GraphKL` to an internal module.
+* #18: Add `dfsForestFrom`.
+* #16: Add support for graph export, in particular in DOT format.
+* Make API more consistent, e.g. rename `postset` to `postSet`.
+* Improve documentation and tests.

@@ -1,5 +1,5 @@ name:          algebraic-graphs-version:       0.0.4+version:       0.0.5 synopsis:      A library for algebraic graph construction and transformation license:       MIT license-file:  LICENSE@@ -9,7 +9,7 @@ homepage:      https://github.com/snowleopard/alga category:      Algebra, Algorithms, Data Structures, Graphs build-type:    Simple-cabal-version: >=1.10+cabal-version: >=1.18 tested-with:   GHC==8.0.2 stability:     experimental description:@@ -41,6 +41,7 @@     <https://github.com/snowleopard/alga/issues discussions on the library API>.  extra-doc-files:+    CHANGES.md     README.md  source-repository head@@ -53,6 +54,8 @@                         Algebra.Graph.AdjacencyMap,                         Algebra.Graph.AdjacencyMap.Internal,                         Algebra.Graph.Class,+                        Algebra.Graph.Export,+                        Algebra.Graph.Export.Dot,                         Algebra.Graph.Fold,                         Algebra.Graph.HigherKinded.Class,                         Algebra.Graph.IntAdjacencyMap,@@ -77,16 +80,24 @@                         DeriveFunctor                         DeriveTraversable                         OverloadedStrings-    GHC-options:        -Wall -fwarn-tabs+                        RecordWildCards+    GHC-options:        -Wall+                        -Wcompat+                        -Wincomplete-record-updates+                        -Wincomplete-uni-patterns+                        -Wredundant-constraints  test-suite test-alga     hs-source-dirs:     test     type:               exitcode-stdio-1.0     main-is:            Main.hs     other-modules:      Algebra.Graph.Test,+                        Algebra.Graph.Test.API,                         Algebra.Graph.Test.AdjacencyMap,                         Algebra.Graph.Test.Arbitrary,+                        Algebra.Graph.Test.Export,                         Algebra.Graph.Test.Fold,+                        Algebra.Graph.Test.Generic,                         Algebra.Graph.Test.Graph,                         Algebra.Graph.Test.IntAdjacencyMap,                         Algebra.Graph.Test.Relation@@ -96,12 +107,19 @@                         extra      >= 1.5,                         QuickCheck >= 2.9     default-language:   Haskell2010-    GHC-options:        -O2 -Wall -fwarn-tabs+    GHC-options:        -O2+                        -Wall+                        -Wcompat+                        -Wincomplete-record-updates+                        -Wincomplete-uni-patterns+                        -Wredundant-constraints     default-extensions: FlexibleContexts                         GeneralizedNewtypeDeriving                         TypeFamilies                         ScopedTypeVariables-    other-extensions:   RankNTypes+    other-extensions:   ConstrainedClassMethods+                        ConstraintKinds+                        RankNTypes                         ViewPatterns  benchmark benchmark-alga@@ -113,7 +131,12 @@                         containers >= 0.5,                         criterion  >= 1.1     default-language:   Haskell2010-    GHC-options:        -O2 -Wall -fwarn-tabs+    GHC-options:        -O2+                        -Wall+                        -Wcompat+                        -Wincomplete-record-updates+                        -Wincomplete-uni-patterns+                        -Wredundant-constraints     default-extensions: FlexibleContexts                         TypeFamilies                         ScopedTypeVariables

@@ -433,9 +433,10 @@ -- hasEdge x y ('vertex' z)       == False -- hasEdge x y ('edge' x y)       == True -- hasEdge x y . 'removeEdge' x y == const False+-- hasEdge x y                  == 'elem' (x,y) . 'edgeList' -- @-hasEdge :: Eq a => a -> a -> Graph a -> Bool-hasEdge s t g = not $ intact st where (_, _, st) = smash s t g+hasEdge :: Ord a => a -> a -> Graph a -> Bool+hasEdge = H.hasEdge  -- | The number of vertices in a graph. -- Complexity: /O(s * log(n))/ time.@@ -555,11 +556,12 @@ -- 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 . 'reverse' == 'transpose' . clique+-- clique []         == 'empty'+-- clique [x]        == 'vertex' x+-- clique [x,y]      == 'edge' x y+-- clique [x,y,z]    == 'edges' [(x,y), (x,z), (y,z)]+-- clique (xs ++ ys) == 'connect' (clique xs) (clique ys)+-- clique . 'reverse'  == 'transpose' . clique -- @ clique :: [a] -> Graph a clique = H.clique@@ -653,13 +655,14 @@ -- -- @ --           deBruijn 0 xs               == 'edge' [] []--- n > 0 'Test.QuickCheck.==>' deBruijn n []               == 'empty'+-- n > 0 ==> 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") ]+--           'transpose'   (deBruijn n xs) == 'fmap' 'reverse' $ deBruijn n xs --           '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)+-- n > 0 ==> 'edgeCount'   (deBruijn n xs) == ('length' $ 'Data.List.nub' xs)^(n + 1) -- @ deBruijn :: Int -> [a] -> Graph [a] deBruijn = H.deBruijn@@ -675,7 +678,8 @@ removeVertex = H.removeVertex  -- | Remove an edge from a given graph.--- Complexity: /O(s)/ time and memory.+-- Complexity: /O(s)/ time and memory. The worst case size complexity is /O(s^2)/,+-- although in practice it is usually also linear /O(s)/. -- -- @ -- removeEdge x y ('edge' x y)       == 'vertices' [x, y]@@ -737,7 +741,7 @@ -- mergeVertices even 1 (0 * 2)     == 1 * 1 -- mergeVertices odd  1 (3 + 4 * 5) == 4 * 1 -- @-mergeVertices :: Eq a => (a -> Bool) -> a -> Graph a -> Graph a+mergeVertices :: (a -> Bool) -> a -> Graph a -> Graph a mergeVertices = H.mergeVertices  -- | Split a vertex into a list of vertices with the same connectivity.

@@ -29,23 +29,20 @@      -- * Graph properties     isEmpty, hasVertex, hasEdge, vertexCount, edgeCount, vertexList, edgeList,-    adjacencyList, vertexSet, edgeSet, postset,+    adjacencyList, vertexSet, edgeSet, postSet,      -- * Standard families of graphs     path, circuit, clique, biclique, star, tree, forest,      -- * Graph transformation-    removeVertex, removeEdge, replaceVertex, mergeVertices, gmap, induce,+    removeVertex, removeEdge, replaceVertex, mergeVertices, transpose, gmap, induce,      -- * Algorithms-    dfsForest, topSort, isTopSort, scc,--    -- * Interoperability with King-Launchbury graphs-    GraphKL, getGraph, getVertex, graphKL, fromGraphKL+    dfsForest, dfsForestFrom, dfs, topSort, isTopSort, scc   ) where -import Data.Array import Data.Foldable (toList)+import Data.Maybe import Data.Set (Set) import Data.Tree @@ -144,7 +141,7 @@ -- 'vertexSet'   . vertices == Set.'Set.fromList' -- @ vertices :: Ord a => [a] -> AdjacencyMap a-vertices = AdjacencyMap . Map.fromList . map (\x -> (x, Set.empty))+vertices = mkAM . 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.@@ -207,7 +204,7 @@ -- 'overlay' (fromAdjacencyList xs) (fromAdjacencyList ys) == fromAdjacencyList (xs ++ ys) -- @ fromAdjacencyList :: Ord a => [(a, [a])] -> AdjacencyMap a-fromAdjacencyList as = AdjacencyMap $ Map.unionWith Set.union vs es+fromAdjacencyList as = mkAM $ Map.unionWith Set.union vs es   where     ss = map (fmap Set.fromList) as     vs = Map.fromSet (const Set.empty) . Set.unions $ map snd ss@@ -259,6 +256,7 @@ -- hasEdge x y ('vertex' z)       == False -- hasEdge x y ('edge' x y)       == True -- hasEdge x y . 'removeEdge' x y == const False+-- hasEdge x y                  == 'elem' (x,y) . 'edgeList' -- @ hasEdge :: Ord a => a -> a -> AdjacencyMap a -> Bool hasEdge u v a = case Map.lookup u (adjacencyMap a) of@@ -273,7 +271,7 @@ -- vertexCount ('vertex' x) == 1 -- vertexCount            == 'length' . 'vertexList' -- @-vertexCount :: Ord a => AdjacencyMap a -> Int+vertexCount :: AdjacencyMap a -> Int vertexCount = Map.size . adjacencyMap  -- | The number of edges in a graph.@@ -285,7 +283,7 @@ -- edgeCount ('edge' x y) == 1 -- edgeCount            == 'length' . 'edgeList' -- @-edgeCount :: Ord a => AdjacencyMap a -> Int+edgeCount :: AdjacencyMap a -> Int edgeCount = Map.foldr (\es r -> (Set.size es + r)) 0 . adjacencyMap  -- | The sorted list of vertices of a given graph.@@ -296,7 +294,7 @@ -- vertexList ('vertex' x) == [x] -- vertexList . 'vertices' == 'Data.List.nub' . 'Data.List.sort' -- @-vertexList :: Ord a => AdjacencyMap a -> [a]+vertexList :: AdjacencyMap a -> [a] vertexList = Map.keys . adjacencyMap  -- | The sorted list of edges of a graph.@@ -308,9 +306,10 @@ -- 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 :: AdjacencyMap a -> [(a, a)]-edgeList (AdjacencyMap m) = [ (x, y) | (x, ys) <- Map.toAscList m, y <- Set.toAscList ys ]+edgeList (AM 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.@@ -334,7 +333,7 @@ -- vertexSet . 'vertices' == Set.'Set.fromList' -- vertexSet . 'clique'   == Set.'Set.fromList' -- @-vertexSet :: Ord a => AdjacencyMap a -> Set a+vertexSet :: AdjacencyMap a -> Set a vertexSet = Map.keysSet . adjacencyMap  -- | The set of edges of a given graph.@@ -352,21 +351,22 @@ -- | The /postset/ of a vertex is the set of its /direct successors/. -- -- @--- postset x 'empty'      == Set.'Set.empty'--- postset x ('vertex' x) == Set.'Set.empty'--- postset x ('edge' x y) == Set.'Set.fromList' [y]--- postset 2 ('edge' 1 2) == Set.'Set.empty'+-- postSet x 'empty'      == Set.'Set.empty'+-- postSet x ('vertex' x) == Set.'Set.empty'+-- postSet x ('edge' x y) == Set.'Set.fromList' [y]+-- postSet 2 ('edge' 1 2) == Set.'Set.empty' -- @-postset :: Ord a => a -> AdjacencyMap a -> Set a-postset x = Map.findWithDefault Set.empty x . adjacencyMap+postSet :: Ord a => a -> AdjacencyMap a -> Set a+postSet x = Map.findWithDefault Set.empty x . adjacencyMap  -- | 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] -> AdjacencyMap a path = C.path@@ -375,9 +375,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] -> AdjacencyMap a circuit = C.circuit@@ -386,10 +387,12 @@ -- 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 (xs ++ ys) == 'connect' (clique xs) (clique ys)+-- clique . 'reverse'  == 'transpose' . clique -- @ clique :: Ord a => [a] -> AdjacencyMap a clique = C.clique@@ -405,7 +408,7 @@ -- biclique xs      ys      == 'connect' ('vertices' xs) ('vertices' ys) -- @ biclique :: Ord a => [a] -> [a] -> AdjacencyMap a-biclique xs ys = AdjacencyMap $ Map.fromSet adjacent (x `Set.union` y)+biclique xs ys = mkAM $ Map.fromSet adjacent (x `Set.union` y)   where     x = Set.fromList xs     y = Set.fromList ys@@ -456,7 +459,7 @@ -- 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+removeVertex x = mkAM . Map.map (Set.delete x) . Map.delete x . adjacencyMap  -- | Remove an edge from a given graph. -- Complexity: /O(log(n))/ time.@@ -469,7 +472,7 @@ -- 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+removeEdge x y = mkAM . 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.@@ -496,6 +499,25 @@ mergeVertices :: Ord a => (a -> Bool) -> a -> AdjacencyMap a -> AdjacencyMap a mergeVertices p v = gmap $ \u -> if p u then v else u +-- | Transpose a given graph.+-- Complexity: /O(m * log(n))/ time, /O(n + m)/ memory.+--+-- @+-- 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 => AdjacencyMap a -> AdjacencyMap a+transpose (AM m _) = mkAM $ Map.foldrWithKey combine vs m+  where+    combine v es = Map.unionWith Set.union (Map.fromSet (const $ Set.singleton v) es)+    vs           = Map.fromSet (const Set.empty) (Map.keysSet m)+ -- | 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'.@@ -509,7 +531,7 @@ -- 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+gmap f = mkAM . Map.map (Set.map f) . Map.mapKeysWith Set.union f . adjacencyMap  -- | Construct the /induced subgraph/ of a given graph by removing the -- vertices that do not satisfy a given predicate.@@ -524,7 +546,7 @@ -- '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+induce p = mkAM . Map.map (Set.filter p) . Map.filterWithKey (\k _ -> p k) . adjacencyMap  -- | Compute the /depth-first search/ forest of a graph. --@@ -534,6 +556,8 @@ -- 'forest' (dfsForest $ 'edge' 2 1)         == 'vertices' [1, 2] -- 'isSubgraphOf' ('forest' $ dfsForest x) x == True -- dfsForest . 'forest' . dfsForest        == dfsForest+-- dfsForest ('vertices' vs)               == map (\\v -> Node v []) ('Data.List.nub' $ 'Data.List.sort' vs)+-- 'dfsForestFrom' ('vertexList' x) x        == dfsForest x -- dfsForest $ 3 * (1 + 4) * (1 + 5)     == [ Node { rootLabel = 1 --                                                 , subForest = [ Node { rootLabel = 5 --                                                                      , subForest = [] }]}@@ -541,9 +565,49 @@ --                                                 , subForest = [ Node { rootLabel = 4 --                                                                      , subForest = [] }]}] -- @-dfsForest :: Ord a => AdjacencyMap a -> Forest a-dfsForest m = let GraphKL g r = graphKL m in fmap (fmap r) (KL.dff g)+dfsForest :: AdjacencyMap a -> Forest a+dfsForest (AM _ (GraphKL g r _)) = fmap (fmap r) (KL.dff g) +-- | Compute the /depth-first search/ forest of a graph, searching from each of+-- the given vertices in order. Note that the resulting forest does not+-- necessarily span the whole graph, as some vertices may be unreachable.+--+-- @+-- 'forest' (dfsForestFrom [1]    $ 'edge' 1 1)     == 'vertex' 1+-- 'forest' (dfsForestFrom [1]    $ 'edge' 1 2)     == 'edge' 1 2+-- 'forest' (dfsForestFrom [2]    $ 'edge' 1 2)     == 'vertex' 2+-- 'forest' (dfsForestFrom [3]    $ 'edge' 1 2)     == 'empty'+-- 'forest' (dfsForestFrom [2, 1] $ 'edge' 1 2)     == 'vertices' [1, 2]+-- 'isSubgraphOf' ('forest' $ dfsForestFrom vs x) x == True+-- dfsForestFrom ('vertexList' x) x               == 'dfsForest' x+-- dfsForestFrom vs             ('vertices' vs)   == map (\\v -> Node v []) ('Data.List.nub' vs)+-- dfsForestFrom []             x               == []+-- dfsForestFrom [1, 4] $ 3 * (1 + 4) * (1 + 5) == [ Node { rootLabel = 1+--                                                        , subForest = [ Node { rootLabel = 5+--                                                                             , subForest = [] }+--                                                 , Node { rootLabel = 4+--                                                        , subForest = [] }]+-- @+dfsForestFrom :: [a] -> AdjacencyMap a -> Forest a+dfsForestFrom vs (AM _ (GraphKL g r t)) = fmap (fmap r) (KL.dfs g (mapMaybe t vs))++-- | Compute the list of vertices visited by the /depth-first search/ in a graph,+-- when searching from each of the given vertices in order.+--+-- @+-- dfs [1]    $ 'edge' 1 1                == [1]+-- dfs [1]    $ 'edge' 1 2                == [1, 2]+-- dfs [2]    $ 'edge' 1 2                == [2]+-- dfs [3]    $ 'edge' 1 2                == []+-- dfs [1, 2] $ 'edge' 1 2                == [1, 2]+-- dfs [2, 1] $ 'edge' 1 2                == [2, 1]+-- dfs []     $ x                       == []+-- dfs [1, 4] $ 3 * (1 + 4) * (1 + 5)   == [1, 5, 4]+-- 'isSubgraphOf' ('vertices' $ dfs vs x) x == True+-- @+dfs :: [a] -> AdjacencyMap a -> [a]+dfs vs = concatMap flatten . dfsForestFrom vs+ -- | Compute the /topological sort/ of a graph or return @Nothing@ if the graph -- is cyclic. --@@ -553,10 +617,10 @@ -- fmap (flip 'isTopSort' x) (topSort x) /= Just False -- @ topSort :: Ord a => AdjacencyMap a -> Maybe [a]-topSort m = if isTopSort result m then Just result else Nothing+topSort m@(AM _ (GraphKL g r _)) =+    if isTopSort result m then Just result else Nothing   where-    GraphKL g r = graphKL m-    result      = map r (KL.topSort g)+    result = map r (KL.topSort g)  -- | Check if a given list of vertices is a valid /topological sort/ of a graph. --@@ -573,7 +637,7 @@   where     go seen []     = seen == Map.keysSet (adjacencyMap m)     go seen (v:vs) = let newSeen = seen `seq` Set.insert v seen-        in postset v m `Set.intersection` newSeen == Set.empty && go newSeen vs+        in postSet v m `Set.intersection` newSeen == Set.empty && go newSeen vs  -- | Compute the /condensation/ of a graph, where each vertex corresponds to a -- /strongly-connected component/ of the original graph.@@ -589,40 +653,8 @@ --                                  , (Set.'Set.fromList' [3]  , Set.'Set.fromList' [5]  )] -- @ scc :: Ord a => AdjacencyMap a -> AdjacencyMap (Set a)-scc m = gmap (\v -> Map.findWithDefault Set.empty v components) m-  where-    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+scc m@(AM _ (GraphKL g r _)) =+    gmap (\v -> Map.findWithDefault Set.empty v components) m   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)+    components = Map.fromList $ concatMap (expand . fmap r . toList) (KL.scc g)+    expand xs  = let s = Set.fromList xs in map (\x -> (x, s)) xs

@@ -12,7 +12,10 @@ ----------------------------------------------------------------------------- module Algebra.Graph.AdjacencyMap.Internal (     -- * Adjacency map implementation-    AdjacencyMap (..), consistent+    AdjacencyMap (..), mkAM, consistent,++    -- * Interoperability with King-Launchbury graphs+    GraphKL (..), mkGraphKL   ) where  import Data.Map.Strict (Map, keysSet, fromSet)@@ -20,6 +23,7 @@  import Algebra.Graph.Class +import qualified Data.Graph      as KL import qualified Data.Map.Strict as Map import qualified Data.Set        as Set @@ -83,14 +87,25 @@ When specifying the time and memory complexity of graph algorithms, /n/ and /m/ will denote the number of vertices and edges in the graph, respectively. -}-newtype AdjacencyMap a = AdjacencyMap {+data AdjacencyMap a = AM {     -- | The /adjacency map/ of the graph: each vertex is associated with a set     -- of its direct successors.-    adjacencyMap :: Map a (Set a)-  } deriving Eq+    adjacencyMap :: !(Map a (Set a)),+    -- | Cached King-Launchbury representation.+    -- /Note: this field is for internal use only/.+    graphKL :: GraphKL a } +-- | Construct an 'AdjacencyMap' from a map of successor sets and (lazily)+-- compute the corresponding King-Launchbury representation.+-- /Note: this function is for internal use only/.+mkAM :: Ord a => Map a (Set a) -> AdjacencyMap a+mkAM m = AM m (mkGraphKL m)++instance Eq a => Eq (AdjacencyMap a) where+    x == y = adjacencyMap x == adjacencyMap y+ instance (Ord a, Show a) => Show (AdjacencyMap a) where-    show (AdjacencyMap m)+    show (AM m _)         | m == Map.empty = "empty"         | es == []       = if Set.size vs > 1 then "vertices " ++ show (Set.toAscList vs)                                               else "vertex "   ++ show v@@ -106,10 +121,10 @@  instance Ord a => Graph (AdjacencyMap a) where     type Vertex (AdjacencyMap a) = a-    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,+    empty       = mkAM $ Map.empty+    vertex x    = mkAM $ Map.singleton x Set.empty+    overlay x y = mkAM $ Map.unionWith Set.union (adjacencyMap x) (adjacencyMap y)+    connect x y = mkAM $ 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@@ -120,6 +135,10 @@     abs         = id     negate      = id +instance ToGraph (AdjacencyMap a) where+    type ToVertex (AdjacencyMap a) = a+    toGraph = overlays . map (uncurry star . fmap Set.toList) . Map.toList . adjacencyMap+ -- | 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.@@ -136,7 +155,7 @@ -- consistent ('Algebra.Graph.AdjacencyMap.fromAdjacencyList' xs) == True -- @ consistent :: Ord a => AdjacencyMap a -> Bool-consistent (AdjacencyMap m) = referredToVertexSet m `Set.isSubsetOf` keysSet m+consistent (AM m _) = referredToVertexSet m `Set.isSubsetOf` keysSet m  -- The set of vertices that are referred to by the edges referredToVertexSet :: Ord a => Map a (Set a) -> Set a@@ -145,3 +164,32 @@ -- 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 ]++-- | 'GraphKL' encapsulates King-Launchbury graphs, which are implemented in+-- the "Data.Graph" module of the @containers@ library.+-- /Note: this data structure is for internal use only/.+--+-- If @mkGraphKL (adjacencyMap g) == h@ then the following holds:+--+-- @+-- map ('fromVertexKL' h) ('Data.Graph.vertices' $ 'toGraphKL' h)                               == 'Algebra.Graph.AdjacencyMap.vertexList' g+-- map (\\(x, y) -> ('fromVertexKL' h x, 'fromVertexKL' h y)) ('Data.Graph.edges' $ 'toGraphKL' h) == 'Algebra.Graph.AdjacencyMap.edgeList' g+-- @+data GraphKL a = GraphKL {+    -- | Array-based graph representation (King and Launchbury, 1995).+    toGraphKL :: KL.Graph,+    -- | A mapping of "Data.Graph.Vertex" to vertices of type @a@.+    fromVertexKL :: KL.Vertex -> a,+    -- | A mapping from vertices of type @a@ to "Data.Graph.Vertex".+    -- Returns 'Nothing' if the argument is not in the graph.+    toVertexKL :: a -> Maybe KL.Vertex }++-- | Build 'GraphKL' from a map of successor sets.+-- /Note: this function is for internal use only/.+mkGraphKL :: Ord a => Map a (Set a) -> GraphKL a+mkGraphKL m = GraphKL+    { toGraphKL    = g+    , fromVertexKL = \u -> case r u of (_, v, _) -> v+    , toVertexKL   = t }+  where+    (g, r, t) = KL.graphFromEdges [ ((), v, Set.toAscList us) | (v, us) <- Map.toAscList m ]

@@ -333,10 +333,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 (xs ++ ys) == 'connect' (clique xs) (clique ys) -- @ clique :: Graph g => [Vertex g] -> g clique = connects . map vertex

@@ -0,0 +1,160 @@+{-# LANGUAGE OverloadedStrings #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Algebra.Graph.Export+-- Copyright  : (c) Andrey Mokhov 2016-2017+-- License    : MIT (see the file LICENSE)+-- Maintainer : andrey.mokhov@gmail.com+-- Stability  : experimental+--+-- __Alga__ is a library for algebraic construction and manipulation of graphs+-- in Haskell. See <https://github.com/snowleopard/alga-paper this paper> for the+-- motivation behind the library, the underlying theory, and implementation details.+--+-- This module defines basic data types and functions for exporting graphs in+-- textual and binary formats. "Algebra.Graph.Export.Dot" provides DOT-specific+-- functionality.+-----------------------------------------------------------------------------+module Algebra.Graph.Export (+    -- * Constructing and exporting documents+    Doc, literal, render,++    -- * Common combinators for text documents+    (<+>), brackets, doubleQuotes, indent, unlines,++    -- * Generic graph export+    export+  ) where++import Data.Semigroup+import Data.String hiding (unlines)+import Prelude hiding (unlines)++import Algebra.Graph.AdjacencyMap+import Algebra.Graph.Class (ToGraph (..))++-- | An abstract document type, where @s@ is the type of strings or words (text+-- or binary). 'Doc' @s@ is a 'Monoid', therefore 'mempty' corresponds to the+-- empty document and two documents can be concatenated with 'mappend' (or+-- operator 'Data.Monoid.<>'). Note that most functions on 'Doc' @s@ require+-- that the underlying type @s@ is also a 'Monoid'.+newtype Doc s = Doc (Endo [s]) deriving (Monoid, Semigroup)++instance (Monoid s, Show s) => Show (Doc s) where+    show = show . render++instance (Monoid s, Eq s) => Eq (Doc s) where+    x == y = render x == render y++instance (Monoid s, Ord s) => Ord (Doc s) where+    compare x y = compare (render x) (render y)++instance IsString s => IsString (Doc s) where+    fromString = literal . fromString++-- | Construct a document comprising a single string or word. If @s@ is an+-- instance of class 'IsString', then documents of type 'Doc' @s@ can be+-- constructed directly from string literals (see the second example below).+--+-- @+-- literal "Hello, " <> literal "World!" == literal "Hello, World!"+-- literal "I am just a string literal"  == "I am just a string literal"+-- literal 'mempty'                        == 'mempty'+-- 'render' . literal                      == 'id'+-- literal . 'render'                      == 'id'+-- @+literal :: s -> Doc s+literal = Doc . Endo . (:)++-- | Render a document as a single string or word. An inverse of the function+-- 'literal'.+--+-- @+-- render ('literal' "al" <> 'literal' "ga") :: ('IsString' s, 'Monoid' s) => s+-- render ('literal' "al" <> 'literal' "ga") == "alga"+-- render 'mempty'                         == 'mempty'+-- render . 'literal'                      == 'id'+-- 'literal' . render                      == 'id'+-- @+render :: Monoid s => Doc s -> s+render (Doc x) = mconcat $ appEndo x []++-- | Concatenate two documents, separated by a single space, unless one of the+-- documents is empty. The operator \<+\> is associative with identity 'mempty'.+--+-- @+-- x \<+\> 'mempty'         == x+-- 'mempty' \<+\> x         == x+-- x \<+\> (y \<+\> z)      == (x \<+\> y) \<+\> z+-- "name" \<+\> "surname" == "name surname"+-- @+(<+>) :: (Eq s, IsString s, Monoid s) => Doc s -> Doc s -> Doc s+x <+> y | x == mempty = y+        | y == mempty = x+        | otherwise   = x <> " " <> y++infixl 7 <+>++-- | Wrap a document in square brackets.+--+-- @+-- brackets "i"    == "[i]"+-- brackets 'mempty' == "[]"+-- @+brackets :: IsString s => Doc s -> Doc s+brackets x = "[" <> x <> "]"++-- | Wrap a document into double quotes.+--+-- @+-- doubleQuotes "\/path\/with spaces"   == "\\"\/path\/with spaces\\""+-- doubleQuotes (doubleQuotes 'mempty') == "\\"\\"\\"\\""+-- @+doubleQuotes :: IsString s => Doc s -> Doc s+doubleQuotes x = "\"" <> x <> "\""++-- | Prepend a given number of spaces to a document.+--+-- @+-- indent 0        == 'id'+-- indent 1 'mempty' == " "+-- @+indent :: IsString s => Int -> Doc s -> Doc s+indent spaces x = fromString (replicate spaces ' ') <> x++-- | Concatenate documents after appending a terminating newline symbol to each.+--+-- @+-- unlines []                    == 'mempty'+-- unlines ['mempty']              == "\\n"+-- unlines ["title", "subtitle"] == "title\\nsubtitle\\n"+-- @+unlines :: IsString s => [Doc s] -> Doc s+unlines []     = mempty+unlines (x:xs) = x <> "\n" <> unlines xs++-- TODO: Avoid round-trip graph conversion if g :: AdjacencyMap a.+-- | Export a graph into a document given two functions that construct documents+-- for individual vertices and edges. The order of export is: vertices, sorted+-- by 'Ord' @a@, and then edges, sorted by 'Ord' @(a, a)@.+--+-- For example:+--+-- @+-- vDoc x   = 'literal' ('show' x) <> "\\n"+-- eDoc x y = 'literal' ('show' x) <> " -> " <> 'literal' ('show' y) <> "\\n"+-- > putStrLn $ 'render' $ export vDoc eDoc (1 + 2 * (3 + 4) :: 'Algebra.Graph.Graph' Int)+--+-- 1+-- 2+-- 3+-- 4+-- 2 -> 3+-- 2 -> 4+-- @+export :: (Ord a, ToGraph g, ToVertex g ~ a) => (a -> Doc s) -> (a -> a -> Doc s) -> g -> Doc s+export vs es g = vDoc <> eDoc+  where+    vDoc   = mconcat $ map (vs        ) (vertexList adjMap)+    eDoc   = mconcat $ map (uncurry es) (edgeList   adjMap)+    adjMap = toGraph g

@@ -0,0 +1,174 @@+{-# LANGUAGE OverloadedStrings, RecordWildCards #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Algebra.Graph.Export.Dot+-- Copyright  : (c) Andrey Mokhov 2016-2017+-- License    : MIT (see the file LICENSE)+-- Maintainer : andrey.mokhov@gmail.com+-- Stability  : experimental+--+-- __Alga__ is a library for algebraic construction and manipulation of graphs+-- in Haskell. See <https://github.com/snowleopard/alga-paper this paper> for the+-- motivation behind the library, the underlying theory, and implementation details.+--+-- This module defines functions for exporting graphs in the DOT file format.+-----------------------------------------------------------------------------+module Algebra.Graph.Export.Dot (+    -- * Graph attributes and style+    Attribute (..), Style (..), defaultStyle, defaultStyleViaShow,++    -- * Export functions+    export, exportAsIs, exportViaShow+  ) where++import Data.List hiding (unlines)+import Data.Monoid+import Data.String hiding (unlines)+import Prelude hiding (unlines)++import Algebra.Graph.Class (ToGraph (..))+import Algebra.Graph.Export hiding (export)+import qualified Algebra.Graph.Export as E++-- | An attribute is just a key-value pair, for example @"shape" := "box"@.+-- Attributes are used to specify the style of graph elements during export.+data Attribute s = (:=) s s++-- | The record 'Style' @a@ @s@ specifies the style to use when exporting a+-- graph in the DOT format. Here @a@ is the type of the graph vertices, and @s@+-- is the type of string to represent the resulting DOT document (e.g. String,+-- Text, etc.). Most fields can be empty. The only field that has no obvious+-- default value is 'vertexName', which holds a function of type @a -> s@ to+-- compute vertex names. See the example for the function 'export'.+data Style a s = Style+    { graphName :: s+    -- ^ Name of the graph.+    , preamble :: s+    -- ^ Preamble is added at the beginning of the DOT file body.+    , graphAttributes :: [Attribute s]+    -- ^ Graph style, e.g. @["bgcolor" := "azure"]@.+    , defaultVertexAttributes :: [Attribute s]+    -- ^ Default vertex style, e.g. @["shape" := "diamond"]@.+    , defaultEdgeAttributes :: [Attribute s]+    -- ^ Default edge style, e.g. @["style" := "dashed"]@.+    , vertexName :: a -> s+    -- ^ Compute a vertex name.+    , vertexAttributes :: a -> [Attribute s]+    -- ^ Attributes of a specific vertex.+    , edgeAttributes   :: a -> a -> [Attribute s]+    -- ^ Attributes of a specific edge.+    }++-- | Default style for exporting graphs. All style settings are empty except for+-- 'vertexName', which is provided as the only argument.+defaultStyle :: Monoid s => (a -> s) -> Style a s+defaultStyle v = Style mempty mempty [] [] [] v (\_ -> []) (\_ _ -> [])++-- | Default style for exporting graphs whose vertices are 'Show'-able. All+-- style settings are empty except for 'vertexName', which is computed from+-- 'show'.+--+-- @+-- defaultStyleViaShow = 'defaultStyle' ('fromString' . 'show')+-- @+defaultStyleViaShow :: (Show a, IsString s, Monoid s) => Style a s+defaultStyleViaShow = defaultStyle (fromString . show)++-- | Export a graph with a given style.+--+-- For example:+--+-- @+-- style :: 'Style' Int String+-- style = 'Style'+--     { 'graphName'               = \"Example\"+--     , 'preamble'                = "  // This is an example\\n"+--     , 'graphAttributes'         = ["label" := \"Example\", "labelloc" := "top"]+--     , 'defaultVertexAttributes' = ["shape" := "circle"]+--     , 'defaultEdgeAttributes'   = 'mempty'+--     , 'vertexName'              = \\x   -> "v" ++ 'show' x+--     , 'vertexAttributes'        = \\x   -> ["color" := "blue"   | 'odd' x      ]+--     , 'edgeAttributes'          = \\x y -> ["style" := "dashed" | 'odd' (x * y)] }+--+-- > putStrLn $ export style (1 * 2 + 3 * 4 * 5 :: 'Graph' Int)+--+-- digraph Example+-- {+--   // This is an example+--+--   graph [label=\"Example\" labelloc="top"]+--   node [shape="circle"]+--   "v1" [color="blue"]+--   "v2"+--   "v3" [color="blue"]+--   "v4"+--   "v5" [color="blue"]+--   "v1" -> "v2"+--   "v3" -> "v4"+--   "v3" -> "v5" [style="dashed"]+--   "v4" -> "v5"+-- }+-- @+export :: (IsString s, Monoid s, Eq s, Ord a, ToGraph g, ToVertex g ~ a) => Style a s -> g -> s+export Style {..} g = render $ header <> body <> "}\n"+  where+    header    = "digraph" <+> literal graphName <> "\n{\n"+             <> if preamble == mempty then mempty else (literal preamble <> "\n")+    with x as = if null as            then mempty else line (x <+> attributes as)+    line s    = indent 2 s <> "\n"+    body      = ("graph" `with` graphAttributes)+             <> ("node"  `with` defaultVertexAttributes)+             <> ("edge"  `with` defaultEdgeAttributes)+             <> E.export vDoc eDoc g+    label     = doubleQuotes . literal . vertexName+    vDoc x    = line $ label x <+>                      attributes (vertexAttributes x)+    eDoc x y  = line $ label x <> " -> " <> label y <+> attributes (edgeAttributes x y)++-- A list of attributes formatted as a DOT document.+-- Example: @attributes ["label" := "A label", "shape" := "box"]@+-- corresponds to document: @ [label="A label" shape="box"]@.+attributes :: IsString s => [Attribute s] -> Doc s+attributes [] = mempty+attributes as = brackets . mconcat . intersperse " " $ map dot as+  where+    dot (k := v) = literal k <> "=" <> doubleQuotes (literal v)++-- | Export a graph whose vertices are represented simply by their names.+--+-- For example:+--+-- @+-- > Text.putStrLn $ exportAsIs ('Algebra.Graph.AdjacencyMap.circuit' ["a", "b", "c"] :: 'Algebra.Graph.AdjacencyMap.AdjacencyMap' Text)+--+-- digraph+-- {+--   "a"+--   "b"+--   "c"+--   "a" -> "b"+--   "b" -> "c"+--   "c" -> "a"+-- }+-- @+exportAsIs :: (IsString s, Monoid s, Ord s, ToGraph g, ToVertex g ~ s) => g -> s+exportAsIs = export (defaultStyle id)++-- | Export a graph using the 'defaultStyleViaShow'.+--+-- For example:+--+-- @+-- > putStrLn $ exportViaShow (1 + 2 * (3 + 4) :: 'Algebra.Graph.Graph' Int)+--+-- digraph+-- {+--   "1"+--   "2"+--   "3"+--   "4"+--   "2" -> "3"+--   "2" -> "4"+-- }+-- @+exportViaShow :: (IsString s, Monoid s, Eq s, ToGraph g, Ord (ToVertex g), Show (ToVertex g)) => g -> s+exportViaShow = export defaultStyleViaShow

@@ -397,12 +397,10 @@ -- hasEdge x y ('vertex' z)       == False -- hasEdge x y ('edge' x y)       == True -- hasEdge x y . 'removeEdge' x y == const False+-- hasEdge x y                  == 'elem' (x,y) . 'edgeList' -- @-hasEdge :: Eq a => a -> a -> Fold a -> Bool-hasEdge s t = not . intact . edgelessPiece s t--edgelessPiece :: forall a. Eq a => a -> a -> Fold a -> Piece (Fold a)-edgelessPiece s t g = st where (_, _, st :: Piece (Fold a)) = smash s t g+hasEdge :: Ord a => a -> a -> Fold a -> Bool+hasEdge = H.hasEdge  data Piece g = Piece { piece :: g, intact :: Bool, trivial :: Bool } @@ -557,13 +555,14 @@ -- -- @ --           deBruijn 0 xs               == 'edge' [] []--- n > 0 'Test.QuickCheck.==>' deBruijn n []               == 'empty'+-- n > 0 ==> 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") ]+--           'transpose'   (deBruijn n xs) == 'gmap' 'reverse' $ deBruijn n xs --           '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)+-- n > 0 ==> '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 [] []@@ -584,7 +583,8 @@ removeVertex v = induce (/= v)  -- | Remove an edge from a given graph.--- Complexity: /O(s)/ time and memory.+-- Complexity: /O(s)/ time and memory. The worst case size complexity is /O(s^2)/,+-- although in practice it is usually also linear /O(s)/. -- -- @ -- removeEdge x y ('edge' x y)       == 'vertices' [x, y]

@@ -42,7 +42,7 @@     isSubgraphOf,      -- * Graph properties-    isEmpty, hasVertex, vertexCount, vertexList, vertexSet, vertexIntSet,+    isEmpty, hasVertex, hasEdge, vertexCount, vertexList, vertexSet, vertexIntSet,      -- * Standard families of graphs     path, circuit, clique, biclique, star, tree, forest, mesh, torus, deBruijn,@@ -298,6 +298,18 @@ hasVertex :: (Eq a, Graph g) => a -> g a -> Bool hasVertex = elem +-- | Check if a graph contains a given edge.+-- Complexity: /O(s)/ time.+--+-- @+-- hasEdge x y 'empty'            == False+-- hasEdge x y ('vertex' z)       == False+-- hasEdge x y ('edge' x y)       == True+-- hasEdge x y                  == 'elem' (x,y) . 'edgeList'+-- @+hasEdge :: (Eq (g a), Graph g, Ord a) => a -> a -> g a -> Bool+hasEdge u v = (edge u v `isSubgraphOf`) . induce (`elem` [u, v])+ -- | The number of vertices in a graph. -- Complexity: /O(s * log(n))/ time. --@@ -377,10 +389,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 (xs ++ ys) == 'connect' (clique xs) (clique ys) -- @ clique :: Graph g => [a] -> g a clique = connects . map vertex@@ -474,13 +487,14 @@ -- -- @ --           deBruijn 0 xs               == 'edge' [] []--- n > 0 'Test.QuickCheck.==>' deBruijn n []               == 'empty'+-- n > 0 ==> 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") ]+--           'transpose'   (deBruijn n xs) == 'fmap' 'reverse' $ deBruijn n xs --           '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)+-- n > 0 ==> 'edgeCount'   (deBruijn n xs) == ('length' $ 'Data.List.nub' xs)^(n + 1) -- @ deBruijn :: Graph g => Int -> [a] -> g [a] deBruijn 0   _        = edge [] []@@ -537,7 +551,7 @@ -- mergeVertices even 1 (0 * 2)     == 1 * 1 -- mergeVertices odd  1 (3 + 4 * 5) == 4 * 1 -- @-mergeVertices :: (Eq a, Graph g) => (a -> Bool) -> a -> g a -> g a+mergeVertices :: Graph g => (a -> Bool) -> a -> g a -> g a mergeVertices p v = fmap $ \w -> if p w then v else w  -- | Split a vertex into a list of vertices with the same connectivity.

@@ -29,23 +29,20 @@      -- * Graph properties     isEmpty, hasVertex, hasEdge, vertexCount, edgeCount, vertexList, edgeList,-    adjacencyList, vertexSet, edgeSet, postset,+    adjacencyList, vertexIntSet, edgeSet, postIntSet,      -- * Standard families of graphs     path, circuit, clique, biclique, star, tree, forest,      -- * Graph transformation-    removeVertex, removeEdge, replaceVertex, mergeVertices, gmap, induce,+    removeVertex, removeEdge, replaceVertex, mergeVertices, transpose, gmap, induce,      -- * Algorithms-    dfsForest, topSort, isTopSort,--    -- * Interoperability with King-Launchbury graphs-    GraphKL, getGraph, getVertex, graphKL, fromGraphKL+    dfsForest, dfsForestFrom, dfs, topSort, isTopSort   ) where -import Data.Array import Data.IntSet (IntSet)+import Data.Maybe import Data.Set (Set) import Data.Tree @@ -138,14 +135,14 @@ -- 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 []             == 'empty'+-- vertices [x]            == 'vertex' x+-- 'hasVertex' x  . vertices == 'elem' x+-- 'vertexCount'  . vertices == 'length' . 'Data.List.nub'+-- 'vertexIntSet' . vertices == IntSet.'IntSet.fromList' -- @ vertices :: [Int] -> IntAdjacencyMap-vertices = IntAdjacencyMap . IntMap.fromList . map (\x -> (x, IntSet.empty))+vertices = mkAM . 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.@@ -208,7 +205,7 @@ -- 'overlay' (fromAdjacencyList xs) (fromAdjacencyList ys) == fromAdjacencyList (xs ++ ys) -- @ fromAdjacencyList :: [(Int, [Int])] -> IntAdjacencyMap-fromAdjacencyList as = IntAdjacencyMap $ IntMap.unionWith IntSet.union vs es+fromAdjacencyList as = mkAM $ IntMap.unionWith IntSet.union vs es   where     ss = map (fmap IntSet.fromList) as     vs = IntMap.fromSet (const IntSet.empty) . IntSet.unions $ map snd ss@@ -260,6 +257,7 @@ -- hasEdge x y ('vertex' z)       == False -- hasEdge x y ('edge' x y)       == True -- hasEdge x y . 'removeEdge' x y == const False+-- hasEdge x y                  == 'elem' (x,y) . 'edgeList' -- @ hasEdge :: Int -> Int -> IntAdjacencyMap -> Bool hasEdge u v a = case IntMap.lookup u (adjacencyMap a) of@@ -309,9 +307,10 @@ -- 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 :: IntAdjacencyMap -> [(Int, Int)]-edgeList (IntAdjacencyMap m) = [ (x, y) | (x, ys) <- IntMap.toAscList m, y <- IntSet.toAscList ys ]+edgeList (AM 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.@@ -330,13 +329,13 @@ -- Complexity: /O(n)/ time and memory. -- -- @--- vertexSet 'empty'      == IntSet.'IntSet.empty'--- vertexSet . 'vertex'   == IntSet.'IntSet.singleton'--- vertexSet . 'vertices' == IntSet.'IntSet.fromList'--- vertexSet . 'clique'   == IntSet.'IntSet.fromList'+-- vertexIntSet 'empty'      == IntSet.'IntSet.empty'+-- vertexIntSet . 'vertex'   == IntSet.'IntSet.singleton'+-- vertexIntSet . 'vertices' == IntSet.'IntSet.fromList'+-- vertexIntSet . 'clique'   == IntSet.'IntSet.fromList' -- @-vertexSet :: IntAdjacencyMap -> IntSet-vertexSet = IntMap.keysSet . adjacencyMap+vertexIntSet :: IntAdjacencyMap -> IntSet+vertexIntSet = IntMap.keysSet . adjacencyMap  -- | The set of edges of a given graph. -- Complexity: /O((n + m) * log(m))/ time and /O(m)/ memory.@@ -355,21 +354,22 @@ -- | The /postset/ of a vertex is the set of its /direct successors/. -- -- @--- postset x 'empty'      == IntSet.'IntSet.empty'--- postset x ('vertex' x) == IntSet.'IntSet.empty'--- postset x ('edge' x y) == IntSet.'IntSet.fromList' [y]--- postset 2 ('edge' 1 2) == IntSet.'IntSet.empty'+-- postIntSet x 'empty'      == IntSet.'IntSet.empty'+-- postIntSet x ('vertex' x) == IntSet.'IntSet.empty'+-- postIntSet x ('edge' x y) == IntSet.'IntSet.fromList' [y]+-- postIntSet 2 ('edge' 1 2) == IntSet.'IntSet.empty' -- @-postset :: Int -> IntAdjacencyMap -> IntSet-postset x = IntMap.findWithDefault IntSet.empty x . adjacencyMap+postIntSet :: Int -> IntAdjacencyMap -> IntSet+postIntSet x = IntMap.findWithDefault IntSet.empty x . adjacencyMap  -- | 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 :: [Int] -> IntAdjacencyMap path = C.path@@ -378,9 +378,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 :: [Int] -> IntAdjacencyMap circuit = C.circuit@@ -389,10 +390,12 @@ -- 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 (xs ++ ys) == 'connect' (clique xs) (clique ys)+-- clique . 'reverse'  == 'transpose' . clique -- @ clique :: [Int] -> IntAdjacencyMap clique = C.clique@@ -408,7 +411,7 @@ -- biclique xs      ys      == 'connect' ('vertices' xs) ('vertices' ys) -- @ biclique :: [Int] -> [Int] -> IntAdjacencyMap-biclique xs ys = IntAdjacencyMap $ IntMap.fromSet adjacent (x `IntSet.union` y)+biclique xs ys = mkAM $ IntMap.fromSet adjacent (x `IntSet.union` y)   where     x = IntSet.fromList xs     y = IntSet.fromList ys@@ -459,7 +462,7 @@ -- removeVertex x . removeVertex x == removeVertex x -- @ removeVertex :: Int -> IntAdjacencyMap -> IntAdjacencyMap-removeVertex x = IntAdjacencyMap . IntMap.map (IntSet.delete x) . IntMap.delete x . adjacencyMap+removeVertex x = mkAM . IntMap.map (IntSet.delete x) . IntMap.delete x . adjacencyMap  -- | Remove an edge from a given graph. -- Complexity: /O(log(n))/ time.@@ -472,7 +475,7 @@ -- 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+removeEdge x y = mkAM . 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.@@ -499,6 +502,25 @@ mergeVertices :: (Int -> Bool) -> Int -> IntAdjacencyMap -> IntAdjacencyMap mergeVertices p v = gmap $ \u -> if p u then v else u +-- | Transpose a given graph.+-- Complexity: /O(m * log(n))/ time, /O(n + m)/ memory.+--+-- @+-- 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 :: IntAdjacencyMap -> IntAdjacencyMap+transpose (AM m _) = mkAM $ IntMap.foldrWithKey combine vs m+  where+    combine v es = IntMap.unionWith IntSet.union (IntMap.fromSet (const $ IntSet.singleton v) es)+    vs           = IntMap.fromSet (const IntSet.empty) (IntMap.keysSet m)+ -- | 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'.@@ -512,7 +534,7 @@ -- 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+gmap f = mkAM . IntMap.map (IntSet.map f) . IntMap.mapKeysWith IntSet.union f . adjacencyMap  -- | Construct the /induced subgraph/ of a given graph by removing the -- vertices that do not satisfy a given predicate.@@ -527,7 +549,7 @@ -- '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+induce p = mkAM . IntMap.map (IntSet.filter p) . IntMap.filterWithKey (\k _ -> p k) . adjacencyMap  -- | Compute the /depth-first search/ forest of a graph. --@@ -537,6 +559,8 @@ -- 'forest' (dfsForest $ 'edge' 2 1)         == 'vertices' [1, 2] -- 'isSubgraphOf' ('forest' $ dfsForest x) x == True -- dfsForest . 'forest' . dfsForest        == dfsForest+-- dfsForest ('vertices' vs)               == map (\\v -> Node v []) ('Data.List.nub' $ 'Data.List.sort' vs)+-- 'dfsForestFrom' ('vertexList' x) x        == dfsForest x -- dfsForest $ 3 * (1 + 4) * (1 + 5)     == [ Node { rootLabel = 1 --                                                 , subForest = [ Node { rootLabel = 5 --                                                                      , subForest = [] }]}@@ -545,8 +569,48 @@ --                                                                      , subForest = [] }]}] -- @ dfsForest :: IntAdjacencyMap -> Forest Int-dfsForest m = let GraphKL g r = graphKL m in fmap (fmap r) (KL.dff g)+dfsForest (AM _ (GraphKL g r _)) = fmap (fmap r) (KL.dff g) +-- | Compute the /depth-first search/ forest of a graph, searching from each of+-- the given vertices in order. Note that the resulting forest does not+-- necessarily span the whole graph, as some vertices may be unreachable.+--+-- @+-- 'forest' (dfsForestFrom [1]    $ 'edge' 1 1)     == 'vertex' 1+-- 'forest' (dfsForestFrom [1]    $ 'edge' 1 2)     == 'edge' 1 2+-- 'forest' (dfsForestFrom [2]    $ 'edge' 1 2)     == 'vertex' 2+-- 'forest' (dfsForestFrom [3]    $ 'edge' 1 2)     == 'empty'+-- 'forest' (dfsForestFrom [2, 1] $ 'edge' 1 2)     == 'vertices' [1, 2]+-- 'isSubgraphOf' ('forest' $ dfsForestFrom vs x) x == True+-- dfsForestFrom ('vertexList' x) x               == 'dfsForest' x+-- dfsForestFrom vs             ('vertices' vs)   == map (\\v -> Node v []) ('Data.List.nub' vs)+-- dfsForestFrom []             x               == []+-- dfsForestFrom [1, 4] $ 3 * (1 + 4) * (1 + 5) == [ Node { rootLabel = 1+--                                                        , subForest = [ Node { rootLabel = 5+--                                                                             , subForest = [] }+--                                                 , Node { rootLabel = 4+--                                                        , subForest = [] }]+-- @+dfsForestFrom :: [Int] -> IntAdjacencyMap -> Forest Int+dfsForestFrom vs (AM _ (GraphKL g r t)) = fmap (fmap r) (KL.dfs g (mapMaybe t vs))++-- | Compute the list of vertices visited by the /depth-first search/ in a graph,+-- when searching from each of the given vertices in order.+--+-- @+-- dfs [1]    $ 'edge' 1 1                == [1]+-- dfs [1]    $ 'edge' 1 2                == [1, 2]+-- dfs [2]    $ 'edge' 1 2                == [2]+-- dfs [3]    $ 'edge' 1 2                == []+-- dfs [1, 2] $ 'edge' 1 2                == [1, 2]+-- dfs [2, 1] $ 'edge' 1 2                == [2, 1]+-- dfs []     $ x                       == []+-- dfs [1, 4] $ 3 * (1 + 4) * (1 + 5)   == [1, 5, 4]+-- 'isSubgraphOf' ('vertices' $ dfs vs x) x == True+-- @+dfs :: [Int] -> IntAdjacencyMap -> [Int]+dfs vs = concatMap flatten . dfsForestFrom vs+ -- | Compute the /topological sort/ of a graph or return @Nothing@ if the graph -- is cyclic. --@@ -556,10 +620,10 @@ -- fmap (flip 'isTopSort' x) (topSort x) /= Just False -- @ topSort :: IntAdjacencyMap -> Maybe [Int]-topSort m = if isTopSort result m then Just result else Nothing+topSort m@(AM _ (GraphKL g r _)) =+    if isTopSort result m then Just result else Nothing   where-    GraphKL g r = graphKL m-    result      = map r (KL.topSort g)+    result = map r (KL.topSort g)  -- | Check if a given list of vertices is a valid /topological sort/ of a graph. --@@ -576,36 +640,4 @@   where     go seen []     = seen == IntMap.keysSet (adjacencyMap m)     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)+        in postIntSet v m `IntSet.intersection` newSeen == IntSet.empty && go newSeen vs

@@ -12,7 +12,10 @@ ----------------------------------------------------------------------------- module Algebra.Graph.IntAdjacencyMap.Internal (     -- * Adjacency map implementation-    IntAdjacencyMap (..), consistent+    IntAdjacencyMap (..), mkAM, consistent,++    -- * Interoperability with King-Launchbury graphs+    GraphKL (..), mkGraphKL   ) where  import Data.IntMap.Strict (IntMap, keysSet, fromSet)@@ -20,6 +23,7 @@  import Algebra.Graph.Class +import qualified Data.Graph         as KL import qualified Data.IntMap.Strict as IntMap import qualified Data.IntSet        as IntSet @@ -83,14 +87,25 @@ When specifying the time and memory complexity of graph algorithms, /n/ and /m/ will denote the number of vertices and edges in the graph, respectively. -}-newtype IntAdjacencyMap = IntAdjacencyMap {+data IntAdjacencyMap = AM {     -- | The /adjacency map/ of the graph: each vertex is associated with a set     -- of its direct successors.-    adjacencyMap :: IntMap IntSet-  } deriving Eq+    adjacencyMap :: !(IntMap IntSet),+    -- | Cached King-Launchbury representation.+    -- /Note: this field is for internal use only/.+    graphKL :: GraphKL } +-- | Construct an 'AdjacencyMap' from a map of successor sets and (lazily)+-- compute the corresponding King-Launchbury representation.+-- /Note: this function is for internal use only/.+mkAM :: IntMap IntSet -> IntAdjacencyMap+mkAM m = AM m (mkGraphKL m)++instance Eq IntAdjacencyMap where+    x == y = adjacencyMap x == adjacencyMap y+ instance Show IntAdjacencyMap where-    show (IntAdjacencyMap m)+    show (AM m _)         | m == IntMap.empty = "empty"         | es == []          = if IntSet.size vs > 1 then "vertices " ++ show (IntSet.toAscList vs)                                                     else "vertex "   ++ show v@@ -106,10 +121,10 @@  instance Graph IntAdjacencyMap where     type Vertex IntAdjacencyMap = Int-    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,+    empty       = mkAM $ IntMap.empty+    vertex x    = mkAM $ IntMap.singleton x IntSet.empty+    overlay x y = mkAM $ IntMap.unionWith IntSet.union (adjacencyMap x) (adjacencyMap y)+    connect x y = mkAM $ IntMap.unionsWith IntSet.union [ adjacencyMap x, adjacencyMap y,         fromSet (const . keysSet $ adjacencyMap y) (keysSet $ adjacencyMap x) ]  instance Num IntAdjacencyMap where@@ -120,6 +135,10 @@     abs         = id     negate      = id +instance ToGraph IntAdjacencyMap where+    type ToVertex IntAdjacencyMap = Int+    toGraph = overlays . map (uncurry star . fmap IntSet.toList) . IntMap.toList . adjacencyMap+ -- | 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.@@ -136,7 +155,7 @@ -- consistent ('Algebra.Graph.IntAdjacencyMap.fromAdjacencyList' xs) == True -- @ consistent :: IntAdjacencyMap -> Bool-consistent (IntAdjacencyMap m) = referredToVertexSet m `IntSet.isSubsetOf` keysSet m+consistent (AM m _) = referredToVertexSet m `IntSet.isSubsetOf` keysSet m  -- The set of vertices that are referred to by the edges referredToVertexSet :: IntMap IntSet -> IntSet@@ -145,3 +164,32 @@ -- 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 ]++-- | 'GraphKL' encapsulates King-Launchbury graphs, which are implemented in+-- the "Data.Graph" module of the @containers@ library.+-- /Note: this data structure is for internal use only/.+--+-- If @mkGraphKL (adjacencyMap g) == h@ then the following holds:+--+-- @+-- map ('fromVertexKL' h) ('Data.Graph.vertices' $ 'toGraphKL' h)                               == 'Algebra.Graph.AdjacencyMap.vertexList' g+-- map (\\(x, y) -> ('fromVertexKL' h x, 'fromVertexKL' h y)) ('Data.Graph.edges' $ 'toGraphKL' h) == 'Algebra.Graph.AdjacencyMap.edgeList' g+-- @+data GraphKL = GraphKL {+    -- | Array-based graph representation (King and Launchbury, 1995).+    toGraphKL :: KL.Graph,+    -- | A mapping of "Data.Graph.Vertex" to vertices of type @Int@.+    fromVertexKL :: KL.Vertex -> Int,+    -- | A mapping from vertices of type @Int@ to "Data.Graph.Vertex".+    -- Returns 'Nothing' if the argument is not in the graph.+    toVertexKL :: Int -> Maybe KL.Vertex }++-- | Build 'GraphKL' from a map of successor sets.+-- /Note: this function is for internal use only/.+mkGraphKL :: IntMap IntSet -> GraphKL+mkGraphKL m = GraphKL+    { toGraphKL    = g+    , fromVertexKL = \u -> case r u of (_, v, _) -> v+    , toVertexKL   = t }+  where+    (g, r, t) = KL.graphFromEdges [ ((), v, IntSet.toAscList us) | (v, us) <- IntMap.toAscList m ]

@@ -27,7 +27,7 @@      -- * Graph properties     isEmpty, hasVertex, hasEdge, vertexCount, edgeCount, vertexList, edgeList,-    vertexSet, vertexIntSet, edgeSet, preset, postset,+    vertexSet, vertexIntSet, edgeSet, preSet, postSet,      -- * Standard families of graphs     path, circuit, clique, biclique, star, tree, forest,@@ -248,6 +248,7 @@ -- hasEdge x y ('vertex' z)       == False -- hasEdge x y ('edge' x y)       == True -- hasEdge x y . 'removeEdge' x y == const False+-- hasEdge x y                  == 'elem' (x,y) . 'edgeList' -- @ hasEdge :: Ord a => a -> a -> Relation a -> Bool hasEdge x y = Set.member (x, y) . relation@@ -260,7 +261,7 @@ -- vertexCount ('vertex' x) == 1 -- vertexCount            == 'length' . 'vertexList' -- @-vertexCount :: Ord a => Relation a -> Int+vertexCount :: Relation a -> Int vertexCount = Set.size . domain  -- | The number of edges in a graph.@@ -272,7 +273,7 @@ -- edgeCount ('edge' x y) == 1 -- edgeCount            == 'length' . 'edgeList' -- @-edgeCount :: Ord a => Relation a -> Int+edgeCount :: Relation a -> Int edgeCount = Set.size . relation  -- | The sorted list of vertices of a given graph.@@ -283,7 +284,7 @@ -- vertexList ('vertex' x) == [x] -- vertexList . 'vertices' == 'Data.List.nub' . 'Data.List.sort' -- @-vertexList :: Ord a => Relation a -> [a]+vertexList :: Relation a -> [a] vertexList = Set.toAscList . domain  -- | The sorted list of edges of a graph.@@ -297,7 +298,7 @@ -- 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 :: Relation a -> [(a, a)] edgeList = Set.toAscList . relation  -- | The set of vertices of a given graph.@@ -309,7 +310,7 @@ -- vertexSet . 'vertices' == Set.'Set.fromList' -- vertexSet . 'clique'   == Set.'Set.fromList' -- @-vertexSet :: Ord a => Relation a -> Set.Set a+vertexSet :: Relation a -> Set.Set a vertexSet = domain  -- | The set of vertices of a given graph. Like 'vertexSet' but specialised for@@ -334,36 +335,36 @@ -- edgeSet ('edge' x y) == Set.'Set.singleton' (x,y) -- edgeSet . 'edges'    == Set.'Set.fromList' -- @-edgeSet :: Ord a => Relation a -> Set.Set (a, a)+edgeSet :: 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+-- 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 x 'empty'      == Set.'Set.empty'+-- preSet x ('vertex' x) == Set.'Set.empty'+-- preSet 1 ('edge' 1 2) == Set.'Set.empty'+-- preSet y ('edge' x y) == Set.'Set.fromList' [x] -- @-preset :: Ord a => a -> Relation a -> Set.Set a-preset x = Set.mapMonotonic fst . Set.filter ((== x) . snd) . relation+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+-- 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 x 'empty'      == Set.'Set.empty'+-- postSet x ('vertex' x) == Set.'Set.empty'+-- postSet x ('edge' x y) == Set.'Set.fromList' [y]+-- postSet 2 ('edge' 1 2) == Set.'Set.empty' -- @-postset :: Ord a => a -> Relation a -> Set.Set a-postset x = Set.mapMonotonic snd . Set.filter ((== x) . fst) . relation+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.@@ -393,11 +394,12 @@ -- 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 . 'reverse' == 'transpose' . clique+-- clique []         == 'empty'+-- clique [x]        == 'vertex' x+-- clique [x,y]      == 'edge' x y+-- clique [x,y,z]    == 'edges' [(x,y), (x,z), (y,z)]+-- clique (xs ++ ys) == 'connect' (clique xs) (clique ys)+-- clique . 'reverse'  == 'transpose' . clique -- @ clique :: Ord a => [a] -> Relation a clique = C.clique@@ -531,7 +533,7 @@ -- gmap id           == id -- gmap f . gmap g   == gmap (f . g) -- @-gmap :: (Ord a, Ord b) => (a -> b) -> Relation a -> Relation b+gmap :: 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@@ -546,7 +548,7 @@ -- 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 :: (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@@ -569,7 +571,7 @@ 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 ]+    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.

@@ -123,6 +123,10 @@     abs         = id     negate      = id +instance ToGraph (Relation a) where+    type ToVertex (Relation a) = a+    toGraph (Relation d r) = graph (Set.toList d) (Set.toList r)+ -- | Check if the internal representation of a relation is consistent, i.e. if all -- 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

@@ -43,4 +43,4 @@ -- neighbours y ('Algebra.Graph.Class.edge' x y) == Set.'Set.fromList' [x] -- @ neighbours :: Ord a => a -> SymmetricRelation a -> Set.Set a-neighbours x = preset x . toRelation+neighbours x = postSet x . toRelation

@@ -83,12 +83,12 @@     , forAll arbitrary (\v -> vertex v `asTypeOf` x == vertex v * vertex v)                                                 // "Vertex self-loop" ] -transitiveAxioms :: Eq g => GraphTestsuite g+transitiveAxioms :: GraphTestsuite g transitiveAxioms x y z = conjoin     [ axioms x y z     , y == empty || x * y * z == x * y + y * z  // "Closure" ] -preorderAxioms :: (Arbitrary (Vertex g), Eq g, Show (Vertex g)) => GraphTestsuite g+preorderAxioms :: (Arbitrary (Vertex g), Show (Vertex g)) => GraphTestsuite g preorderAxioms x y z = conjoin     [ axioms x y z     , forAll arbitrary (\v -> vertex v `asTypeOf` x == vertex v * vertex v)

@@ -0,0 +1,340 @@+{-# LANGUAGE ConstrainedClassMethods, RankNTypes #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Algebra.Graph.Test.API+-- Copyright  : (c) Andrey Mokhov 2016-2017+-- License    : MIT (see the file LICENSE)+-- Maintainer : andrey.mokhov@gmail.com+-- Stability  : experimental+--+-- Graph manipulation API used for generic testing.+-----------------------------------------------------------------------------+module Algebra.Graph.Test.API (+    -- * Graph manipulation API+    GraphAPI (..)+  ) where++import Data.IntSet (IntSet)+import Data.Set (Set)+import Data.Tree++import Algebra.Graph.Class++import qualified Algebra.Graph.AdjacencyMap    as AdjacencyMap+import qualified Algebra.Graph.Fold            as Fold+import qualified Algebra.Graph                 as Graph+import qualified Algebra.Graph.IntAdjacencyMap as IntAdjacencyMap+import qualified Algebra.Graph.Relation        as Relation+import qualified Data.Set                      as Set+import qualified Data.IntSet                   as IntSet++class Graph g => GraphAPI g where+    edge              :: Vertex g -> Vertex g -> g+    edge              = notImplemented+    vertices          :: [Vertex g] -> g+    vertices          = notImplemented+    edges             :: [(Vertex g, Vertex g)] -> g+    edges             = notImplemented+    overlays          :: [g] -> g+    overlays          = notImplemented+    connects          :: [g] -> g+    connects          = notImplemented+    graph             :: [Vertex g] -> [(Vertex g, Vertex g)] -> g+    graph             = notImplemented+    fromAdjacencyList :: [(Vertex g, [Vertex g])] -> g+    fromAdjacencyList = notImplemented+    foldg             :: r -> (Vertex g -> r) -> (r -> r -> r) -> (r -> r -> r) -> g -> r+    foldg             = notImplemented+    isSubgraphOf      :: g -> g -> Bool+    isSubgraphOf      = notImplemented+    (===)             :: g -> g -> Bool+    (===)             = notImplemented+    isEmpty           :: g -> Bool+    isEmpty           = notImplemented+    size              :: g -> Int+    size              = notImplemented+    hasVertex         :: Vertex g -> g -> Bool+    hasVertex         = notImplemented+    hasEdge           :: Vertex g -> Vertex g -> g -> Bool+    hasEdge           = notImplemented+    vertexCount       :: g -> Int+    vertexCount       = notImplemented+    edgeCount         :: g -> Int+    edgeCount         = notImplemented+    vertexList        :: g -> [Vertex g]+    vertexList        = notImplemented+    edgeList          :: g -> [(Vertex g, Vertex g)]+    edgeList          = notImplemented+    adjacencyList     :: g -> [(Vertex g, [Vertex g])]+    adjacencyList     = notImplemented+    vertexSet         :: g -> Set (Vertex g)+    vertexSet         = notImplemented+    vertexIntSet      :: Vertex g ~ Int => g -> IntSet+    vertexIntSet      = notImplemented+    edgeSet           :: g -> Set (Vertex g, Vertex g)+    edgeSet           = notImplemented+    preSet            :: Vertex g -> g -> Set (Vertex g)+    preSet            = notImplemented+    postSet           :: Vertex g -> g -> Set (Vertex g)+    postSet           = notImplemented+    postIntSet        :: Vertex g ~ Int => Int -> g -> IntSet+    postIntSet        = notImplemented+    path              :: [Vertex g] -> g+    path              = notImplemented+    circuit           :: [Vertex g] -> g+    circuit           = notImplemented+    clique            :: [Vertex g] -> g+    clique            = notImplemented+    biclique          :: [Vertex g] -> [Vertex g] -> g+    biclique          = notImplemented+    star              :: Vertex g -> [Vertex g] -> g+    star              = notImplemented+    tree              :: Tree (Vertex g) -> g+    tree              = notImplemented+    forest            :: Forest (Vertex g) -> g+    forest            = notImplemented+    mesh              :: Vertex g ~ (a, b) => [a] -> [b] -> g+    mesh              = notImplemented+    torus             :: Vertex g ~ (a, b) => [a] -> [b] -> g+    torus             = notImplemented+    deBruijn          :: Vertex g ~ [a] => Int -> [a] -> g+    deBruijn          = notImplemented+    removeVertex      :: Vertex g -> g -> g+    removeVertex      = notImplemented+    removeEdge        :: Vertex g -> Vertex g -> g -> g+    removeEdge        = notImplemented+    replaceVertex     :: Vertex g -> Vertex g -> g -> g+    replaceVertex     = notImplemented+    mergeVertices     :: (Vertex g -> Bool) -> Vertex g -> g -> g+    mergeVertices     = notImplemented+    splitVertex       :: Vertex g -> [Vertex g] -> g -> g+    splitVertex       = notImplemented+    transpose         :: g -> g+    transpose         = notImplemented+    gmap              :: Vertex g ~ Int => (Int -> Int) -> g -> g+    gmap              = notImplemented+    induce            :: (Vertex g -> Bool) -> g -> g+    induce            = notImplemented+    bind              :: Vertex g ~ Int => g -> (Int -> g) -> g+    bind              = notImplemented+    simplify          :: g -> g+    simplify          = notImplemented+    box               :: forall a b f. (Vertex (f a) ~ a, Vertex (f b) ~ b, Vertex (f (a, b)) ~ (a, b), g ~ f (a, b)) => f a -> f b -> f (a, b)+    box               = notImplemented+    dfsForest         :: g -> Forest (Vertex g)+    dfsForest         = notImplemented+    dfsForestFrom     :: [Vertex g] -> g -> Forest (Vertex g)+    dfsForestFrom     = notImplemented+    dfs               :: [Vertex g] -> g -> [Vertex g]+    dfs               = notImplemented+    topSort           :: g -> Maybe [Vertex g]+    topSort           = notImplemented+    isTopSort         :: [Vertex g] -> g -> Bool+    isTopSort         = notImplemented++notImplemented :: a+notImplemented = error "Not implemented"++instance Ord a => GraphAPI (AdjacencyMap.AdjacencyMap a) where+    edge              = AdjacencyMap.edge+    vertices          = AdjacencyMap.vertices+    edges             = AdjacencyMap.edges+    overlays          = AdjacencyMap.overlays+    connects          = AdjacencyMap.connects+    graph             = AdjacencyMap.graph+    fromAdjacencyList = AdjacencyMap.fromAdjacencyList+    isSubgraphOf      = AdjacencyMap.isSubgraphOf+    isEmpty           = AdjacencyMap.isEmpty+    hasVertex         = AdjacencyMap.hasVertex+    hasEdge           = AdjacencyMap.hasEdge+    vertexCount       = AdjacencyMap.vertexCount+    edgeCount         = AdjacencyMap.edgeCount+    vertexList        = AdjacencyMap.vertexList+    edgeList          = AdjacencyMap.edgeList+    adjacencyList     = AdjacencyMap.adjacencyList+    vertexSet         = AdjacencyMap.vertexSet+    vertexIntSet      = IntSet.fromAscList . Set.toAscList . AdjacencyMap.vertexSet+    edgeSet           = AdjacencyMap.edgeSet+    postSet           = AdjacencyMap.postSet+    path              = AdjacencyMap.path+    circuit           = AdjacencyMap.circuit+    clique            = AdjacencyMap.clique+    biclique          = AdjacencyMap.biclique+    star              = AdjacencyMap.star+    tree              = AdjacencyMap.tree+    forest            = AdjacencyMap.forest+    removeVertex      = AdjacencyMap.removeVertex+    removeEdge        = AdjacencyMap.removeEdge+    replaceVertex     = AdjacencyMap.replaceVertex+    mergeVertices     = AdjacencyMap.mergeVertices+    transpose         = AdjacencyMap.transpose+    gmap              = AdjacencyMap.gmap+    induce            = AdjacencyMap.induce+    dfsForest         = AdjacencyMap.dfsForest+    dfsForestFrom     = AdjacencyMap.dfsForestFrom+    dfs               = AdjacencyMap.dfs+    topSort           = AdjacencyMap.topSort+    isTopSort         = AdjacencyMap.isTopSort++instance Ord a => GraphAPI (Fold.Fold a) where+    edge          = Fold.edge+    vertices      = Fold.vertices+    edges         = Fold.edges+    overlays      = Fold.overlays+    connects      = Fold.connects+    graph         = Fold.graph+    foldg         = Fold.foldg+    isSubgraphOf  = Fold.isSubgraphOf+    isEmpty       = Fold.isEmpty+    size          = Fold.size+    hasVertex     = Fold.hasVertex+    hasEdge       = Fold.hasEdge+    vertexCount   = Fold.vertexCount+    edgeCount     = Fold.edgeCount+    vertexList    = Fold.vertexList+    edgeList      = Fold.edgeList+    vertexSet     = Fold.vertexSet+    vertexIntSet  = Fold.vertexIntSet+    edgeSet       = Fold.edgeSet+    path          = Fold.path+    circuit       = Fold.circuit+    clique        = Fold.clique+    biclique      = Fold.biclique+    star          = Fold.star+    tree          = Fold.tree+    forest        = Fold.forest+    mesh          = Fold.mesh+    torus         = Fold.torus+    deBruijn      = Fold.deBruijn+    removeVertex  = Fold.removeVertex+    removeEdge    = Fold.removeEdge+    replaceVertex = Fold.replaceVertex+    mergeVertices = Fold.mergeVertices+    splitVertex   = Fold.splitVertex+    transpose     = Fold.transpose+    gmap          = fmap+    induce        = Fold.induce+    bind          = (>>=)+    simplify      = Fold.simplify+    box           = Fold.box++instance Ord a => GraphAPI (Graph.Graph a) where+    edge          = Graph.edge+    vertices      = Graph.vertices+    edges         = Graph.edges+    overlays      = Graph.overlays+    connects      = Graph.connects+    graph         = Graph.graph+    foldg         = Graph.foldg+    isSubgraphOf  = Graph.isSubgraphOf+    (===)         = (Graph.===)+    isEmpty       = Graph.isEmpty+    size          = Graph.size+    hasVertex     = Graph.hasVertex+    hasEdge       = Graph.hasEdge+    vertexCount   = Graph.vertexCount+    edgeCount     = Graph.edgeCount+    vertexList    = Graph.vertexList+    edgeList      = Graph.edgeList+    vertexSet     = Graph.vertexSet+    vertexIntSet  = Graph.vertexIntSet+    edgeSet       = Graph.edgeSet+    path          = Graph.path+    circuit       = Graph.circuit+    clique        = Graph.clique+    biclique      = Graph.biclique+    star          = Graph.star+    tree          = Graph.tree+    forest        = Graph.forest+    mesh          = Graph.mesh+    torus         = Graph.torus+    deBruijn      = Graph.deBruijn+    removeVertex  = Graph.removeVertex+    removeEdge    = Graph.removeEdge+    replaceVertex = Graph.replaceVertex+    mergeVertices = Graph.mergeVertices+    splitVertex   = Graph.splitVertex+    transpose     = Graph.transpose+    gmap          = fmap+    induce        = Graph.induce+    bind          = (>>=)+    simplify      = Graph.simplify+    box           = Graph.box++instance GraphAPI IntAdjacencyMap.IntAdjacencyMap where+    edge              = IntAdjacencyMap.edge+    vertices          = IntAdjacencyMap.vertices+    edges             = IntAdjacencyMap.edges+    overlays          = IntAdjacencyMap.overlays+    connects          = IntAdjacencyMap.connects+    graph             = IntAdjacencyMap.graph+    fromAdjacencyList = IntAdjacencyMap.fromAdjacencyList+    isSubgraphOf      = IntAdjacencyMap.isSubgraphOf+    isEmpty           = IntAdjacencyMap.isEmpty+    hasVertex         = IntAdjacencyMap.hasVertex+    hasEdge           = IntAdjacencyMap.hasEdge+    vertexCount       = IntAdjacencyMap.vertexCount+    edgeCount         = IntAdjacencyMap.edgeCount+    vertexList        = IntAdjacencyMap.vertexList+    edgeList          = IntAdjacencyMap.edgeList+    postIntSet        = IntAdjacencyMap.postIntSet+    adjacencyList     = IntAdjacencyMap.adjacencyList+    vertexSet         = Set.fromAscList . IntSet.toAscList . IntAdjacencyMap.vertexIntSet+    vertexIntSet      = IntAdjacencyMap.vertexIntSet+    edgeSet           = IntAdjacencyMap.edgeSet+    path              = IntAdjacencyMap.path+    circuit           = IntAdjacencyMap.circuit+    clique            = IntAdjacencyMap.clique+    biclique          = IntAdjacencyMap.biclique+    star              = IntAdjacencyMap.star+    tree              = IntAdjacencyMap.tree+    forest            = IntAdjacencyMap.forest+    removeVertex      = IntAdjacencyMap.removeVertex+    removeEdge        = IntAdjacencyMap.removeEdge+    replaceVertex     = IntAdjacencyMap.replaceVertex+    mergeVertices     = IntAdjacencyMap.mergeVertices+    transpose         = IntAdjacencyMap.transpose+    gmap              = IntAdjacencyMap.gmap+    induce            = IntAdjacencyMap.induce+    dfsForest         = IntAdjacencyMap.dfsForest+    dfsForestFrom     = IntAdjacencyMap.dfsForestFrom+    dfs               = IntAdjacencyMap.dfs+    topSort           = IntAdjacencyMap.topSort+    isTopSort         = IntAdjacencyMap.isTopSort++instance Ord a => GraphAPI (Relation.Relation a) where+    edge              = Relation.edge+    vertices          = Relation.vertices+    edges             = Relation.edges+    overlays          = Relation.overlays+    connects          = Relation.connects+    graph             = Relation.graph+    fromAdjacencyList = Relation.fromAdjacencyList+    isSubgraphOf      = Relation.isSubgraphOf+    isEmpty           = Relation.isEmpty+    hasVertex         = Relation.hasVertex+    hasEdge           = Relation.hasEdge+    vertexCount       = Relation.vertexCount+    edgeCount         = Relation.edgeCount+    vertexList        = Relation.vertexList+    edgeList          = Relation.edgeList+    preSet            = Relation.preSet+    postSet           = Relation.postSet+    adjacencyList     = AdjacencyMap.adjacencyList . toGraph+    vertexSet         = Relation.vertexSet+    vertexIntSet      = IntSet.fromAscList . Set.toAscList . Relation.vertexSet+    edgeSet           = Relation.edgeSet+    path              = Relation.path+    circuit           = Relation.circuit+    clique            = Relation.clique+    biclique          = Relation.biclique+    star              = Relation.star+    tree              = Relation.tree+    forest            = Relation.forest+    removeVertex      = Relation.removeVertex+    removeEdge        = Relation.removeEdge+    replaceVertex     = Relation.replaceVertex+    mergeVertices     = Relation.mergeVertices+    transpose         = Relation.transpose+    gmap              = Relation.gmap+    induce            = Relation.induce

@@ -1,4 +1,3 @@-{-# LANGUAGE ViewPatterns #-} ----------------------------------------------------------------------------- -- | -- Module     : Algebra.Graph.Test.AdjacencyMap@@ -7,26 +6,25 @@ -- Maintainer : andrey.mokhov@gmail.com -- Stability  : experimental ----- Testsuite for 'AdjacencyMap'.---+-- Testsuite for "Algebra.Graph.AdjacencyMap". ----------------------------------------------------------------------------- module Algebra.Graph.Test.AdjacencyMap (     -- * Testsuite     testAdjacencyMap   ) where -import Data.Tree- import Algebra.Graph.AdjacencyMap import Algebra.Graph.AdjacencyMap.Internal import Algebra.Graph.Test+import Algebra.Graph.Test.Generic  import qualified Data.Graph as KL import qualified Data.Set   as Set +t :: Testsuite+t = testsuite "AdjacencyMap." empty+ type AI = AdjacencyMap Int-type II = Int -> Int-type IB = Int -> Bool  testAdjacencyMap :: IO () testAdjacencyMap = do@@ -39,578 +37,20 @@     test "Consistency of fromAdjacencyList" $ \xs ->         consistent (fromAdjacencyList xs :: AI) -    putStrLn "\n============ AdjacencyMap.Show ============"-    test "show (empty     :: AdjacencyMap Int) == \"empty\"" $-          show (empty     :: AdjacencyMap Int) == "empty"--    test "show (1         :: AdjacencyMap Int) == \"vertex 1\"" $-          show (1         :: AdjacencyMap Int) == "vertex 1"--    test "show (1 + 2     :: AdjacencyMap Int) == \"vertices [1,2]\"" $-          show (1 + 2     :: AdjacencyMap Int) == "vertices [1,2]"--    test "show (1 * 2     :: AdjacencyMap Int) == \"edge 1 2\"" $-          show (1 * 2     :: AdjacencyMap Int) == "edge 1 2"--    test "show (1 * 2 * 3 :: AdjacencyMap Int) == \"edges [(1,2),(1,3),(2,3)]\"" $-          show (1 * 2 * 3 :: AdjacencyMap Int) == "edges [(1,2),(1,3),(2,3)]"--    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============ AdjacencyMap.empty ============"-    test "isEmpty     empty == True" $-          isEmpty    (empty :: AI) == True--    test "hasVertex x empty == False" $ \(x :: Int) ->-          hasVertex x empty == False--    test "vertexCount empty == 0" $-          vertexCount(empty :: AI) == 0--    test "edgeCount   empty == 0" $-          edgeCount  (empty :: AI) == 0--    putStrLn "\n============ AdjacencyMap.vertex ============"-    test "isEmpty     (vertex x) == False" $ \(x :: Int) ->-          isEmpty     (vertex x) == False--    test "hasVertex x (vertex x) == True" $ \(x :: Int) ->-          hasVertex x (vertex x) == True--    test "hasVertex 1 (vertex 2) == False" $-          hasVertex 1 (vertex 2 :: AI) == False--    test "vertexCount (vertex x) == 1" $ \(x :: Int) ->-          vertexCount (vertex x) == 1--    test "edgeCount   (vertex x) == 0" $ \(x :: Int) ->-          edgeCount   (vertex x) == 0--    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)--    test "hasEdge x y (edge x y) == True" $ \(x :: Int) y ->-          hasEdge x y (edge x y) == True--    test "edgeCount   (edge x y) == 1" $ \(x :: Int) y ->-          edgeCount   (edge x y) == 1--    test "vertexCount (edge 1 1) == 1" $-          vertexCount (edge 1 1 :: AI) == 1--    test "vertexCount (edge 1 2) == 2" $-          vertexCount (edge 1 2 :: AI) == 2--    putStrLn "\n============ AdjacencyMap.overlay ============"-    test "isEmpty     (overlay x y) == isEmpty   x   && isEmpty   y" $ \(x :: AI) y ->-          isEmpty     (overlay x y) == (isEmpty   x   && isEmpty   y)--    test "hasVertex z (overlay x y) == hasVertex z x || hasVertex z y" $ \(x :: AI) y z ->-          hasVertex z (overlay x y) == (hasVertex z x || hasVertex z y)--    test "vertexCount (overlay x y) >= vertexCount x" $ \(x :: AI) y ->-          vertexCount (overlay x y) >= vertexCount x--    test "vertexCount (overlay x y) <= vertexCount x + vertexCount y" $ \(x :: AI) y ->-          vertexCount (overlay x y) <= vertexCount x + vertexCount y--    test "edgeCount   (overlay x y) >= edgeCount x" $ \(x :: AI) y ->-          edgeCount   (overlay x y) >= edgeCount x--    test "edgeCount   (overlay x y) <= edgeCount x   + edgeCount y" $ \(x :: AI) y ->-          edgeCount   (overlay x y) <= edgeCount x   + edgeCount y--    test "vertexCount (overlay 1 2) == 2" $-          vertexCount (overlay 1 2 :: AI) == 2--    test "edgeCount   (overlay 1 2) == 0" $-          edgeCount   (overlay 1 2 :: AI) == 0--    putStrLn "\n============ AdjacencyMap.connect ============"-    test "isEmpty     (connect x y) == isEmpty   x   && isEmpty   y" $ \(x :: AI) y ->-          isEmpty     (connect x y) == (isEmpty   x   && isEmpty   y)--    test "hasVertex z (connect x y) == hasVertex z x || hasVertex z y" $ \(x :: AI) y z ->-          hasVertex z (connect x y) == (hasVertex z x || hasVertex z y)--    test "vertexCount (connect x y) >= vertexCount x" $ \(x :: AI) y ->-          vertexCount (connect x y) >= vertexCount x--    test "vertexCount (connect x y) <= vertexCount x + vertexCount y" $ \(x :: AI) y ->-          vertexCount (connect x y) <= vertexCount x + vertexCount y--    test "edgeCount   (connect x y) >= edgeCount x" $ \(x :: AI) y ->-          edgeCount   (connect x y) >= edgeCount x--    test "edgeCount   (connect x y) >= edgeCount y" $ \(x :: AI) y ->-          edgeCount   (connect x y) >= edgeCount y--    test "edgeCount   (connect x y) >= vertexCount x * vertexCount y" $ \(x :: AI) y ->-          edgeCount   (connect x y) >= vertexCount x * vertexCount y--    test "edgeCount   (connect x y) <= vertexCount x * vertexCount y + edgeCount x + edgeCount y" $ \(x :: AI) y ->-          edgeCount   (connect x y) <= vertexCount x * vertexCount y + edgeCount x + edgeCount y--    test "vertexCount (connect 1 2) == 2" $-          vertexCount (connect 1 2 :: AI) == 2--    test "edgeCount   (connect 1 2) == 1" $-          edgeCount   (connect 1 2 :: AI) == 1--    putStrLn "\n============ AdjacencyMap.vertices ============"-    test "vertices []            == empty" $-          vertices []            == (empty :: AI)--    test "vertices [x]           == vertex x" $ \(x :: Int) ->-          vertices [x]           == (vertex x :: AI)--    test "hasVertex x . vertices == elem x" $ \x (xs :: [Int]) ->-         (hasVertex x . vertices) xs == elem x xs--    test "vertexCount . vertices == length . nub" $ \(xs :: [Int]) ->-         (vertexCount . vertices) xs == (length . nubOrd) xs--    test "vertexSet   . vertices == Set.fromList" $ \(xs :: [Int]) ->-         (vertexSet   . vertices) xs == Set.fromList xs--    putStrLn "\n============ AdjacencyMap.edges ============"-    test "edges []          == empty" $-          edges []          == (empty :: AI)--    test "edges [(x,y)]     == edge x y" $ \(x :: Int) y ->-          edges [(x,y)]     == (edge x y :: AI)--    test "edgeCount . edges == length . nub" $ \(xs :: [(Int, Int)]) ->-         (edgeCount . edges) xs == (length . nubOrd) xs--    putStrLn "\n============ AdjacencyMap.overlays ============"-    test "overlays []        == empty" $-          overlays []        == (empty :: AI)--    test "overlays [x]       == x" $ \(x :: AI) ->-          overlays [x]       == x--    test "overlays [x,y]     == overlay x y" $ \(x :: AI) y ->-          overlays [x,y]     == overlay x y--    test "isEmpty . overlays == all isEmpty" $ mapSize (min 10) $ \(xs :: [AI]) ->-         (isEmpty . overlays) xs == all isEmpty xs--    putStrLn "\n============ AdjacencyMap.connects ============"-    test "connects []        == empty" $-          connects []        == (empty :: AI)--    test "connects [x]       == x" $ \(x :: AI) ->-          connects [x]       == x--    test "connects [x,y]     == connect x y" $ \(x :: AI) y ->-          connects [x,y]     == connect x y--    test "isEmpty . connects == all isEmpty" $ mapSize (min 10) $ \(xs :: [AI]) ->-         (isEmpty . connects) xs == all isEmpty xs--    putStrLn "\n============ AdjacencyMap.graph ============"-    test "graph []  []      == empty" $-          graph []  []      == (empty :: AI)--    test "graph [x] []      == vertex x" $ \(x :: Int) ->-          graph [x] []      == (vertex x :: AI)--    test "graph []  [(x,y)] == edge x y" $ \(x :: Int) y ->-          graph []  [(x,y)] == (edge x y :: AI)--    test "graph vs  es      == overlay (vertices vs) (edges es)" $ \(vs :: [Int]) es ->-          graph vs  es      == (overlay (vertices vs) (edges es) :: AI)--    putStrLn "\n============ AdjacencyMap.fromAdjacencyList ============"-    test "fromAdjacencyList []                                  == empty" $-          fromAdjacencyList []                                  == (empty :: AI)--    test "fromAdjacencyList [(x, [])]                           == vertex x" $ \(x :: Int) ->-          fromAdjacencyList [(x, [])]                           == vertex x--    test "fromAdjacencyList [(x, [y])]                          == edge x y" $ \(x :: Int) y ->-          fromAdjacencyList [(x, [y])]                          == edge x y--    test "fromAdjacencyList . adjacencyList                     == id" $ \(x :: AI) ->-         (fromAdjacencyList . adjacencyList) x                  == x--    test "overlay (fromAdjacencyList xs) (fromAdjacencyList ys) == fromAdjacencyList (xs ++ ys)" $ \xs ys ->-          overlay (fromAdjacencyList xs) (fromAdjacencyList ys) ==(fromAdjacencyList (xs ++ ys) :: AI)--    putStrLn "\n============ AdjacencyMap.isSubgraphOf ============"-    test "isSubgraphOf empty         x             == True" $ \(x :: AI) ->-          isSubgraphOf empty         x             == True--    test "isSubgraphOf (vertex x)    empty         == False" $ \x ->-          isSubgraphOf (vertex x)   (empty :: AI)   == False--    test "isSubgraphOf x             (overlay x y) == True" $ \(x :: AI) y ->-          isSubgraphOf x             (overlay x y) == True--    test "isSubgraphOf (overlay x y) (connect x y) == True" $ \(x :: AI) y ->-          isSubgraphOf (overlay x y) (connect x y) == True--    test "isSubgraphOf (path xs)     (circuit xs)  == True" $ \xs ->-          isSubgraphOf (path xs :: AI)(circuit xs)  == True--    putStrLn "\n============ AdjacencyMap.isEmpty ============"-    test "isEmpty empty                       == True" $-          isEmpty (empty :: AI)                == True--    test "isEmpty (overlay empty empty)       == True" $-          isEmpty (overlay empty empty :: AI)  == True--    test "isEmpty (vertex x)                  == False" $ \(x :: Int) ->-          isEmpty (vertex x)                  == False--    test "isEmpty (removeVertex x $ vertex x) == True" $ \(x :: Int) ->-          isEmpty (removeVertex x $ vertex x) == True--    test "isEmpty (removeEdge x y $ edge x y) == False" $ \(x :: Int) y ->-          isEmpty (removeEdge x y $ edge x y) == False--    putStrLn "\n============ AdjacencyMap.hasVertex ============"-    test "hasVertex x empty            == False" $ \(x :: Int) ->-          hasVertex x empty            == False--    test "hasVertex x (vertex x)       == True" $ \(x :: Int) ->-          hasVertex x (vertex x)       == True--    test "hasVertex x . removeVertex x == const False" $ \(x :: Int) y ->-          hasVertex x (removeVertex x y)==const False y--    putStrLn "\n============ AdjacencyMap.hasEdge ============"-    test "hasEdge x y empty            == False" $ \(x :: Int) y ->-          hasEdge x y empty            == False--    test "hasEdge x y (vertex z)       == False" $ \(x :: Int) y z ->-          hasEdge x y (vertex z)       == False--    test "hasEdge x y (edge x y)       == True" $ \(x :: Int) y ->-          hasEdge x y (edge x y)       == True--    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============ AdjacencyMap.vertexCount ============"-    test "vertexCount empty      == 0" $-          vertexCount (empty :: AI) == 0--    test "vertexCount (vertex x) == 1" $ \(x :: Int) ->-          vertexCount (vertex x) == 1--    test "vertexCount            == length . vertexList" $ \(x :: AI) ->-          vertexCount x          == (length . vertexList) x--    putStrLn "\n============ AdjacencyMap.edgeCount ============"-    test "edgeCount empty      == 0" $-          edgeCount (empty :: AI) == 0--    test "edgeCount (vertex x) == 0" $ \(x :: Int) ->-          edgeCount (vertex x) == 0--    test "edgeCount (edge x y) == 1" $ \(x :: Int) y ->-          edgeCount (edge x y) == 1--    test "edgeCount            == length . edgeList" $ \(x :: AI) ->-          edgeCount x          == (length . edgeList) x--    putStrLn "\n============ AdjacencyMap.vertexList ============"-    test "vertexList empty      == []" $-          vertexList (empty :: AI) == []--    test "vertexList (vertex x) == [x]" $ \(x :: Int) ->-          vertexList (vertex x) == [x]--    test "vertexList . vertices == nub . sort" $ \(xs :: [Int]) ->-         (vertexList . vertices) xs == (nubOrd . sort) xs--    putStrLn "\n============ AdjacencyMap.edgeList ============"-    test "edgeList empty          == []" $-          edgeList (empty :: AI )  == []--    test "edgeList (vertex x)     == []" $ \(x :: Int) ->-          edgeList (vertex x)     == []--    test "edgeList (edge x y)     == [(x,y)]" $ \(x :: Int) y ->-          edgeList (edge x y)     == [(x,y)]--    test "edgeList (star 2 [3,1]) == [(2,1), (2,3)]" $-          edgeList (star 2 [3,1]) == [(2,1), (2,3 :: Int)]--    test "edgeList . edges        == nub . sort" $ \(xs :: [(Int, Int)]) ->-         (edgeList . edges) xs    == (nubOrd . sort) xs--    putStrLn "\n============ AdjacencyMap.adjacencyList ============"-    test "adjacencyList empty          == []" $-          adjacencyList (empty :: AI)  == []--    test "adjacencyList (vertex x)     == [(x, [])]" $ \(x :: Int) ->-          adjacencyList (vertex x)     == [(x, [])]--    test "adjacencyList (edge 1 2)     == [(1, [2]), (2, [])]" $-          adjacencyList (edge 1 (2 :: Int)) == [(1, [2]), (2, [])]--    test "adjacencyList (star 2 [3,1]) == [(1, []), (2, [1,3]), (3, [])]" $-          adjacencyList (star 2 [3,1::Int]) == [(1, []), (2, [1,3]), (3, [])]--    putStrLn "\n============ AdjacencyMap.vertexSet ============"-    test "vertexSet empty      == Set.empty" $-          vertexSet(empty :: AI)== Set.empty--    test "vertexSet . vertex   == Set.singleton" $ \(x :: Int) ->-         (vertexSet . vertex) x== Set.singleton x--    test "vertexSet . vertices == Set.fromList" $ \(xs :: [Int]) ->-         (vertexSet . vertices) xs == Set.fromList xs--    test "vertexSet . clique   == Set.fromList" $ \(xs :: [Int]) ->-         (vertexSet . clique) xs == Set.fromList xs--    putStrLn "\n============ AdjacencyMap.edgeSet ============"-    test "edgeSet empty      == Set.empty" $-          edgeSet (empty :: AI) == Set.empty--    test "edgeSet (vertex x) == Set.empty" $ \(x :: Int) ->-          edgeSet (vertex x) == Set.empty--    test "edgeSet (edge x y) == Set.singleton (x,y)" $ \(x :: Int) y ->-          edgeSet (edge x y) == Set.singleton (x,y)--    test "edgeSet . edges    == Set.fromList" $ \(xs :: [(Int, Int)]) ->-         (edgeSet . edges) xs== Set.fromList xs--    putStrLn "\n============ AdjacencyMap.postset ============"-    test "postset x empty      == Set.empty" $ \(x :: Int) ->-          postset x empty      == Set.empty--    test "postset x (vertex x) == Set.empty" $ \(x :: Int) ->-          postset x (vertex x) == Set.empty--    test "postset x (edge x y) == Set.fromList [y]" $ \(x :: Int) y ->-          postset x (edge x y) == Set.fromList [y]--    test "postset 2 (edge 1 2) == Set.empty" $-          postset 2 (edge 1 2) ==(Set.empty :: Set.Set Int)--    putStrLn "\n============ AdjacencyMap.path ============"-    test "path []    == empty" $-          path []    == (empty :: AI)--    test "path [x]   == vertex x" $ \(x :: Int) ->-          path [x]   == (vertex x :: AI)--    test "path [x,y] == edge x y" $ \(x :: Int) y ->-          path [x,y] == (edge x y :: AI)--    putStrLn "\n============ AdjacencyMap.circuit ============"-    test "circuit []    == empty" $-          circuit []    == (empty :: AI)--    test "circuit [x]   == edge x x" $ \(x :: Int) ->-          circuit [x]   == (edge x x :: AI)--    test "circuit [x,y] == edges [(x,y), (y,x)]" $ \(x :: Int) y ->-          circuit [x,y] == (edges [(x,y), (y,x)] :: AI)--    putStrLn "\n============ AdjacencyMap.clique ============"-    test "clique []      == empty" $-          clique []      == (empty :: AI)--    test "clique [x]     == vertex x" $ \(x :: Int) ->-          clique [x]     == (vertex x :: AI)--    test "clique [x,y]   == edge x y" $ \(x :: Int) y ->-          clique [x,y]   == (edge x y :: AI)--    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============ AdjacencyMap.biclique ============"-    test "biclique []      []      == empty" $-          biclique []      []      == (empty :: AI)--    test "biclique [x]     []      == vertex x" $ \(x :: Int) ->-          biclique [x]     []      == (vertex x :: AI)--    test "biclique []      [y]     == vertex y" $ \(y :: Int) ->-          biclique []      [y]     == (vertex y :: AI)--    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)--    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)--    test "star x [y]   == edge x y" $ \(x :: Int) y ->-          star x [y]   == (edge x y :: AI)--    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============ 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============ 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)--    test "removeEdge x y . removeEdge x y == removeEdge x y" $ \(x :: Int) y z ->-         (removeEdge x y . removeEdge x y)z==(removeEdge x y z :: AI)--    test "removeEdge x y . removeVertex x == removeVertex x" $ \(x :: Int) y z ->-         (removeEdge x y . removeVertex x)z==(removeVertex x z :: AI)--    test "removeEdge 1 1 (1 * 1 * 2 * 2)  == 1 * 2 * 2" $-          removeEdge 1 1 (1 * 1 * 2 * 2)  == (1 * 2 * (2 :: AI))--    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============ AdjacencyMap.replaceVertex ============"-    test "replaceVertex x x            == id" $ \x (y :: AI) ->-          replaceVertex x x y          == y--    test "replaceVertex x y (vertex x) == vertex y" $ \x (y :: Int) ->-          replaceVertex x y (vertex x) == (vertex y :: AI)--    test "replaceVertex x y            == mergeVertices (== x) y" $ \x y z ->-          replaceVertex x y z          == (mergeVertices (== x) y z :: AI)--    putStrLn "\n============ AdjacencyMap.mergeVertices ============"-    test "mergeVertices (const False) x    == id" $ \x (y :: AI) ->-          mergeVertices (const False) x y  == y--    test "mergeVertices (== x) y           == replaceVertex x y" $ \x y (z :: AI) ->-          mergeVertices (== x) y z         == (replaceVertex x y z :: AI)--    test "mergeVertices even 1 (0 * 2)     == 1 * 1" $-          mergeVertices even 1 (0 * 2)     == (1 * 1 :: AI)--    test "mergeVertices odd  1 (3 + 4 * 5) == 4 * 1" $-          mergeVertices odd  1 (3 + 4 * 5) == (4 * 1 :: AI)--    putStrLn "\n============ AdjacencyMap.gmap ============"-    test "gmap f empty      == empty" $ \(apply -> f :: II) ->-          gmap f empty      == empty--    test "gmap f (vertex x) == vertex (f x)" $ \(apply -> f :: II) x ->-          gmap f (vertex x) == vertex (f x)--    test "gmap f (edge x y) == edge (f x) (f y)" $ \(apply -> f :: II) x y ->-          gmap f (edge x y) == edge (f x) (f y)--    test "gmap id           == id" $ \x ->-          gmap id x         == (x :: AI)--    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============ AdjacencyMap.induce ============"-    test "induce (const True)  x      == x" $ \(x :: AI) ->-          induce (const True)  x      == x--    test "induce (const False) x      == empty" $ \(x :: AI) ->-          induce (const False) x      == (empty :: AI)--    test "induce (/= x)               == removeVertex x" $ \x (y :: AI) ->-          induce (/= x) y             == (removeVertex x y :: AI)--    test "induce p . induce q         == induce (\\x -> p x && q x)" $ \(apply -> p :: IB) (apply -> q :: IB) (y :: AI) ->-         (induce p . induce q) y      == (induce (\x -> p x && q x) y :: AI)--    test "isSubgraphOf (induce p x) x == True" $ \(apply -> p :: IB) (x :: AI) ->-          isSubgraphOf (induce p x) x == True--    putStrLn "\n============ AdjacencyMap.dfsForest ============"-    test "forest (dfsForest $ edge 1 1)         == vertex 1" $-          forest (dfsForest $ edge 1 (1 :: Int))==(vertex 1 :: AI)--    test "forest (dfsForest $ edge 1 2)         == edge 1 2" $-          forest (dfsForest $ edge 1 (2 :: Int))==(edge 1 2 :: AI)--    test "forest (dfsForest $ edge 2 1)         == vertices [1, 2]" $-          forest (dfsForest $ edge 2 (1 :: Int))==(vertices [1, 2] :: AI)--    test "isSubgraphOf (forest $ dfsForest x) x == True" $ \(x :: AI) ->-          isSubgraphOf (forest $ dfsForest x) x == True--    test "dfsForest . forest . dfsForest        == dfsForest" $ \(x :: AI) ->-         (dfsForest . forest . dfsForest) x     == dfsForest x--    test "dfsForest $ 3 * (1 + 4) * (1 + 5)     == <correct result>" $-          dfsForest  (3 * (1 + 4) * (1 + 5))    == [ Node { rootLabel = 1 :: Int-                                                   , subForest = [ Node { rootLabel = 5-                                                                        , subForest = [] }]}-                                                   , Node { rootLabel = 3-                                                   , subForest = [ Node { rootLabel = 4-                                                                        , subForest = [] }]}]--    putStrLn "\n============ AdjacencyMap.topSort ============"-    test "topSort (1 * 2 + 3 * 1)             == Just [3,1,2]" $-          topSort (1 * 2 + 3 * 1)             == Just [3,1,2 :: Int]--    test "topSort (1 * 2 + 2 * 1)             == Nothing" $-          topSort (1 * 2 + 2 * 1 :: AI)       == Nothing--    test "fmap (flip isTopSort x) (topSort x) /= Just False" $ \(x :: AI) ->-          fmap (flip isTopSort x) (topSort x) /= Just False--    putStrLn "\n============ AdjacencyMap.isTopSort  ============"-    test "isTopSort [3, 1, 2] (1 * 2 + 3 * 1) == True" $-          isTopSort [3, 1, 2] (1 * 2 + 3 * 1 :: AI) == True--    test "isTopSort [1, 2, 3] (1 * 2 + 3 * 1) == False" $-          isTopSort [1, 2, 3] (1 * 2 + 3 * 1 :: AI) == False--    test "isTopSort []        (1 * 2 + 3 * 1) == False" $-          isTopSort []        (1 * 2 + 3 * 1 :: AI) == False--    test "isTopSort []        empty           == True" $-          isTopSort []       (empty :: AI)    == True--    test "isTopSort [x]       (vertex x)      == True" $ \(x :: Int) ->-          isTopSort [x]       (vertex x)      == True--    test "isTopSort [x]       (edge x x)      == False" $ \(x :: Int) ->-          isTopSort [x]       (edge x x)      == False+    testShow              t+    testBasicPrimitives   t+    testFromAdjacencyList t+    testIsSubgraphOf      t+    testProperties        t+    testAdjacencyList     t+    testPostSet           t+    testGraphFamilies     t+    testTransformations   t+    testDfsForest         t+    testDfsForestFrom     t+    testDfs               t+    testTopSort           t+    testIsTopSort         t      putStrLn "\n============ AdjacencyMap.scc ============"     test "scc empty               == empty" $@@ -631,14 +71,11 @@                                            , (Set.fromList [3]  , Set.fromList [1,4])                                            , (Set.fromList [3]  , Set.fromList [5 :: Int])] -    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)--    test "map (\\(x, y) -> (getVertex h x, getVertex h y)) (edges $ getGraph h) == edgeList g"-      $ \(g :: AI) -> let h = graphKL g in-        map (\(x, y) -> (getVertex h x, getVertex h y)) (KL.edges $ getGraph h) == edgeList g+    putStrLn "\n============ AdjacencyMap.Internal.GraphKL ============"+    test "map (fromVertexKL h) (vertices $ toGraphKL h) == vertexList g"+      $ \(g :: AI) -> let h = mkGraphKL (adjacencyMap g) in+          map (fromVertexKL h) (KL.vertices $ toGraphKL h) == vertexList g -    test "fromGraphKL . graphKL == id" $ \(x :: AI) ->-        (fromGraphKL . graphKL) x == x+    test "map (\\(x, y) -> (fromVertexKL h x, fromVertexKL h y)) (edges $ toGraphKL h) == edgeList g"+      $ \(g :: AI) -> let h = mkGraphKL (adjacencyMap g) in+          map ( \(x, y) -> (fromVertexKL h x, fromVertexKL h y)) (KL.edges $ toGraphKL h) == edgeList g

@@ -20,15 +20,16 @@  import Algebra.Graph import Algebra.Graph.AdjacencyMap.Internal+import Algebra.Graph.Export import Algebra.Graph.Fold (Fold) 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      as AdjacencyMap-import qualified Algebra.Graph.IntAdjacencyMap   as IntAdjacencyMap-import qualified Algebra.Graph.Relation          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@@ -102,3 +103,6 @@             root     <- arbitrary             children <- replicateM subTrees (go subSize)             return $ Node root children++instance Arbitrary s => Arbitrary (Doc s) where+    arbitrary = (mconcat . map literal) <$> arbitrary

@@ -0,0 +1,162 @@+{-# LANGUAGE OverloadedStrings #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Algebra.Graph.Test.Export+-- Copyright  : (c) Andrey Mokhov 2016-2017+-- License    : MIT (see the file LICENSE)+-- Maintainer : andrey.mokhov@gmail.com+-- Stability  : experimental+--+-- Testsuite for "Algebra.Graph.Export" and "Algebra.Graph.Export.Dot".+-----------------------------------------------------------------------------+module Algebra.Graph.Test.Export (+    -- * Testsuite+    testExport+  ) where++import Prelude+import Data.Monoid++import Algebra.Graph (Graph, circuit)+import Algebra.Graph.Export hiding (unlines)+import Algebra.Graph.Export.Dot (Attribute (..))+import Algebra.Graph.Test++import qualified Algebra.Graph.Export     as E+import qualified Algebra.Graph.Export.Dot as ED++testExport :: IO ()+testExport = do+    putStrLn "\n============ Export.literal ============"+    test "literal \"Hello, \" <> literal \"World!\" == literal \"Hello, World!\"" $+          literal "Hello, " <> literal "World!" == literal ("Hello, World!" :: String)++    test "literal \"I am just a string literal\"  == \"I am just a string literal\"" $+          literal "I am just a string literal"  == ("I am just a string literal" :: Doc String)++    test "literal mempty                        == mempty" $+          literal mempty                        == (mempty :: Doc String)++    test "render . literal                      == id" $ \(x :: String) ->+         (render . literal) x                   == x++    test "literal . render                      == id" $ \(xs :: [String]) -> let x = mconcat (map literal xs) in+         (literal . render) x                   == x++    putStrLn "\n============ Export.render ============"+    test "render (literal \"al\" <> literal \"ga\") == \"alga\"" $+          render (literal "al" <> literal "ga") == ("alga" :: String)++    test "render mempty                         == mempty" $+          render mempty                         == (mempty :: Doc String)++    putStrLn "\n============ Export.<+> ============"+    test "x <+> mempty         == x" $ \(x :: Doc String) ->+          x <+> mempty         == x++    test "mempty <+> x         == x" $ \(x :: Doc String) ->+          mempty <+> x         == x++    test "x <+> (y <+> z)      == (x <+> y) <+> z" $ \(x :: Doc String) y z ->+          x <+> (y <+> z)      == (x <+> y) <+> z++    test "\"name\" <+> \"surname\" == \"name surname\"" $+          "name" <+> "surname" == ("name surname" :: Doc String)++    putStrLn "\n============ Export.brackets ============"+    test "brackets \"i\"    == \"[i]\"" $+          brackets "i"    == ("[i]" :: Doc String)++    test "brackets mempty == \"[]\"" $+          brackets mempty == ("[]" :: Doc String)++    putStrLn "\n============ Export.doubleQuotes ============"+    test "doubleQuotes \"/path/with spaces\"   == \"\\\"/path/with spaces\\\"\"" $+          doubleQuotes "/path/with spaces"    == ("\"/path/with spaces\"" :: Doc String)++    test "doubleQuotes (doubleQuotes mempty) == \"\\\"\\\"\\\"\\\"\"" $+          doubleQuotes (doubleQuotes mempty) == ("\"\"\"\"" :: Doc String)++    putStrLn "\n============ Export.indent ============"+    test "indent 0        == id" $ \(x :: String) ->+         (indent 0) (literal x) == literal x++    test "indent 1 mempty == \" \"" $+          indent 1 mempty == (" " :: Doc String)++    putStrLn "\n============ Export.unlines ============"+    test "unlines []                    == mempty" $+        E.unlines []                    == (mempty :: Doc String)++    test "unlines [mempty]              == \"\\n\"" $+        E.unlines [mempty]              == ("\n" :: Doc String)++    test "unlines [\"title\", \"subtitle\"] == \"title\\nsubtitle\\n\"" $+        E.unlines ["title",    "subtitle" ] == ("title\nsubtitle\n" :: Doc String)++    putStrLn "\n============ Export.export ============"+    let vDoc x   = literal (show x) <> "\n"+        eDoc x y = literal (show x) <> " -> " <> literal (show y) <> "\n"+    test "render $ export vDoc eDoc (1 + 2 * (3 + 4) :: Graph Int)" $+         (render (export vDoc eDoc (1 + 2 * (3 + 4) :: Graph Int)) :: String) ==+            unlines [ "1"+                    , "2"+                    , "3"+                    , "4"+                    , "2 -> 3"+                    , "2 -> 4" ]++    putStrLn "\n============ Export.Dot.export ============"+    let style = ED.Style+            { ED.graphName               = "Example"+            , ED.preamble                = "  // This is an example\n"+            , ED.graphAttributes         = ["label" := "Example", "labelloc" := "top"]+            , ED.defaultVertexAttributes = ["shape" := "circle"]+            , ED.defaultEdgeAttributes   = mempty+            , ED.vertexName              = \x   -> "v" ++ show x+            , ED.vertexAttributes        = \x   -> ["color" := "blue"   | odd x      ]+            , ED.edgeAttributes          = \x y -> ["style" := "dashed" | odd (x * y)] }+    test "export style (1 * 2 + 3 * 4 * 5 :: Graph Int)" $+        (ED.export style (1 * 2 + 3 * 4 * 5 :: Graph Int) :: String) ==+            unlines [ "digraph Example"+                    , "{"+                    , "  // This is an example"+                    , ""+                    , "  graph [label=\"Example\" labelloc=\"top\"]"+                    , "  node [shape=\"circle\"]"+                    , "  \"v1\" [color=\"blue\"]"+                    , "  \"v2\""+                    , "  \"v3\" [color=\"blue\"]"+                    , "  \"v4\""+                    , "  \"v5\" [color=\"blue\"]"+                    , "  \"v1\" -> \"v2\""+                    , "  \"v3\" -> \"v4\""+                    , "  \"v3\" -> \"v5\" [style=\"dashed\"]"+                    , "  \"v4\" -> \"v5\""+                    , "}" ]++    putStrLn "\n============ Export.Dot.exportAsIs ============"+    test "exportAsIs (circuit [\"a\", \"b\", \"c\"] :: Graph String)" $+        (ED.exportAsIs (circuit ["a", "b", "c"] :: Graph String) :: String) ==+            unlines [ "digraph"+                    , "{"+                    , "  \"a\""+                    , "  \"b\""+                    , "  \"c\""+                    , "  \"a\" -> \"b\""+                    , "  \"b\" -> \"c\""+                    , "  \"c\" -> \"a\""+                    , "}" ]++    putStrLn "\n============ Export.Dot.exportViaShow ============"+    test "exportViaShow (1 + 2 * (3 + 4) :: Graph Int)" $+        (ED.exportViaShow (1 + 2 * (3 + 4) :: Graph Int) :: String) ==+            unlines [ "digraph"+                    , "{"+                    , "  \"1\""+                    , "  \"2\""+                    , "  \"3\""+                    , "  \"4\""+                    , "  \"2\" -> \"3\""+                    , "  \"2\" -> \"4\""+                    , "}" ]

@@ -1,4 +1,3 @@-{-# LANGUAGE ViewPatterns #-} ----------------------------------------------------------------------------- -- | -- Module     : Algebra.Graph.Test.Fold@@ -7,497 +6,39 @@ -- Maintainer : andrey.mokhov@gmail.com -- Stability  : experimental ----- Testsuite for 'Fold' and polymorphic functions defined in+-- Testsuite for "Algebra.Graph.Fold" and polymorphic functions defined in -- "Algebra.Graph.Class".--- ----------------------------------------------------------------------------- module Algebra.Graph.Test.Fold (     -- * Testsuite     testFold   ) where -import Data.Foldable-import Data.Tree-import Data.Tuple- import Algebra.Graph.Fold import Algebra.Graph.Test+import Algebra.Graph.Test.Generic -import qualified Data.Set    as Set-import qualified Data.IntSet as IntSet+t :: Testsuite+t = testsuite "Fold." (empty :: Fold Int) +h :: HTestsuite+h = hTestsuite "Fold." (empty :: Fold Int)+ type F  = Fold Int-type II = Int -> Int-type IB = Int -> Bool-type IF = Int -> F  testFold :: IO () testFold = do     putStrLn "\n============ Fold ============"     test "Axioms of graphs"   $ (axioms   :: GraphTestsuite F) -    putStrLn "\n============ Fold.Show ============"-    test "show (empty     :: Fold Int) == \"empty\"" $-          show (empty     :: Fold Int) == "empty"--    test "show (1         :: Fold Int) == \"vertex 1\"" $-          show (1         :: Fold Int) == "vertex 1"--    test "show (1 + 2     :: Fold Int) == \"vertices [1,2]\"" $-          show (1 + 2     :: Fold Int) == "vertices [1,2]"--    test "show (1 * 2     :: Fold Int) == \"edge 1 2\"" $-          show (1 * 2     :: Fold Int) == "edge 1 2"--    test "show (1 * 2 * 3 :: Fold Int) == \"edges [(1,2),(1,3),(2,3)]\"" $-          show (1 * 2 * 3 :: Fold Int) == "edges [(1,2),(1,3),(2,3)]"--    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============ Fold.empty ============"-    test "isEmpty     empty == True" $-          isEmpty    (empty :: F) == True--    test "hasVertex x empty == False" $ \(x :: Int) ->-          hasVertex x empty == False--    test "vertexCount empty == 0" $-          vertexCount(empty :: F) == 0--    test "edgeCount   empty == 0" $-          edgeCount  (empty :: F) == 0--    test "size        empty == 1" $-          size       (empty :: F) == 1--    putStrLn "\n============ Fold.vertex ============"-    test "isEmpty     (vertex x) == False" $ \(x :: Int) ->-          isEmpty     (vertex x) == False--    test "hasVertex x (vertex x) == True" $ \(x :: Int) ->-          hasVertex x (vertex x) == True--    test "hasVertex 1 (vertex 2) == False" $-          hasVertex 1 (vertex 2 :: F) == False--    test "vertexCount (vertex x) == 1" $ \(x :: Int) ->-          vertexCount (vertex x) == 1--    test "edgeCount   (vertex x) == 0" $ \(x :: Int) ->-          edgeCount   (vertex x) == 0--    test "size        (vertex x) == 1" $ \(x :: Int) ->-          size        (vertex x) == 1--    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)--    test "hasEdge x y (edge x y) == True" $ \(x :: Int) y ->-          hasEdge x y (edge x y) == True--    test "edgeCount   (edge x y) == 1" $ \(x :: Int) y ->-          edgeCount   (edge x y) == 1--    test "vertexCount (edge 1 1) == 1" $-          vertexCount (edge 1 1 :: F) == 1--    test "vertexCount (edge 1 2) == 2" $-          vertexCount (edge 1 2 :: F) == 2--    putStrLn "\n============ Fold.overlay ============"-    test "isEmpty     (overlay x y) == isEmpty   x   && isEmpty   y" $ \(x :: F) y ->-          isEmpty     (overlay x y) == (isEmpty   x   && isEmpty   y)--    test "hasVertex z (overlay x y) == hasVertex z x || hasVertex z y" $ \(x :: F) y z ->-          hasVertex z (overlay x y) == (hasVertex z x || hasVertex z y)--    test "vertexCount (overlay x y) >= vertexCount x" $ \(x :: F) y ->-          vertexCount (overlay x y) >= vertexCount x--    test "vertexCount (overlay x y) <= vertexCount x + vertexCount y" $ \(x :: F) y ->-          vertexCount (overlay x y) <= vertexCount x + vertexCount y--    test "edgeCount   (overlay x y) >= edgeCount x" $ \(x :: F) y ->-          edgeCount   (overlay x y) >= edgeCount x--    test "edgeCount   (overlay x y) <= edgeCount x   + edgeCount y" $ \(x :: F) y ->-          edgeCount   (overlay x y) <= edgeCount x   + edgeCount y--    test "size        (overlay x y) == size x        + size y" $ \(x :: F) y ->-          size        (overlay x y) == size x        + size y--    test "vertexCount (overlay 1 2) == 2" $-          vertexCount (overlay 1 2 :: F) == 2--    test "edgeCount   (overlay 1 2) == 0" $-          edgeCount   (overlay 1 2 :: F) == 0--    putStrLn "\n============ Fold.connect ============"-    test "isEmpty     (connect x y) == isEmpty   x   && isEmpty   y" $ \(x :: F) y ->-          isEmpty     (connect x y) == (isEmpty   x   && isEmpty   y)--    test "hasVertex z (connect x y) == hasVertex z x || hasVertex z y" $ \(x :: F) y z ->-          hasVertex z (connect x y) == (hasVertex z x || hasVertex z y)--    test "vertexCount (connect x y) >= vertexCount x" $ \(x :: F) y ->-          vertexCount (connect x y) >= vertexCount x--    test "vertexCount (connect x y) <= vertexCount x + vertexCount y" $ \(x :: F) y ->-          vertexCount (connect x y) <= vertexCount x + vertexCount y--    test "edgeCount   (connect x y) >= edgeCount x" $ \(x :: F) y ->-          edgeCount   (connect x y) >= edgeCount x--    test "edgeCount   (connect x y) >= edgeCount y" $ \(x :: F) y ->-          edgeCount   (connect x y) >= edgeCount y--    test "edgeCount   (connect x y) >= vertexCount x * vertexCount y" $ \(x :: F) y ->-          edgeCount   (connect x y) >= vertexCount x * vertexCount y--    test "edgeCount   (connect x y) <= vertexCount x * vertexCount y + edgeCount x + edgeCount y" $ \(x :: F) y ->-          edgeCount   (connect x y) <= vertexCount x * vertexCount y + edgeCount x + edgeCount y--    test "size        (connect x y) == size x        + size y" $ \(x :: F) y ->-          size        (connect x y) == size x        + size y--    test "vertexCount (connect 1 2) == 2" $-          vertexCount (connect 1 2 :: F) == 2--    test "edgeCount   (connect 1 2) == 1" $-          edgeCount   (connect 1 2 :: F) == 1--    putStrLn "\n============ Fold.vertices ============"-    test "vertices []            == empty" $-          vertices []            == (empty :: F)--    test "vertices [x]           == vertex x" $ \(x :: Int) ->-          vertices [x]           == (vertex x :: F)--    test "hasVertex x . vertices == elem x" $ \x (xs :: [Int]) ->-         (hasVertex x . vertices) xs == elem x xs--    test "vertexCount . vertices == length . nub" $ \(xs :: [Int]) ->-         (vertexCount . vertices) xs == (length . nubOrd) xs--    test "vertexSet   . vertices == Set.fromList" $ \(xs :: [Int]) ->-         (vertexSet   . vertices) xs == Set.fromList xs--    putStrLn "\n============ Fold.edges ============"-    test "edges []          == empty" $-          edges []          == (empty :: F)--    test "edges [(x,y)]     == edge x y" $ \(x :: Int) y ->-          edges [(x,y)]     == (edge x y :: F)--    test "edgeCount . edges == length . nub" $ \(xs :: [(Int, Int)]) ->-         (edgeCount . edges) xs == (length . nubOrd) xs--    putStrLn "\n============ Fold.overlays ============"-    test "overlays []        == empty" $-          overlays []        == (empty :: F)--    test "overlays [x]       == x" $ \(x :: F) ->-          overlays [x]       == x--    test "overlays [x,y]     == overlay x y" $ \(x :: F) y ->-          overlays [x,y]     == overlay x y--    test "isEmpty . overlays == all isEmpty" $ \(xs :: [F]) ->-         (isEmpty . overlays) xs == all isEmpty xs--    putStrLn "\n============ Fold.connects ============"-    test "connects []        == empty" $-          connects []        == (empty :: F)--    test "connects [x]       == x" $ \(x :: F) ->-          connects [x]       == x--    test "connects [x,y]     == connect x y" $ \(x :: F) y ->-          connects [x,y]     == connect x y--    test "isEmpty . connects == all isEmpty" $ \(xs :: [F]) ->-         (isEmpty . connects) xs == all isEmpty xs--    putStrLn "\n============ Fold.graph ============"-    test "graph []  []      == empty" $-          graph []  []      == (empty :: F)--    test "graph [x] []      == vertex x" $ \(x :: Int) ->-          graph [x] []      == (vertex x :: F)--    test "graph []  [(x,y)] == edge x y" $ \(x :: Int) y ->-          graph []  [(x,y)] == (edge x y :: F)--    test "graph vs  es      == overlay (vertices vs) (edges es)" $ \(vs :: [Int]) es ->-          graph vs  es      == (overlay (vertices vs) (edges es) :: F)--    putStrLn "\n============ Fold.foldg ============"-    test "foldg empty vertex        overlay connect        == id" $ \(x :: F) ->-          foldg empty vertex        overlay connect x      == x--    test "foldg empty vertex        overlay (flip connect) == transpose" $ \(x :: F) ->-          foldg empty vertex        overlay (flip connect)x== (transpose x :: F)--    test "foldg []    return        (++)    (++)           == toList" $ \(x :: F) ->-          foldg []    return        (++)    (++) x         == toList x--    test "foldg 0     (const 1)     (+)     (+)            == length" $ \(x :: F) ->-          foldg 0     (const 1)     (+)     (+) x          == length x--    test "foldg 1     (const 1)     (+)     (+)            == size" $ \(x :: F) ->-          foldg 1     (const 1)     (+)     (+) x          == size x--    test "foldg True  (const False) (&&)    (&&)           == isEmpty" $ \(x :: F) ->-          foldg True  (const False) (&&)    (&&) x         == isEmpty x--    putStrLn "\n============ Fold.isSubgraphOf ============"-    test "isSubgraphOf empty         x             == True" $ \(x :: F) ->-          isSubgraphOf empty         x             == True--    test "isSubgraphOf (vertex x)    empty         == False" $ \x ->-          isSubgraphOf (vertex x)   (empty :: F)   == False--    test "isSubgraphOf x             (overlay x y) == True" $ \(x :: F) y ->-          isSubgraphOf x             (overlay x y) == True--    test "isSubgraphOf (overlay x y) (connect x y) == True" $ \(x :: F) y ->-          isSubgraphOf (overlay x y) (connect x y) == True--    test "isSubgraphOf (path xs)     (circuit xs)  == True" $ \xs ->-          isSubgraphOf (path xs :: F)(circuit xs)  == True--    putStrLn "\n============ Fold.isEmpty ============"-    test "isEmpty empty                       == True" $-          isEmpty (empty :: F)                == True--    test "isEmpty (overlay empty empty)       == True" $-          isEmpty (overlay empty empty :: F)  == True--    test "isEmpty (vertex x)                  == False" $ \(x :: Int) ->-          isEmpty (vertex x)                  == False--    test "isEmpty (removeVertex x $ vertex x) == True" $ \(x :: Int) ->-          isEmpty (removeVertex x $ vertex x) == True--    test "isEmpty (removeEdge x y $ edge x y) == False" $ \(x :: Int) y ->-          isEmpty (removeEdge x y $ edge x y) == False--    putStrLn "\n============ Fold.size ============"-    test "size empty         == 1" $-          size (empty :: F)  == 1--    test "size (vertex x)    == 1" $ \(x :: Int) ->-          size (vertex x)    == 1--    test "size (overlay x y) == size x + size y" $ \(x :: F) y ->-          size (overlay x y) == size x + size y--    test "size (connect x y) == size x + size y" $ \(x :: F) y ->-          size (connect x y) == size x + size y--    test "size x             >= 1" $ \(x :: F) ->-          size x             >= 1--    test "size x             >= vertexCount x" $ \(x :: F) ->-          size x             >= vertexCount x--    putStrLn "\n============ Fold.hasVertex ============"-    test "hasVertex x empty            == False" $ \(x :: Int) ->-          hasVertex x empty            == False--    test "hasVertex x (vertex x)       == True" $ \(x :: Int) ->-          hasVertex x (vertex x)       == True--    test "hasVertex x . removeVertex x == const False" $ \(x :: Int) y ->-          hasVertex x (removeVertex x y)==const False y--    putStrLn "\n============ Fold.hasEdge ============"-    test "hasEdge x y empty            == False" $ \(x :: Int) y ->-          hasEdge x y empty            == False--    test "hasEdge x y (vertex z)       == False" $ \(x :: Int) y z ->-          hasEdge x y (vertex z)       == False--    test "hasEdge x y (edge x y)       == True" $ \(x :: Int) y ->-          hasEdge x y (edge x y)       == True--    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============ Fold.vertexCount ============"-    test "vertexCount empty      == 0" $-          vertexCount (empty :: F) == 0--    test "vertexCount (vertex x) == 1" $ \(x :: Int) ->-          vertexCount (vertex x) == 1--    test "vertexCount            == length . vertexList" $ \(x :: F) ->-          vertexCount x          == (length . vertexList) x--    putStrLn "\n============ Fold.edgeCount ============"-    test "edgeCount empty      == 0" $-          edgeCount (empty :: F) == 0--    test "edgeCount (vertex x) == 0" $ \(x :: Int) ->-          edgeCount (vertex x) == 0--    test "edgeCount (edge x y) == 1" $ \(x :: Int) y ->-          edgeCount (edge x y) == 1--    test "edgeCount            == length . edgeList" $ \(x :: F) ->-          edgeCount x          == (length . edgeList) x--    putStrLn "\n============ Fold.vertexList ============"-    test "vertexList empty      == []" $-          vertexList (empty :: F) == []--    test "vertexList (vertex x) == [x]" $ \(x :: Int) ->-          vertexList (vertex x) == [x]--    test "vertexList . vertices == nub . sort" $ \(xs :: [Int]) ->-         (vertexList . vertices) xs == (nubOrd . sort) xs--    putStrLn "\n============ Fold.edgeList ============"-    test "edgeList empty          == []" $-          edgeList (empty :: F )  == []--    test "edgeList (vertex x)     == []" $ \(x :: Int) ->-          edgeList (vertex x)     == []--    test "edgeList (edge x y)     == [(x,y)]" $ \(x :: Int) y ->-          edgeList (edge x y)     == [(x,y)]--    test "edgeList (star 2 [3,1]) == [(2,1), (2,3)]" $-          edgeList (star 2 [3,1]) == [(2,1), (2,3 :: Int)]--    test "edgeList . edges        == nub . sort" $ \(xs :: [(Int, Int)]) ->-         (edgeList . edges) xs    == (nubOrd . sort) xs--    putStrLn "\n============ Fold.vertexSet ============"-    test "vertexSet empty      == Set.empty" $-          vertexSet(empty :: F)== Set.empty--    test "vertexSet . vertex   == Set.singleton" $ \(x :: Int) ->-         (vertexSet . vertex) x== Set.singleton x--    test "vertexSet . vertices == Set.fromList" $ \(xs :: [Int]) ->-         (vertexSet . vertices) xs == Set.fromList xs--    test "vertexSet . clique   == Set.fromList" $ \(xs :: [Int]) ->-         (vertexSet . clique) xs == Set.fromList xs--    putStrLn "\n============ Fold.vertexIntSet ============"-    test "vertexIntSet empty      == IntSet.empty" $-          vertexIntSet(empty :: F)== IntSet.empty--    test "vertexIntSet . vertex   == IntSet.singleton" $ \(x :: Int) ->-         (vertexIntSet . vertex) x== IntSet.singleton x--    test "vertexIntSet . vertices == IntSet.fromList" $ \(xs :: [Int]) ->-         (vertexIntSet . vertices) xs == IntSet.fromList xs--    test "vertexIntSet . clique   == IntSet.fromList" $ \(xs :: [Int]) ->-         (vertexIntSet . clique) xs == IntSet.fromList xs--    putStrLn "\n============ Fold.edgeSet ============"-    test "edgeSet empty      == Set.empty" $-          edgeSet (empty :: F) == Set.empty--    test "edgeSet (vertex x) == Set.empty" $ \(x :: Int) ->-          edgeSet (vertex x) == Set.empty--    test "edgeSet (edge x y) == Set.singleton (x,y)" $ \(x :: Int) y ->-          edgeSet (edge x y) == Set.singleton (x,y)--    test "edgeSet . edges    == Set.fromList" $ \(xs :: [(Int, Int)]) ->-         (edgeSet . edges) xs== Set.fromList xs--    putStrLn "\n============ Fold.path ============"-    test "path []    == empty" $-          path []    == (empty :: F)--    test "path [x]   == vertex x" $ \(x :: Int) ->-          path [x]   == (vertex x :: F)--    test "path [x,y] == edge x y" $ \(x :: Int) y ->-          path [x,y] == (edge x y :: F)--    putStrLn "\n============ Fold.circuit ============"-    test "circuit []    == empty" $-          circuit []    == (empty :: F)--    test "circuit [x]   == edge x x" $ \(x :: Int) ->-          circuit [x]   == (edge x x :: F)--    test "circuit [x,y] == edges [(x,y), (y,x)]" $ \(x :: Int) y ->-          circuit [x,y] == (edges [(x,y), (y,x)] :: F)--    putStrLn "\n============ Fold.clique ============"-    test "clique []      == empty" $-          clique []      == (empty :: F)--    test "clique [x]     == vertex x" $ \(x :: Int) ->-          clique [x]     == (vertex x :: F)--    test "clique [x,y]   == edge x y" $ \(x :: Int) y ->-          clique [x,y]   == (edge x y :: F)--    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============ Fold.biclique ============"-    test "biclique []      []      == empty" $-          biclique []      []      == (empty :: F)--    test "biclique [x]     []      == vertex x" $ \x ->-          biclique [x]     []      == (vertex x :: F)--    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 x2 y1 y2 ->-          biclique [x1,x2] [y1,y2] == (edges [(x1,y1), (x1,y2), (x2,y1), (x2,y2)] :: F)--    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)--    test "star x [y]   == edge x y" $ \(x :: Int) y ->-          star x [y]   == (edge x y :: F)--    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============ 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)+    testShow            t+    testBasicPrimitives t+    testFoldg           h+    testIsSubgraphOf    t+    testSize            t+    testProperties      t+    testGraphFamilies   t+    testTransformations t      putStrLn "\n============ Fold.mesh ============"     test "mesh xs     []   == empty" $ \xs ->@@ -550,159 +91,18 @@                     deBruijn 2 "01"             ==(edges [ ("00","00"), ("00","01"), ("01","10"), ("01","11")                                                          , ("10","00"), ("10","01"), ("11","10"), ("11","11") ] :: Fold String) +    test "          transpose   (deBruijn n xs) == gmap reverse $ deBruijn n xs" $ mapSize (min 5) $ \(NonNegative n) (xs :: [Int]) ->+                    transpose   (deBruijn n xs) == ((gmap reverse $ deBruijn n xs) :: Fold [Int])+     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============ 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)--    test "removeEdge x y . removeEdge x y == removeEdge x y" $ \(x :: Int) y z ->-         (removeEdge x y . removeEdge x y)z==(removeEdge x y z :: F)--    test "removeEdge x y . removeVertex x == removeVertex x" $ \(x :: Int) y z ->-         (removeEdge x y . removeVertex x)z==(removeVertex x z :: F)--    test "removeEdge 1 1 (1 * 1 * 2 * 2)  == 1 * 2 * 2" $-          removeEdge 1 1 (1 * 1 * 2 * 2)  == (1 * 2 * (2 :: F))--    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============ Fold.replaceVertex ============"-    test "replaceVertex x x            == id" $ \x (y :: F) ->-          replaceVertex x x y          == y--    test "replaceVertex x y (vertex x) == vertex y" $ \x (y :: Int) ->-          replaceVertex x y (vertex x) == (vertex y :: F)--    test "replaceVertex x y            == mergeVertices (== x) y" $ \x y z ->-          replaceVertex x y z          == (mergeVertices (== x) y z :: F)--    putStrLn "\n============ Fold.mergeVertices ============"-    test "mergeVertices (const False) x    == id" $ \x (y :: F) ->-          mergeVertices (const False) x y  == y--    test "mergeVertices (== x) y           == replaceVertex x y" $ \x y (z :: F) ->-          mergeVertices (== x) y z         == (replaceVertex x y z :: F)--    test "mergeVertices even 1 (0 * 2)     == 1 * 1" $-          mergeVertices even 1 (0 * 2)     == (1 * 1 :: F)--    test "mergeVertices odd  1 (3 + 4 * 5) == 4 * 1" $-          mergeVertices odd  1 (3 + 4 * 5) == (4 * 1 :: F)--    putStrLn "\n============ Fold.splitVertex ============"-    test "splitVertex x []                   == removeVertex x" $ \x (y :: F) ->-         (splitVertex x []) y                == (removeVertex x y :: F)--    test "splitVertex x [x]                  == id" $ \x (y :: F) ->-         (splitVertex x [x]) y               == y--    test "splitVertex x [y]                  == replaceVertex x y" $ \x y (z :: F) ->-         (splitVertex x [y]) z               == (replaceVertex x y z :: F)--    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============ Fold.transpose ============"-    test "transpose empty       == empty" $-          transpose empty       == (empty :: F)--    test "transpose (vertex x)  == vertex x" $ \(x :: Int) ->-          transpose (vertex x)  == (vertex x :: F)--    test "transpose (edge x y)  == edge y x" $ \(x :: Int) y ->-          transpose (edge x y)  == (edge y x :: F)--    test "transpose . transpose == id" $ \(x :: F) ->-         (transpose . transpose) x == x--    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)--    test "gmap f (vertex x) == vertex (f x)" $ \(apply -> f :: II) x ->-          gmap f (vertex x) == (vertex (f x) :: F)--    test "gmap f (edge x y) == edge (f x) (f y)" $ \(apply -> f :: II) x y ->-          gmap f (edge x y) == (edge (f x) (f y) :: F)--    test "gmap id           == id" $ \(x :: F) ->-          gmap id x         == x--    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============ Fold.bind ============"-    test "bind empty f         == empty" $ \(apply -> f :: IF) ->-          bind empty f         == empty--    test "bind (vertex x) f    == f x" $ \(apply -> f :: IF) x ->-          bind (vertex x) f    == f x--    test "bind (edge x y) f    == connect (f x) (f y)" $ \(apply -> f :: IF) x y ->-          bind (edge x y) f    == connect (f x) (f y)--    test "bind (vertices xs) f == overlays (map f xs)" $ mapSize (min 10) $ \xs (apply -> f :: IF) ->-          bind (vertices xs) f == overlays (map f xs)--    test "bind x (const empty) == empty" $ \(x :: F) ->-          bind x (const empty) == (empty :: F)--    test "bind x vertex        == x" $ \(x :: F) ->-          bind x vertex        == x--    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============ Fold.induce ============"-    test "induce (const True)  x      == x" $ \(x :: F) ->-          induce (const True)  x      == x--    test "induce (const False) x      == empty" $ \(x :: F) ->-          induce (const False) x      == (empty :: F)--    test "induce (/= x)               == removeVertex x" $ \x (y :: F) ->-          induce (/= x) y             == (removeVertex x y :: F)--    test "induce p . induce q         == induce (\\x -> p x && q x)" $ \(apply -> p :: IB) (apply -> q :: IB) (y :: F) ->-         (induce p . induce q) y      == (induce (\x -> p x && q x) y :: F)--    test "isSubgraphOf (induce p x) x == True" $ \(apply -> p :: IB) (x :: F) ->-          isSubgraphOf (induce p x) x == True--    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+    testSplitVertex t+    testBind        t+    testSimplify    t      putStrLn "\n============ Fold.box ============"     let unit = fmap $ \(a, ()) -> a@@ -722,6 +122,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 "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 "vertexCount (box x y) == vertexCount x * vertexCount y" $ mapSize (min 10) $ \(x :: F) (y :: F) ->           vertexCount (box x y) == vertexCount x * vertexCount y

@@ -0,0 +1,983 @@+{-# LANGUAGE GADTs, RankNTypes, ViewPatterns #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Algebra.Graph.Test.Generic+-- Copyright  : (c) Andrey Mokhov 2016-2017+-- License    : MIT (see the file LICENSE)+-- Maintainer : andrey.mokhov@gmail.com+-- Stability  : experimental+--+-- Generic graph API testing.+-----------------------------------------------------------------------------+module Algebra.Graph.Test.Generic (+    -- * Generic tests+    Testsuite, testsuite, HTestsuite, hTestsuite, testShow, testFromAdjacencyList,+    testBasicPrimitives, testFoldg, testIsSubgraphOf, testSize, testProperties,+    testAdjacencyList, testPreSet, testPostSet, testPostIntSet, testGraphFamilies,+    testTransformations, testDfsForest, testDfsForestFrom, testDfs, testTopSort,+    testIsTopSort, testSplitVertex, testBind, testSimplify+  ) where++import Data.Foldable+import Data.List (nub, sort)+import Data.Tree+import Data.Tuple++import Algebra.Graph.Class (Graph (..))+import Algebra.Graph.Test+import Algebra.Graph.Test.API++import qualified Data.Set    as Set+import qualified Data.IntSet as IntSet++data Testsuite where+    Testsuite :: (Arbitrary g, Eq g, GraphAPI g, Num g, Show g, Vertex g ~ Int)+              => String -> (forall r. (g -> r) -> g -> r) -> Testsuite++testsuite :: (Arbitrary g, Eq g, GraphAPI g, Num g, Show g, Vertex g ~ Int)+          => String -> g -> Testsuite+testsuite prefix g = Testsuite prefix (\f x -> f (x `asTypeOf` g))++data HTestsuite where+    HTestsuite :: (Arbitrary g, Eq g, GraphAPI g, Num g, Show g, Vertex g ~ Int,+                   g ~ f Int, Foldable f)+               => String -> (forall r. (g -> r) -> g -> r) -> HTestsuite++hTestsuite :: (Arbitrary g, Eq g, GraphAPI g, Num g, Show g, Vertex g ~ Int,+               g ~ f Int, Foldable f) => String -> g -> HTestsuite+hTestsuite prefix g = HTestsuite prefix (\f x -> f (x `asTypeOf` g))++testBasicPrimitives :: Testsuite -> IO ()+testBasicPrimitives = mconcat [ testEmpty+                              , testVertex+                              , testEdge+                              , testOverlay+                              , testConnect+                              , testVertices+                              , testEdges+                              , testOverlays+                              , testConnects+                              , testGraph ]++testProperties :: Testsuite -> IO ()+testProperties = mconcat [ testIsEmpty+                         , testHasVertex+                         , testHasEdge+                         , testVertexCount+                         , testEdgeCount+                         , testVertexList+                         , testEdgeList+                         , testVertexSet+                         , testVertexIntSet+                         , testEdgeSet ]++testGraphFamilies :: Testsuite -> IO ()+testGraphFamilies = mconcat [ testPath+                            , testCircuit+                            , testClique+                            , testBiclique+                            , testStar+                            , testTree+                            , testForest ]++testTransformations :: Testsuite -> IO ()+testTransformations = mconcat [ testRemoveVertex+                              , testRemoveEdge+                              , testReplaceVertex+                              , testMergeVertices+                              , testTranspose+                              , testGmap+                              , testInduce ]++testShow :: Testsuite -> IO ()+testShow (Testsuite prefix (%)) = do+    putStrLn $ "\n============ " ++ prefix ++ "Show ============"+    test "show (empty     :: IntAdjacencyMap) == \"empty\"" $+          show % empty                        == "empty"++    test "show (1         :: IntAdjacencyMap) == \"vertex 1\"" $+          show % 1                            == "vertex 1"++    test "show (1 + 2     :: IntAdjacencyMap) == \"vertices [1,2]\"" $+          show % (1 + 2)                      == "vertices [1,2]"++    test "show (1 * 2     :: IntAdjacencyMap) == \"edge 1 2\"" $+          show % (1 * 2)                      == "edge 1 2"++    test "show (1 * 2 * 3 :: IntAdjacencyMap) == \"edges [(1,2),(1,3),(2,3)]\"" $+          show % (1 * 2 * 3)                  == "edges [(1,2),(1,3),(2,3)]"++    test "show (1 * 2 + 3 :: IntAdjacencyMap) == \"graph [1,2,3] [(1,2)]\"" $+          show % (1 * 2 + 3)                  == "graph [1,2,3] [(1,2)]"++testEmpty :: Testsuite -> IO ()+testEmpty (Testsuite prefix (%)) = do+    putStrLn $ "\n============ " ++ prefix ++ "empty ============"+    test "isEmpty     empty == True" $+          isEmpty   % empty == True++    test "hasVertex x empty == False" $ \x ->+          hasVertex x % empty == False++    test "vertexCount empty == 0" $+          vertexCount % empty == 0++    test "edgeCount   empty == 0" $+          edgeCount % empty == 0++testVertex :: Testsuite -> IO ()+testVertex (Testsuite prefix (%)) = do+    putStrLn $ "\n============ " ++ prefix ++ "vertex ============"+    test "isEmpty     (vertex x) == False" $ \x ->+          isEmpty    % vertex x  == False++    test "hasVertex x (vertex x) == True" $ \x ->+          hasVertex x % vertex x == True++    test "hasVertex 1 (vertex 2) == False" $+          hasVertex 1 % vertex 2 == False++    test "vertexCount (vertex x) == 1" $ \x ->+          vertexCount % vertex x == 1++    test "edgeCount   (vertex x) == 0" $ \x ->+          edgeCount  % vertex x  == 0++testEdge :: Testsuite -> IO ()+testEdge (Testsuite prefix (%)) = do+    putStrLn $ "\n============ " ++ prefix ++ "edge ============"+    test "edge x y               == connect (vertex x) (vertex y)" $ \x y ->+          edge x y               == connect (vertex x) % (vertex y)++    test "hasEdge x y (edge x y) == True" $ \x y ->+          hasEdge x y % (edge x y) == True++    test "edgeCount   (edge x y) == 1" $ \x y ->+          edgeCount % (edge x y) == 1++    test "vertexCount (edge 1 1) == 1" $+          vertexCount % (edge 1 1) == 1++    test "vertexCount (edge 1 2) == 2" $+          vertexCount % (edge 1 2) == 2++testOverlay :: Testsuite -> IO ()+testOverlay (Testsuite prefix (%)) = do+    putStrLn $ "\n============ " ++ prefix ++ "overlay ============"+    test "isEmpty     (overlay x y) == isEmpty   x   && isEmpty   y" $ \x y ->+          isEmpty   % (overlay x y) == (isEmpty   x   && isEmpty   y)++    test "hasVertex z (overlay x y) == hasVertex z x || hasVertex z y" $ \x y z ->+          hasVertex z % (overlay x y) == (hasVertex z x || hasVertex z y)++    test "vertexCount (overlay x y) >= vertexCount x" $ \x y ->+          vertexCount % (overlay x y) >= vertexCount x++    test "vertexCount (overlay x y) <= vertexCount x + vertexCount y" $ \x y ->+          vertexCount % (overlay x y) <= vertexCount x + vertexCount y++    test "edgeCount   (overlay x y) >= edgeCount x" $ \x y ->+          edgeCount % (overlay x y) >= edgeCount x++    test "edgeCount   (overlay x y) <= edgeCount x   + edgeCount y" $ \x y ->+          edgeCount % (overlay x y) <= edgeCount x   + edgeCount y++    test "vertexCount (overlay 1 2) == 2" $+          vertexCount % (overlay 1 2) == 2++    test "edgeCount   (overlay 1 2) == 0" $+          edgeCount % (overlay 1 2) == 0++testConnect :: Testsuite -> IO ()+testConnect (Testsuite prefix (%)) = do+    putStrLn $ "\n============ " ++ prefix ++ "connect ============"+    test "isEmpty     (connect x y) == isEmpty   x   && isEmpty   y" $ \x y ->+          isEmpty    % connect x y  == (isEmpty   x   && isEmpty   y)++    test "hasVertex z (connect x y) == hasVertex z x || hasVertex z y" $ \x y z ->+          hasVertex z % connect x y == (hasVertex z x || hasVertex z y)++    test "vertexCount (connect x y) >= vertexCount x" $ \x y ->+          vertexCount % connect x y >= vertexCount x++    test "vertexCount (connect x y) <= vertexCount x + vertexCount y" $ \x y ->+          vertexCount % connect x y <= vertexCount x + vertexCount y++    test "edgeCount   (connect x y) >= edgeCount x" $ \x y ->+          edgeCount  % connect x y  >= edgeCount x++    test "edgeCount   (connect x y) >= edgeCount y" $ \x y ->+          edgeCount  % connect x y  >= edgeCount y++    test "edgeCount   (connect x y) >= vertexCount x * vertexCount y" $ \x y ->+          edgeCount  % connect x y  >= vertexCount x * vertexCount y++    test "edgeCount   (connect x y) <= vertexCount x * vertexCount y + edgeCount x + edgeCount y" $ \x y ->+          edgeCount  % connect x y  <= vertexCount x * vertexCount y + edgeCount x + edgeCount y++    test "vertexCount (connect 1 2) == 2" $+          vertexCount % connect 1 2 == 2++    test "edgeCount   (connect 1 2) == 1" $+          edgeCount  % connect 1 2  == 1++testVertices :: Testsuite -> IO ()+testVertices (Testsuite prefix (%)) = do+    putStrLn $ "\n============ " ++ prefix ++ "vertices ============"+    test "vertices []            == empty" $+          vertices []            == id % empty++    test "vertices [x]           == vertex x" $ \x ->+          vertices [x]           == id % vertex x++    test "hasVertex x . vertices == elem x" $ \x xs ->+          hasVertex x % vertices xs == elem x xs++    test "vertexCount . vertices == length . nub" $ \xs ->+          vertexCount % vertices xs == (length . nubOrd) xs++    test "vertexSet   . vertices == Set.fromList" $ \xs ->+          vertexSet % vertices xs == Set.fromList xs++testEdges :: Testsuite -> IO ()+testEdges (Testsuite prefix (%)) = do+    putStrLn $ "\n============ " ++ prefix ++ "edges ============"+    test "edges []          == empty" $+          edges []          == id % empty++    test "edges [(x,y)]     == edge x y" $ \x y ->+          edges [(x,y)]     == id % edge x y++    test "edgeCount . edges == length . nub" $ \xs ->+          edgeCount % edges xs == (length . nubOrd) xs++testOverlays :: Testsuite -> IO ()+testOverlays (Testsuite prefix (%)) = do+    putStrLn $ "\n============ " ++ prefix ++ "overlays ============"+    test "overlays []        == empty" $+          overlays []        == id % empty++    test "overlays [x]       == x" $ \x ->+          overlays [x]       == id % x++    test "overlays [x,y]     == overlay x y" $ \x y ->+          overlays [x,y]     == id % overlay x y++    test "isEmpty . overlays == all isEmpty" $ mapSize (min 10) $ \xs ->+          isEmpty % overlays xs == all isEmpty xs++testConnects :: Testsuite -> IO ()+testConnects (Testsuite prefix (%)) = do+    putStrLn $ "\n============ " ++ prefix ++ "connects ============"+    test "connects []        == empty" $+          connects []        == id % empty++    test "connects [x]       == x" $ \x ->+          connects [x]       == id % x++    test "connects [x,y]     == connect x y" $ \x y ->+          connects [x,y]     == id % connect x y++    test "isEmpty . connects == all isEmpty" $ mapSize (min 10) $ \xs ->+          isEmpty % connects xs == all isEmpty xs++testGraph :: Testsuite -> IO ()+testGraph (Testsuite prefix (%)) = do+    putStrLn $ "\n============ " ++ prefix ++ "graph ============"+    test "graph []  []      == empty" $+          graph []  []      == id % empty++    test "graph [x] []      == vertex x" $ \x ->+          graph [x] []      == id % vertex x++    test "graph []  [(x,y)] == edge x y" $ \x y ->+          graph []  [(x,y)] == id % edge x y++    test "graph vs  es      == overlay (vertices vs) (edges es)" $ \vs es ->+          graph vs  es      == overlay (vertices vs) % edges es++testFromAdjacencyList :: Testsuite -> IO ()+testFromAdjacencyList (Testsuite prefix (%)) = do+    putStrLn $ "\n============ " ++ prefix ++ "fromAdjacencyList ============"+    test "fromAdjacencyList []                                  == empty" $+          fromAdjacencyList []                                  == id % empty++    test "fromAdjacencyList [(x, [])]                           == vertex x" $ \x ->+          fromAdjacencyList [(x, [])]                           == id % vertex x++    test "fromAdjacencyList [(x, [y])]                          == edge x y" $ \x y ->+          fromAdjacencyList [(x, [y])]                          == id % edge x y++    test "fromAdjacencyList . adjacencyList                     == id" $ \x ->+         (fromAdjacencyList . adjacencyList) % x                == x++    test "overlay (fromAdjacencyList xs) (fromAdjacencyList ys) == fromAdjacencyList (xs ++ ys)" $ \xs ys ->+          overlay (fromAdjacencyList xs) % fromAdjacencyList ys == fromAdjacencyList (xs ++ ys)++testFoldg :: HTestsuite -> IO ()+testFoldg (HTestsuite prefix (%)) = do+    putStrLn $ "\n============ " ++ prefix ++ "foldg ============"+    test "foldg empty vertex        overlay connect        == id" $ \x ->+          foldg empty vertex        overlay connect x      == id % x++    test "foldg empty vertex        overlay (flip connect) == transpose" $ \x ->+          foldg empty vertex        overlay (flip connect)x== transpose % x++    test "foldg []    return        (++)    (++)           == toList" $ \x ->+          foldg []    return        (++)    (++) x         == toList % x++    test "foldg 0     (const 1)     (+)     (+)            == length" $ \x ->+          foldg 0     (const 1)     (+)     (+) x          == length % x++    test "foldg 1     (const 1)     (+)     (+)            == size" $ \x ->+          foldg 1     (const 1)     (+)     (+) x          == size % x++    test "foldg True  (const False) (&&)    (&&)           == isEmpty" $ \x ->+          foldg True  (const False) (&&)    (&&) x         == isEmpty % x++testIsSubgraphOf :: Testsuite -> IO ()+testIsSubgraphOf (Testsuite prefix (%)) = do+    putStrLn $ "\n============ " ++ prefix ++ "isSubgraphOf ============"+    test "isSubgraphOf empty         x             == True" $ \x ->+          isSubgraphOf empty       % x             == True++    test "isSubgraphOf (vertex x)    empty         == False" $ \x ->+          isSubgraphOf (vertex x)  % empty         == False++    test "isSubgraphOf x             (overlay x y) == True" $ \x y ->+          isSubgraphOf x            % overlay x y  == True++    test "isSubgraphOf (overlay x y) (connect x y) == True" $ \x y ->+          isSubgraphOf (overlay x y) % connect x y == True++    test "isSubgraphOf (path xs)     (circuit xs)  == True" $ \xs ->+          isSubgraphOf (path xs)    % circuit xs   == True++testIsEmpty :: Testsuite -> IO ()+testIsEmpty (Testsuite prefix (%)) = do+    putStrLn $ "\n============ " ++ prefix ++ "isEmpty ============"+    test "isEmpty empty                       == True" $+          isEmpty % empty                     == True++    test "isEmpty (overlay empty empty)       == True" $+          isEmpty % overlay empty empty       == True++    test "isEmpty (vertex x)                  == False" $ \x ->+          isEmpty % vertex x                  == False++    test "isEmpty (removeVertex x $ vertex x) == True" $ \x ->+          isEmpty (removeVertex x % vertex x) == True++    test "isEmpty (removeEdge x y $ edge x y) == False" $ \x y ->+          isEmpty (removeEdge x y % edge x y) == False++testSize :: Testsuite -> IO ()+testSize (Testsuite prefix (%)) = do+    putStrLn $ "\n============ " ++ prefix ++ "size ============"+    test "size empty         == 1" $+          size % empty       == 1++    test "size (vertex x)    == 1" $ \x ->+          size % vertex x    == 1++    test "size (overlay x y) == size x + size y" $ \x y ->+          size % overlay x y == size x + size y++    test "size (connect x y) == size x + size y" $ \x y ->+          size % connect x y == size x + size y++    test "size x             >= 1" $ \x ->+          size % x           >= 1++    test "size x             >= vertexCount x" $ \x ->+          size % x           >= vertexCount x++testHasVertex :: Testsuite -> IO ()+testHasVertex (Testsuite prefix (%)) = do+    putStrLn $ "\n============ " ++ prefix ++ "hasVertex ============"+    test "hasVertex x empty            == False" $ \x ->+          hasVertex x % empty          == False++    test "hasVertex x (vertex x)       == True" $ \x ->+          hasVertex x % vertex x     == True++    test "hasVertex x . removeVertex x == const False" $ \x y ->+         (hasVertex x . removeVertex x) y == const False % y++testHasEdge :: Testsuite -> IO ()+testHasEdge (Testsuite prefix (%)) = do+    putStrLn $ "\n============ " ++ prefix ++ "hasEdge ============"+    test "hasEdge x y empty            == False" $ \x y ->+          hasEdge x y % empty          == False++    test "hasEdge x y (vertex z)       == False" $ \x y z ->+          hasEdge x y % vertex z       == False++    test "hasEdge x y (edge x y)       == True" $ \x y ->+          hasEdge x y % edge x y       == True++    test "hasEdge x y . removeEdge x y == const False" $ \x y z ->+         (hasEdge x y . removeEdge x y) z == const False % z++    test "hasEdge x y                  == elem (x,y) . edgeList" $ \x y z -> do+        (u, v) <- elements ((x, y) : edgeList z)+        return $ hasEdge u v z == elem (u, v) (edgeList % z)++testVertexCount :: Testsuite -> IO ()+testVertexCount (Testsuite prefix (%)) = do+    putStrLn $ "\n============ " ++ prefix ++ "vertexCount ============"+    test "vertexCount empty      == 0" $+          vertexCount % empty    == 0++    test "vertexCount (vertex x) == 1" $ \x ->+          vertexCount % vertex x == 1++    test "vertexCount            == length . vertexList" $ \x ->+          vertexCount % x        == (length . vertexList) x++testEdgeCount :: Testsuite -> IO ()+testEdgeCount (Testsuite prefix (%)) = do+    putStrLn $ "\n============ " ++ prefix ++ "edgeCount ============"+    test "edgeCount empty      == 0" $+          edgeCount % empty    == 0++    test "edgeCount (vertex x) == 0" $ \x ->+          edgeCount % vertex x == 0++    test "edgeCount (edge x y) == 1" $ \x y ->+          edgeCount % edge x y == 1++    test "edgeCount            == length . edgeList" $ \x ->+          edgeCount % x        == (length . edgeList) x++testVertexList :: Testsuite -> IO ()+testVertexList (Testsuite prefix (%)) = do+    putStrLn $ "\n============ " ++ prefix ++ "vertexList ============"+    test "vertexList empty      == []" $+          vertexList % empty    == []++    test "vertexList (vertex x) == [x]" $ \x ->+          vertexList % vertex x == [x]++    test "vertexList . vertices == nub . sort" $ \xs ->+          vertexList % vertices xs == (nubOrd . sort) xs++testEdgeList :: Testsuite -> IO ()+testEdgeList (Testsuite prefix (%)) = do+    putStrLn $ "\n============ " ++ prefix ++ "edgeList ============"+    test "edgeList empty          == []" $+          edgeList % empty        == []++    test "edgeList (vertex x)     == []" $ \x ->+          edgeList % vertex x     == []++    test "edgeList (edge x y)     == [(x,y)]" $ \x y ->+          edgeList % edge x y     == [(x,y)]++    test "edgeList (star 2 [3,1]) == [(2,1), (2,3)]" $+          edgeList % star 2 [3,1] == [(2,1), (2,3)]++    test "edgeList . edges        == nub . sort" $ \xs ->+          edgeList % edges xs     == (nubOrd . sort) xs++testAdjacencyList :: Testsuite -> IO ()+testAdjacencyList (Testsuite prefix (%)) = do+    putStrLn $ "\n============ " ++ prefix ++ "adjacencyList ============"+    test "adjacencyList empty          == []" $+          adjacencyList % empty        == []++    test "adjacencyList (vertex x)     == [(x, [])]" $ \x ->+          adjacencyList % vertex x     == [(x, [])]++    test "adjacencyList (edge 1 2)     == [(1, [2]), (2, [])]" $+          adjacencyList % edge 1 2     == [(1, [2]), (2, [])]++    test "adjacencyList (star 2 [3,1]) == [(1, []), (2, [1,3]), (3, [])]" $+          adjacencyList % star 2 [3,1] == [(1, []), (2, [1,3]), (3, [])]++testVertexSet :: Testsuite -> IO ()+testVertexSet (Testsuite prefix (%)) = do+    putStrLn $ "\n============ " ++ prefix ++ "vertexSet ============"+    test "vertexSet empty      == Set.empty" $+          vertexSet % empty    == Set.empty++    test "vertexSet . vertex   == Set.singleton" $ \x ->+          vertexSet % vertex x == Set.singleton x++    test "vertexSet . vertices == Set.fromList" $ \xs ->+          vertexSet % vertices xs == Set.fromList xs++    test "vertexSet . clique   == Set.fromList" $ \xs ->+          vertexSet % clique xs == Set.fromList xs++testVertexIntSet :: Testsuite -> IO ()+testVertexIntSet (Testsuite prefix (%)) = do+    putStrLn $ "\n============ " ++ prefix ++ "vertexIntSet ============"+    test "vertexIntSet empty      == IntSet.empty" $+          vertexIntSet % empty    == IntSet.empty++    test "vertexIntSet . vertex   == IntSet.singleton" $ \x ->+          vertexIntSet % vertex x == IntSet.singleton x++    test "vertexIntSet . vertices == IntSet.fromList" $ \xs ->+          vertexIntSet % vertices xs == IntSet.fromList xs++    test "vertexIntSet . clique   == IntSet.fromList" $ \xs ->+          vertexIntSet % clique xs == IntSet.fromList xs++testEdgeSet :: Testsuite -> IO ()+testEdgeSet (Testsuite prefix (%)) = do+    putStrLn $ "\n============ " ++ prefix ++ "edgeSet ============"+    test "edgeSet empty      == Set.empty" $+          edgeSet % empty    == Set.empty++    test "edgeSet (vertex x) == Set.empty" $ \x ->+          edgeSet % vertex x == Set.empty++    test "edgeSet (edge x y) == Set.singleton (x,y)" $ \x y ->+          edgeSet % edge x y == Set.singleton (x,y)++    test "edgeSet . edges    == Set.fromList" $ \xs ->+          edgeSet % edges xs == Set.fromList xs++testPreSet :: Testsuite -> IO ()+testPreSet (Testsuite prefix (%)) = do+    putStrLn $ "\n============ " ++ prefix ++ "preSet ============"+    test "preSet x empty      == Set.empty" $ \x ->+          preSet x % empty    == Set.empty++    test "preSet x (vertex x) == Set.empty" $ \x ->+          preSet x % vertex x == Set.empty++    test "preSet 1 (edge 1 2) == Set.empty" $+          preSet 1 % edge 1 2 == Set.empty++    test "preSet y (edge x y) == Set.fromList [x]" $ \x y ->+          preSet y % edge x y == Set.fromList [x]++testPostSet :: Testsuite -> IO ()+testPostSet (Testsuite prefix (%)) = do+    putStrLn $ "\n============ " ++ prefix ++ "postSet ============"+    test "postSet x empty      == Set.empty" $ \x ->+          postSet x % empty    == Set.empty++    test "postSet x (vertex x) == Set.empty" $ \x ->+          postSet x % vertex x == Set.empty++    test "postSet x (edge x y) == Set.fromList [y]" $ \x y ->+          postSet x % edge x y == Set.fromList [y]++    test "postSet 2 (edge 1 2) == Set.empty" $+          postSet 2 % edge 1 2 == Set.empty++testPostIntSet :: Testsuite -> IO ()+testPostIntSet (Testsuite prefix (%)) = do+    putStrLn $ "\n============ " ++ prefix ++ "postIntSet ============"+    test "postIntSet x empty      == IntSet.empty" $ \x ->+          postIntSet x % empty    == IntSet.empty++    test "postIntSet x (vertex x) == IntSet.empty" $ \x ->+          postIntSet x % vertex x == IntSet.empty++    test "postIntSet x (edge x y) == IntSet.fromList [y]" $ \x y ->+          postIntSet x % edge x y == IntSet.fromList [y]++    test "postIntSet 2 (edge 1 2) == IntSet.empty" $+          postIntSet 2 % edge 1 2 == IntSet.empty++testPath :: Testsuite -> IO ()+testPath (Testsuite prefix (%)) = do+    putStrLn $ "\n============ " ++ prefix ++ "path ============"+    test "path []    == empty" $+          path []    == id % empty++    test "path [x]   == vertex x" $ \x ->+          path [x]   == id % vertex x++    test "path [x,y] == edge x y" $ \x y ->+          path [x,y] == id % edge x y++testCircuit :: Testsuite -> IO ()+testCircuit (Testsuite prefix (%)) = do+    putStrLn $ "\n============ " ++ prefix ++ "circuit ============"+    test "circuit []    == empty" $+          circuit []    == id % empty++    test "circuit [x]   == edge x x" $ \x ->+          circuit [x]   == id % edge x x++    test "circuit [x,y] == edges [(x,y), (y,x)]" $ \x y ->+          circuit [x,y] == id % edges [(x,y), (y,x)]++testClique :: Testsuite -> IO ()+testClique (Testsuite prefix (%)) = do+    putStrLn $ "\n============ " ++ prefix ++ "clique ============"+    test "clique []         == empty" $+          clique []         == id % empty++    test "clique [x]        == vertex x" $ \x ->+          clique [x]        == id % vertex x++    test "clique [x,y]      == edge x y" $ \x y ->+          clique [x,y]      == id % edge x y++    test "clique [x,y,z]    == edges [(x,y), (x,z), (y,z)]" $ \x y z ->+          clique [x,y,z]    == id % edges [(x,y), (x,z), (y,z)]++    test "clique (xs ++ ys) == connect (clique xs) (clique ys)" $ \xs ys ->+          clique (xs ++ ys) == connect (clique xs) % (clique ys)++testBiclique :: Testsuite -> IO ()+testBiclique (Testsuite prefix (%)) = do+    putStrLn $ "\n============ " ++ prefix ++ "biclique ============"+    test "biclique []      []      == empty" $+          biclique []      []      == id % empty++    test "biclique [x]     []      == vertex x" $ \x ->+          biclique [x]     []      == id % vertex x++    test "biclique []      [y]     == vertex y" $ \y ->+          biclique []      [y]     == id % vertex y++    test "biclique [x1,x2] [y1,y2] == edges [(x1,y1), (x1,y2), (x2,y1), (x2,y2)]" $ \(x1) x2 y1 y2 ->+          biclique [x1,x2] [y1,y2] == id % edges [(x1,y1), (x1,y2), (x2,y1), (x2,y2)]++    test "biclique xs      ys      == connect (vertices xs) (vertices ys)" $ \xs ys ->+          biclique xs      ys      == connect (vertices xs) % (vertices ys)++testStar :: Testsuite -> IO ()+testStar (Testsuite prefix (%)) = do+    putStrLn $ "\n============ " ++ prefix ++ "star ============"+    test "star x []    == vertex x" $ \x ->+          star x []    == id % vertex x++    test "star x [y]   == edge x y" $ \x y ->+          star x [y]   == id % edge x y++    test "star x [y,z] == edges [(x,y), (x,z)]" $ \x y z ->+          star x [y,z] == id % edges [(x,y), (x,z)]++testTree :: Testsuite -> IO ()+testTree (Testsuite prefix (%)) = do+    putStrLn $ "\n============ " ++ prefix ++ "tree ============"+    test "tree (Node x [])                                         == vertex x" $ \x ->+          tree (Node x [])                                         == id % vertex x++    test "tree (Node x [Node y [Node z []]])                       == path [x,y,z]" $ \x y z ->+          tree (Node x [Node y [Node z []]])                       == id % 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 []])                     == id % 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 []]]) == id % edges [(1,2), (1,3), (3,4), (3,5)]++testForest :: Testsuite -> IO ()+testForest (Testsuite prefix (%)) = do+    putStrLn $ "\n============ " ++ prefix ++ "forest ============"+    test "forest []                                                  == empty" $+          forest []                                                  == id % empty++    test "forest [x]                                                 == tree x" $ \x ->+          forest [x]                                                 == id % 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 []]] == id % edges [(1,2), (1,3), (4,5)]++    test "forest                                                     == overlays . map tree" $ \x ->+         (forest x)                                                  == id % (overlays . map tree) x++testRemoveVertex :: Testsuite -> IO ()+testRemoveVertex (Testsuite prefix (%)) = do+    putStrLn $ "\n============ " ++ prefix ++ "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++testRemoveEdge :: Testsuite -> IO ()+testRemoveEdge (Testsuite prefix (%)) = do+    putStrLn $ "\n============ " ++ prefix ++ "removeEdge ============"+    test "removeEdge x y (edge x y)       == vertices [x, y]" $ \x y ->+          removeEdge x y % edge x y       == vertices [x, y]++    test "removeEdge x y . removeEdge x y == removeEdge x y" $ \x y z ->+         (removeEdge x y . removeEdge x y) z == removeEdge x y % z++    test "removeEdge x y . removeVertex x == removeVertex x" $ \x y z ->+         (removeEdge x y . removeVertex x) z == removeVertex x % z++    test "removeEdge 1 1 (1 * 1 * 2 * 2)  == 1 * 2 * 2" $+          removeEdge 1 1 % (1 * 1 * 2 * 2) == 1 * 2 * 2++    test "removeEdge 1 2 (1 * 1 * 2 * 2)  == 1 * 1 + 2 * 2" $+          removeEdge 1 2 % (1 * 1 * 2 * 2) == 1 * 1 + 2 * 2++testReplaceVertex :: Testsuite -> IO ()+testReplaceVertex (Testsuite prefix (%)) = do+    putStrLn $ "\n============ " ++ prefix ++ "replaceVertex ============"+    test "replaceVertex x x            == id" $ \x y ->+          replaceVertex x x % y        == y++    test "replaceVertex x y (vertex x) == vertex y" $ \x y ->+          replaceVertex x y % vertex x == vertex y++    test "replaceVertex x y            == mergeVertices (== x) y" $ \x y z ->+          replaceVertex x y % z        == mergeVertices (== x) y z++testMergeVertices :: Testsuite -> IO ()+testMergeVertices (Testsuite prefix (%)) = do+    putStrLn $ "\n============ " ++ prefix ++ "mergeVertices ============"+    test "mergeVertices (const False) x    == id" $ \x y ->+          mergeVertices (const False) x % y == y++    test "mergeVertices (== x) y           == replaceVertex x y" $ \x y z ->+          mergeVertices (== x) y % z       == replaceVertex x y z++    test "mergeVertices even 1 (0 * 2)     == 1 * 1" $+          mergeVertices even 1 % (0 * 2)   == 1 * 1++    test "mergeVertices odd  1 (3 + 4 * 5) == 4 * 1" $+          mergeVertices odd  1 % (3 + 4 * 5) == 4 * 1++testTranspose :: Testsuite -> IO ()+testTranspose (Testsuite prefix (%)) = do+    putStrLn $ "\n============ " ++ prefix ++ "transpose ============"+    test "transpose empty       == empty" $+          transpose % empty     == empty++    test "transpose (vertex x)  == vertex x" $ \x ->+          transpose % (vertex x) == vertex x++    test "transpose (edge x y)  == edge y x" $ \x y ->+          transpose % (edge x y) == edge y x++    test "transpose . transpose == id" $ \x ->+         (transpose . transpose) % x == x++    test "transpose . path      == path    . reverse" $ \xs ->+          transpose % (path xs) == (path . reverse) xs++    test "transpose . circuit   == circuit . reverse" $ \xs ->+          transpose % (circuit xs) == (circuit . reverse) xs++    test "transpose . clique    == clique  . reverse" $ \xs ->+          transpose % (clique xs) == (clique . reverse) xs++    test "edgeList . transpose  == sort . map swap . edgeList" $ \x ->+          edgeList % (transpose x) == (sort . map swap . edgeList) x++testGmap :: Testsuite -> IO ()+testGmap (Testsuite prefix (%)) = do+    putStrLn $ "\n============ " ++ prefix ++ "gmap ============"+    test "gmap f empty      == empty" $ \(apply -> f) ->+          gmap f % empty      == empty++    test "gmap f (vertex x) == vertex (f x)" $ \(apply -> f) x ->+          gmap f % vertex x == vertex (f x)++    test "gmap f (edge x y) == edge (f x) (f y)" $ \(apply -> f) x y ->+          gmap f % edge x y == edge (f x) (f y)++    test "gmap id           == id" $ \x ->+          gmap id % x       == x++    test "gmap f . gmap g   == gmap (f . g)" $ \(apply -> f) (apply -> g) x ->+         (gmap f . gmap g) x == gmap (f . g) % x++testInduce :: Testsuite -> IO ()+testInduce (Testsuite prefix (%)) = do+    putStrLn $ "\n============ " ++ prefix ++ "induce ============"+    test "induce (const True)  x      == x" $ \x ->+          induce (const True) % x     == x++    test "induce (const False) x      == empty" $ \x ->+          induce (const False) % x    == empty++    test "induce (/= x)               == removeVertex x" $ \x y ->+          induce (/= x) % y           == removeVertex x y++    test "induce p . induce q         == induce (\\x -> p x && q x)" $ \(apply -> p) (apply -> q) y ->+         (induce p . induce q) % y    == induce (\x -> p x && q x) y++    test "isSubgraphOf (induce p x) x == True" $ \(apply -> p) x ->+          isSubgraphOf (induce p x) % x == True++testSplitVertex :: Testsuite -> IO ()+testSplitVertex (Testsuite prefix (%)) = do+    putStrLn $ "\n============ " ++ prefix ++ "splitVertex ============"+    test "splitVertex x []                   == removeVertex x" $ \x y ->+          splitVertex x [] % y               == removeVertex x y++    test "splitVertex x [x]                  == id" $ \x y ->+          splitVertex x [x] % y              == y++    test "splitVertex x [y]                  == replaceVertex x y" $ \x y z ->+          splitVertex x [y] % z              == replaceVertex x y z++    test "splitVertex 1 [0, 1] $ 1 * (2 + 3) == (0 + 1) * (2 + 3)" $+          splitVertex 1 [0, 1] % (1 * (2 + 3)) == (0 + 1) * (2 + 3)++testBind :: Testsuite -> IO ()+testBind (Testsuite prefix (%)) = do+    putStrLn $ "\n============ " ++ prefix ++ "bind ============"+    test "bind empty f         == empty" $ \(apply -> f) ->+          bind empty f         == id % empty++    test "bind (vertex x) f    == f x" $ \(apply -> f) x ->+          bind (vertex x) f    == id % f x++    test "bind (edge x y) f    == connect (f x) (f y)" $ \(apply -> f) x y ->+          bind (edge x y) f    == connect (f x) % (f y)++    test "bind (vertices xs) f == overlays (map f xs)" $ mapSize (min 10) $ \xs (apply -> f) ->+          bind (vertices xs) f == id % overlays (map f xs)++    test "bind x (const empty) == empty" $ \x ->+          bind x (const empty) == id % empty++    test "bind x vertex        == x" $ \x ->+          bind x vertex        == id % x++    test "bind (bind x f) g    == bind x (\\y -> bind (f y) g)" $ mapSize (min 10) $ \x (apply -> f) (apply -> g) ->+          bind (bind x f) g    == bind (id % x) (\y -> bind (f y) g)++testSimplify :: Testsuite -> IO ()+testSimplify (Testsuite prefix (%)) = do+    putStrLn $ "\n============ " ++ prefix ++ "simplify ============"+    test "simplify              == id" $ \x ->+          simplify % x          == x++    test "size (simplify x)     <= size x" $ \x ->+          size % simplify x     <= size x+++testDfsForest :: Testsuite -> IO ()+testDfsForest (Testsuite prefix (%)) = do+    putStrLn $ "\n============ " ++ prefix ++ "dfsForest ============"+    test "forest (dfsForest $ edge 1 1)         == vertex 1" $+          forest (dfsForest % edge 1 1)         == id % vertex 1++    test "forest (dfsForest $ edge 1 2)         == edge 1 2" $+          forest (dfsForest % edge 1 2)         == id % edge 1 2++    test "forest (dfsForest $ edge 2 1)         == vertices [1, 2]" $+          forest (dfsForest % edge 2 1)         == id % vertices [1, 2]++    test "isSubgraphOf (forest $ dfsForest x) x == True" $ \x ->+          isSubgraphOf (forest $ dfsForest x) % x == True++    test "dfsForest . forest . dfsForest        == dfsForest" $ \x ->+          dfsForest % (forest $ dfsForest x)    == dfsForest % x++    test "dfsForest (vertices vs)               == map (\\v -> Node v []) (nub $ sort vs)" $ \vs ->+          dfsForest % (vertices vs)             == map (\v -> Node v []) (nub $ sort vs)++    test "dfsForest $ 3 * (1 + 4) * (1 + 5)     == <correct result>" $+          dfsForest % (3 * (1 + 4) * (1 + 5))   == [ Node { rootLabel = 1+                                                   , subForest = [ Node { rootLabel = 5+                                                                        , subForest = [] }]}+                                                   , Node { rootLabel = 3+                                                   , subForest = [ Node { rootLabel = 4+                                                                        , subForest = [] }]}]++testDfsForestFrom :: Testsuite -> IO ()+testDfsForestFrom (Testsuite prefix (%)) = do+    putStrLn $ "\n============ " ++ prefix ++ "dfsForestFrom ============"+    test "forest (dfsForestFrom [1]    $ edge 1 1)     == vertex 1" $+          forest (dfsForestFrom [1]    % edge 1 1)     == id % vertex 1++    test "forest (dfsForestFrom [1]    $ edge 1 2)     == edge 1 2" $+          forest (dfsForestFrom [1]    % edge 1 2)     == id % edge 1 2++    test "forest (dfsForestFrom [2]    $ edge 1 2)     == vertex 2" $+          forest (dfsForestFrom [2]    % edge 1 2)     == id % vertex 2++    test "forest (dfsForestFrom [3]    $ edge 1 2)     == empty" $+          forest (dfsForestFrom [3]    % edge 1 2)     == id % empty++    test "forest (dfsForestFrom [2, 1] $ edge 1 2)     == vertices [1, 2]" $+          forest (dfsForestFrom [2, 1] % edge 1 2)     == id % vertices [1, 2]++    test "isSubgraphOf (forest $ dfsForestFrom vs x) x == True" $ \vs x ->+          isSubgraphOf (forest $ dfsForestFrom vs x) % x == True++    test "dfsForestFrom (vertexList x) x               == dfsForest x" $ \x ->+          dfsForestFrom (vertexList x) % x             == dfsForest % x++    test "dfsForestFrom vs             (vertices vs)   == map (\\v -> Node v []) (nub vs)" $ \vs ->+          dfsForestFrom vs           % (vertices vs)   == map (\v -> Node v []) (nub vs)++    test "dfsForestFrom []             x               == []" $ \x ->+          dfsForestFrom []           % x               == []++    test "dfsForestFrom [1, 4] $ 3 * (1 + 4) * (1 + 5) == <correct result>" $+          dfsForestFrom [1, 4] % (3 * (1 + 4) * (1 + 5)) == [ Node { rootLabel = 1+                                                                   , subForest = [ Node { rootLabel = 5+                                                                                        , subForest = [] }]}+                                                            , Node { rootLabel = 4+                                                                   , subForest = [] }]++testDfs :: Testsuite -> IO ()+testDfs (Testsuite prefix (%)) = do+    putStrLn $ "\n============ " ++ prefix ++ "dfs ============"+    test "dfs [1]    $ edge 1 1                == [1]" $+          dfs [1]    % edge 1 1                == [1]++    test "dfs [1]    $ edge 1 2                == [1, 2]" $+          dfs [1]    % edge 1 2                == [1, 2]++    test "dfs [2]    $ edge 1 2                == [2]" $+          dfs [2]    % edge 1 2                == [2]++    test "dfs [3]    $ edge 1 2                == []" $+          dfs [3]    % edge 1 2                == []++    test "dfs [1, 2] $ edge 1 2                == [1, 2]" $+          dfs [1, 2] % edge 1 2                == [1, 2]++    test "dfs [2, 1] $ edge 1 2                == [2, 1]" $+          dfs [2, 1] % edge 1 2                == [2, 1]++    test "dfs []     $ x                       == []" $ \x ->+          dfs []     % x                       == []++    test "dfs [1, 4] $ 3 * (1 + 4) * (1 + 5)   == [1, 5, 4]" $+          dfs [1, 4] % (3 * (1 + 4) * (1 + 5))   == [1, 5, 4]++    test "isSubgraphOf (vertices $ dfs vs x) x == True" $ \vs x ->+          isSubgraphOf (vertices $ dfs vs x) % x == True++testTopSort :: Testsuite -> IO ()+testTopSort (Testsuite prefix (%)) = do+    putStrLn $ "\n============ " ++ prefix ++ "topSort ============"+    test "topSort (1 * 2 + 3 * 1)             == Just [3,1,2]" $+          topSort % (1 * 2 + 3 * 1)           == Just [3,1,2]++    test "topSort (1 * 2 + 2 * 1)             == Nothing" $+          topSort % (1 * 2 + 2 * 1)           == Nothing++    test "fmap (flip isTopSort x) (topSort x) /= Just False" $ \x ->+          fmap (flip isTopSort x) (topSort % x) /= Just False++testIsTopSort :: Testsuite -> IO ()+testIsTopSort (Testsuite prefix (%)) = do+    putStrLn $ "\n============ " ++ prefix ++ "isTopSort ============"+    test "isTopSort [3, 1, 2] (1 * 2 + 3 * 1) == True" $+          isTopSort [3, 1, 2] % (1 * 2 + 3 * 1) == True++    test "isTopSort [1, 2, 3] (1 * 2 + 3 * 1) == False" $+          isTopSort [1, 2, 3] % (1 * 2 + 3 * 1) == False++    test "isTopSort []        (1 * 2 + 3 * 1) == False" $+          isTopSort []      % (1 * 2 + 3 * 1) == False++    test "isTopSort []        empty           == True" $+          isTopSort []      % empty           == True++    test "isTopSort [x]       (vertex x)      == True" $ \x ->+          isTopSort [x]      % vertex x       == True++    test "isTopSort [x]       (edge x x)      == False" $ \x ->+          isTopSort [x]      % edge x x       == False

@@ -1,4 +1,3 @@-{-# LANGUAGE ViewPatterns #-} ----------------------------------------------------------------------------- -- | -- Module     : Algebra.Graph.Test.Graph@@ -7,29 +6,25 @@ -- Maintainer : andrey.mokhov@gmail.com -- Stability  : experimental ----- Testsuite for 'Graph' and polymorphic functions defined in+-- Testsuite for "Algebra.Graph" and polymorphic functions defined in -- "Algebra.Graph.HigherKinded.Class".--- ----------------------------------------------------------------------------- module Algebra.Graph.Test.Graph (     -- * Testsuite     testGraph   ) where -import Data.Foldable-import Data.Tree-import Data.Tuple- import Algebra.Graph import Algebra.Graph.Test+import Algebra.Graph.Test.Generic -import qualified Data.Set    as Set-import qualified Data.IntSet as IntSet+t :: Testsuite+t = testsuite "Graph." empty +h :: HTestsuite+h = hTestsuite "Graph." empty+ type G  = Graph Int-type II = Int -> Int-type IB = Int -> Bool-type IG = Int -> G  testGraph :: IO () testGraph = do@@ -37,218 +32,13 @@     test "Axioms of graphs"   $ (axioms   :: GraphTestsuite G)     test "Theorems of graphs" $ (theorems :: GraphTestsuite G) -    putStrLn "\n============ Graph.empty ============"-    test "isEmpty     empty == True" $-          isEmpty    (empty :: G) == True--    test "hasVertex x empty == False" $ \(x :: Int) ->-          hasVertex x empty == False--    test "vertexCount empty == 0" $-          vertexCount(empty :: G) == 0--    test "edgeCount   empty == 0" $-          edgeCount  (empty :: G) == 0--    test "size        empty == 1" $-          size       (empty :: G) == 1--    putStrLn "\n============ Graph.vertex ============"-    test "isEmpty     (vertex x) == False" $ \(x :: Int) ->-          isEmpty     (vertex x) == False--    test "hasVertex x (vertex x) == True" $ \(x :: Int) ->-          hasVertex x (vertex x) == True--    test "hasVertex 1 (vertex 2) == False" $-          hasVertex 1 (vertex 2 :: G) == False--    test "vertexCount (vertex x) == 1" $ \(x :: Int) ->-          vertexCount (vertex x) == 1--    test "edgeCount   (vertex x) == 0" $ \(x :: Int) ->-          edgeCount   (vertex x) == 0--    test "size        (vertex x) == 1" $ \(x :: Int) ->-          size        (vertex x) == 1--    putStrLn "\n============ Graph.edge ============"-    test "edge x y               == connect (vertex x) (vertex y)" $ \(x :: Int) y ->-          edge x y               == connect (vertex x) (vertex y)--    test "hasEdge x y (edge x y) == True" $ \(x :: Int) y ->-          hasEdge x y (edge x y) == True--    test "edgeCount   (edge x y) == 1" $ \(x :: Int) y ->-          edgeCount   (edge x y) == 1--    test "vertexCount (edge 1 1) == 1" $-          vertexCount (edge 1 1 :: G) == 1--    test "vertexCount (edge 1 2) == 2" $-          vertexCount (edge 1 2 :: G) == 2--    putStrLn "\n============ Graph.overlay ============"-    test "isEmpty     (overlay x y) == isEmpty   x   && isEmpty   y" $ \(x :: G) y ->-          isEmpty     (overlay x y) ==(isEmpty   x   && isEmpty   y)--    test "hasVertex z (overlay x y) == hasVertex z x || hasVertex z y" $ \(x :: G) y z ->-          hasVertex z (overlay x y) ==(hasVertex z x || hasVertex z y)--    test "vertexCount (overlay x y) >= vertexCount x" $ \(x :: G) y ->-          vertexCount (overlay x y) >= vertexCount x--    test "vertexCount (overlay x y) <= vertexCount x + vertexCount y" $ \(x :: G) y ->-          vertexCount (overlay x y) <= vertexCount x + vertexCount y--    test "edgeCount   (overlay x y) >= edgeCount x" $ \(x :: G) y ->-          edgeCount   (overlay x y) >= edgeCount x--    test "edgeCount   (overlay x y) <= edgeCount x   + edgeCount y" $ \(x :: G) y ->-          edgeCount   (overlay x y) <= edgeCount x   + edgeCount y--    test "size        (overlay x y) == size x        + size y" $ \(x :: G) y ->-          size        (overlay x y) == size x        + size y--    test "vertexCount (overlay 1 2) == 2" $-          vertexCount (overlay 1 2 :: G) == 2--    test "edgeCount   (overlay 1 2) == 0" $-          edgeCount   (overlay 1 2 :: G) == 0--    putStrLn "\n============ Graph.connect ============"-    test "isEmpty     (connect x y) == isEmpty   x   && isEmpty   y" $ \(x :: G) y ->-          isEmpty     (connect x y) ==(isEmpty   x   && isEmpty   y)--    test "hasVertex z (connect x y) == hasVertex z x || hasVertex z y" $ \(x :: G) y z ->-          hasVertex z (connect x y) ==(hasVertex z x || hasVertex z y)--    test "vertexCount (connect x y) >= vertexCount x" $ \(x :: G) y ->-          vertexCount (connect x y) >= vertexCount x--    test "vertexCount (connect x y) <= vertexCount x + vertexCount y" $ \(x :: G) y ->-          vertexCount (connect x y) <= vertexCount x + vertexCount y--    test "edgeCount   (connect x y) >= edgeCount x" $ \(x :: G) y ->-          edgeCount   (connect x y) >= edgeCount x--    test "edgeCount   (connect x y) >= edgeCount y" $ \(x :: G) y ->-          edgeCount   (connect x y) >= edgeCount y--    test "edgeCount   (connect x y) >= vertexCount x * vertexCount y" $ \(x :: G) y ->-          edgeCount   (connect x y) >= vertexCount x * vertexCount y--    test "edgeCount   (connect x y) <= vertexCount x * vertexCount y + edgeCount x + edgeCount y" $ \(x :: G) y ->-          edgeCount   (connect x y) <= vertexCount x * vertexCount y + edgeCount x + edgeCount y--    test "size        (connect x y) == size x        + size y" $ \(x :: G) y ->-          size        (connect x y) == size x        + size y--    test "vertexCount (connect 1 2) == 2" $-          vertexCount (connect 1 2 :: G) == 2--    test "edgeCount   (connect 1 2) == 1" $-          edgeCount   (connect 1 2 :: G) == 1--    putStrLn "\n============ Graph.vertices ============"-    test "vertices []            == empty" $-          vertices []            == (empty :: G)--    test "vertices [x]           == vertex x" $ \(x :: Int) ->-          vertices [x]           == vertex x--    test "hasVertex x . vertices == elem x" $ \x (xs :: [Int]) ->-         (hasVertex x . vertices) xs == elem x xs--    test "vertexCount . vertices == length . nub" $ \(xs :: [Int]) ->-         (vertexCount . vertices) xs == (length . nubOrd) xs--    test "vertexSet   . vertices == Set.fromList" $ \(xs :: [Int]) ->-         (vertexSet   . vertices) xs == Set.fromList xs--    putStrLn "\n============ Graph.edges ============"-    test "edges []          == empty" $-          edges []          ==(empty :: G)--    test "edges [(x,y)]     == edge x y" $ \(x :: Int) y ->-          edges [(x,y)]     == edge x y--    test "edgeCount . edges == length . nub" $ \(xs :: [(Int, Int)]) ->-         (edgeCount . edges) xs == (length . nubOrd) xs--    putStrLn "\n============ Graph.overlays ============"-    test "overlays []        == empty" $-          overlays []        ==(empty :: G)--    test "overlays [x]       == x" $ \(x :: G) ->-          overlays [x]       == x--    test "overlays [x,y]     == overlay x y" $ \(x :: G) y ->-          overlays [x,y]     == overlay x y--    test "isEmpty . overlays == all isEmpty" $ \(xs :: [G]) ->-         (isEmpty . overlays) xs == all isEmpty xs--    putStrLn "\n============ Graph.connects ============"-    test "connects []        == empty" $-          connects []        ==(empty :: G)--    test "connects [x]       == x" $ \(x :: G) ->-          connects [x]       == x--    test "connects [x,y]     == connect x y" $ \(x :: G) y ->-          connects [x,y]     == connect x y--    test "isEmpty . connects == all isEmpty" $ \(xs :: [G]) ->-         (isEmpty . connects) xs == all isEmpty xs--    putStrLn "\n============ Graph.graph ============"-    test "graph []  []      == empty" $-          graph []  []      ==(empty :: G)--    test "graph [x] []      == vertex x" $ \(x :: Int) ->-          graph [x] []      == vertex x--    test "graph []  [(x,y)] == edge x y" $ \(x :: Int) y ->-          graph []  [(x,y)] == edge x y--    test "graph vs  es      == overlay (vertices vs) (edges es)" $ \(vs :: [Int]) es ->-          graph vs  es      == overlay (vertices vs) (edges es)--    putStrLn "\n============ Graph.foldg ============"-    test "foldg empty vertex        overlay connect        == id" $ \(x :: G) ->-          foldg empty vertex        overlay connect x      == x--    test "foldg empty vertex        overlay (flip connect) == transpose" $ \(x :: G) ->-          foldg empty vertex        overlay (flip connect)x== transpose x--    test "foldg []    return        (++)    (++)           == toList" $ \(x :: G) ->-          foldg []    return        (++)    (++) x         == toList x--    test "foldg 0     (const 1)     (+)     (+)            == length" $ \(x :: G) ->-          foldg 0     (const 1)     (+)     (+) x          == length x--    test "foldg 1     (const 1)     (+)     (+)            == size" $ \(x :: G) ->-          foldg 1     (const 1)     (+)     (+) x          == size x--    test "foldg True  (const False) (&&)    (&&)           == isEmpty" $ \(x :: G) ->-          foldg True  (const False) (&&)    (&&) x         == isEmpty x--    putStrLn "\n============ Graph.isSubgraphOf ============"-    test "isSubgraphOf empty         x             == True" $ \(x :: G) ->-          isSubgraphOf empty         x             == True--    test "isSubgraphOf (vertex x)    empty         == False" $ \x ->-          isSubgraphOf (vertex x)   (empty :: G)   == False--    test "isSubgraphOf x             (overlay x y) == True" $ \(x :: G) y ->-          isSubgraphOf x             (overlay x y) == True--    test "isSubgraphOf (overlay x y) (connect x y) == True" $ \(x :: G) y ->-          isSubgraphOf (overlay x y) (connect x y) == True--    test "isSubgraphOf (path xs)     (circuit xs)  == True" $ \xs ->-          isSubgraphOf (path xs :: G)(circuit xs)  == True+    testBasicPrimitives t+    testFoldg           h+    testIsSubgraphOf    t+    testSize            t+    testProperties      t+    testGraphFamilies   t+    testTransformations t      putStrLn "\n============ Graph.(===) ============"     test "    x === x         == True" $ \(x :: G) ->@@ -266,237 +56,6 @@     test "x + y === x * y     == False" $ \(x :: G) y ->          (x + y === x * y)    == False -    putStrLn "\n============ Graph.isEmpty ============"-    test "isEmpty empty                       == True" $-          isEmpty (empty :: G)                == True--    test "isEmpty (overlay empty empty)       == True" $-          isEmpty (overlay empty empty :: G)  == True--    test "isEmpty (vertex x)                  == False" $ \(x :: Int) ->-          isEmpty (vertex x)                  == False--    test "isEmpty (removeVertex x $ vertex x) == True" $ \(x :: Int) ->-          isEmpty (removeVertex x $ vertex x) == True--    test "isEmpty (removeEdge x y $ edge x y) == False" $ \(x :: Int) y ->-          isEmpty (removeEdge x y $ edge x y) == False--    putStrLn "\n============ Graph.size ============"-    test "size empty         == 1" $-          size (empty :: G)  == 1--    test "size (vertex x)    == 1" $ \(x :: Int) ->-          size (vertex x)    == 1--    test "size (overlay x y) == size x + size y" $ \(x :: G) y ->-          size (overlay x y) == size x + size y--    test "size (connect x y) == size x + size y" $ \(x :: G) y ->-          size (connect x y) == size x + size y--    test "size x             >= 1" $ \(x :: G) ->-          size x             >= 1--    test "size x             >= vertexCount x" $ \(x :: G) ->-          size x             >= vertexCount x--    putStrLn "\n============ Graph.hasVertex ============"-    test "hasVertex x empty            == False" $ \(x :: Int) ->-          hasVertex x empty            == False--    test "hasVertex x (vertex x)       == True" $ \(x :: Int) ->-          hasVertex x (vertex x)       == True--    test "hasVertex x . removeVertex x == const False" $ \(x :: Int) y ->-          hasVertex x (removeVertex x y)==const False y--    putStrLn "\n============ Graph.hasEdge ============"-    test "hasEdge x y empty            == False" $ \(x :: Int) y ->-          hasEdge x y empty            == False--    test "hasEdge x y (vertex z)       == False" $ \(x :: Int) y z ->-          hasEdge x y (vertex z)       == False--    test "hasEdge x y (edge x y)       == True" $ \(x :: Int) y ->-          hasEdge x y (edge x y)       == True--    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============ Graph.vertexCount ============"-    test "vertexCount empty      == 0" $-          vertexCount (empty :: G) == 0--    test "vertexCount (vertex x) == 1" $ \(x :: Int) ->-          vertexCount (vertex x) == 1--    test "vertexCount            == length . vertexList" $ \(x :: G) ->-          vertexCount x          ==(length . vertexList) x--    putStrLn "\n============ Graph.edgeCount ============"-    test "edgeCount empty      == 0" $-          edgeCount (empty :: G) == 0--    test "edgeCount (vertex x) == 0" $ \(x :: Int) ->-          edgeCount (vertex x) == 0--    test "edgeCount (edge x y) == 1" $ \(x :: Int) y ->-          edgeCount (edge x y) == 1--    test "edgeCount            == length . edgeList" $ \(x :: G) ->-          edgeCount x          == (length . edgeList) x--    putStrLn "\n============ Graph.vertexList ============"-    test "vertexList empty      == []" $-          vertexList (empty :: G) == []--    test "vertexList (vertex x) == [x]" $ \(x :: Int) ->-          vertexList (vertex x) == [x]--    test "vertexList . vertices == nub . sort" $ \(xs :: [Int]) ->-         (vertexList . vertices) xs == (nubOrd . sort) xs--    putStrLn "\n============ Graph.edgeList ============"-    test "edgeList empty          == []" $-          edgeList (empty :: G )  == []--    test "edgeList (vertex x)     == []" $ \(x :: Int) ->-          edgeList (vertex x)     == []--    test "edgeList (edge x y)     == [(x,y)]" $ \(x :: Int) y ->-          edgeList (edge x y)     == [(x,y)]--    test "edgeList (star 2 [3,1]) == [(2,1), (2,3)]" $-          edgeList (star 2 [3,1]) == [(2,1), (2,3 :: Int)]--    test "edgeList . edges        == nub . sort" $ \(xs :: [(Int, Int)]) ->-         (edgeList . edges) xs    ==(nubOrd . sort) xs--    putStrLn "\n============ Graph.vertexSet ============"-    test "vertexSet empty      == Set.empty" $-          vertexSet(empty :: G)== Set.empty--    test "vertexSet . vertex   == Set.singleton" $ \(x :: Int) ->-         (vertexSet . vertex) x== Set.singleton x--    test "vertexSet . vertices == Set.fromList" $ \(xs :: [Int]) ->-         (vertexSet . vertices) xs == Set.fromList xs--    test "vertexSet . clique   == Set.fromList" $ \(xs :: [Int]) ->-         (vertexSet . clique) xs == Set.fromList xs--    putStrLn "\n============ Graph.vertexIntSet ============"-    test "vertexIntSet empty      == IntSet.empty" $-          vertexIntSet(empty :: G)== IntSet.empty--    test "vertexIntSet . vertex   == IntSet.singleton" $ \(x :: Int) ->-         (vertexIntSet . vertex) x== IntSet.singleton x--    test "vertexIntSet . vertices == IntSet.fromList" $ \(xs :: [Int]) ->-         (vertexIntSet . vertices) xs == IntSet.fromList xs--    test "vertexIntSet . clique   == IntSet.fromList" $ \(xs :: [Int]) ->-         (vertexIntSet . clique) xs == IntSet.fromList xs--    putStrLn "\n============ Graph.edgeSet ============"-    test "edgeSet empty      == Set.empty" $-          edgeSet (empty :: G) == Set.empty--    test "edgeSet (vertex x) == Set.empty" $ \(x :: Int) ->-          edgeSet (vertex x) == Set.empty--    test "edgeSet (edge x y) == Set.singleton (x,y)" $ \(x :: Int) y ->-          edgeSet (edge x y) == Set.singleton (x,y)--    test "edgeSet . edges    == Set.fromList" $ \(xs :: [(Int, Int)]) ->-         (edgeSet . edges) xs== Set.fromList xs--    putStrLn "\n============ Graph.path ============"-    test "path []    == empty" $-          path []    ==(empty :: G)--    test "path [x]   == vertex x" $ \(x :: Int) ->-          path [x]   == vertex x--    test "path [x,y] == edge x y" $ \(x :: Int) y ->-          path [x,y] == edge x y--    putStrLn "\n============ Graph.circuit ============"-    test "circuit []    == empty" $-          circuit []    ==(empty :: G)--    test "circuit [x]   == edge x x" $ \(x :: Int) ->-          circuit [x]   == edge x x--    test "circuit [x,y] == edges [(x,y), (y,x)]" $ \(x :: Int) y ->-          circuit [x,y] == edges [(x,y), (y,x)]--    putStrLn "\n============ Graph.clique ============"-    test "clique []      == empty" $-          clique []      ==(empty :: G)--    test "clique [x]     == vertex x" $ \(x :: Int) ->-          clique [x]     == vertex x--    test "clique [x,y]   == edge x y" $ \(x :: Int) y ->-          clique [x,y]   == edge x y--    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============ Graph.biclique ============"-    test "biclique []      []      == empty" $-          biclique []      []      ==(empty :: G)--    test "biclique [x]     []      == vertex x" $ \(x :: Int) ->-          biclique [x]     []      == vertex x--    test "biclique []      [y]     == vertex y" $ \(y :: Int) ->-          biclique []      [y]     == vertex y--    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)]--    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--    test "star x [y]   == edge x y" $ \(x :: Int) y ->-          star x [y]   == edge x y--    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============ 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))@@ -548,174 +107,18 @@                     deBruijn 2 "01"             == edges [ ("00","00"), ("00","01"), ("01","10"), ("01","11")                                                          , ("10","00"), ("10","01"), ("11","10"), ("11","11") ] +    test "          transpose   (deBruijn n xs) == fmap reverse $ deBruijn n xs" $ mapSize (min 5) $ \(NonNegative n) (xs :: [Int]) ->+                    transpose   (deBruijn n xs) == (fmap reverse $ deBruijn n xs)+     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============ Graph.removeEdge ============"-    test "removeEdge x y (edge x y)       == vertices [x, y]" $ \(x :: Int) y ->-          removeEdge x y (edge x y)       == vertices [x, y]--    test "removeEdge x y . removeEdge x y == removeEdge x y" $ \(x :: Int) y z ->-         (removeEdge x y . removeEdge x y)z==removeEdge x y z--    test "removeEdge x y . removeVertex x == removeVertex x" $ \(x :: Int) y z ->-         (removeEdge x y . removeVertex x)z==removeVertex x z--    test "removeEdge 1 1 (1 * 1 * 2 * 2)  == 1 * 2 * 2" $-          removeEdge 1 1 (1 * 1 * 2 * 2)  ==(1 * 2 * (2 :: G))--    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============ Graph.replaceVertex ============"-    test "replaceVertex x x            == id" $ \x (y :: G) ->-          replaceVertex x x y          == y--    test "replaceVertex x y (vertex x) == vertex y" $ \x (y :: Int) ->-          replaceVertex x y (vertex x) == vertex y--    test "replaceVertex x y            == mergeVertices (== x) y" $ \x y z ->-          replaceVertex x y z          == mergeVertices (== x) y (z :: G)--    putStrLn "\n============ Graph.mergeVertices ============"-    test "mergeVertices (const False) x    == id" $ \x (y :: G) ->-          mergeVertices (const False) x y  == y--    test "mergeVertices (== x) y           == replaceVertex x y" $ \x y (z :: G) ->-          mergeVertices (== x) y z         == replaceVertex x y z--    test "mergeVertices even 1 (0 * 2)     == 1 * 1" $-          mergeVertices even 1 (0 * 2)     ==(1 * 1 :: G)--    test "mergeVertices odd  1 (3 + 4 * 5) == 4 * 1" $-          mergeVertices odd  1 (3 + 4 * 5) ==(4 * 1 :: G)--    putStrLn "\n============ Graph.splitVertex ============"-    test "splitVertex x []                   == removeVertex x" $ \x (y :: G) ->-         (splitVertex x []) y                == removeVertex x y--    test "splitVertex x [x]                  == id" $ \x (y :: G) ->-         (splitVertex x [x]) y               == y--    test "splitVertex x [y]                  == replaceVertex x y" $ \x y (z :: G) ->-         (splitVertex x [y]) z               == replaceVertex x y z--    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============ Graph.transpose ============"-    test "transpose empty       == empty" $-          transpose empty       ==(empty :: G)--    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 :: G) ->-         (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 "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--    test "fmap f (vertex x) == vertex (f x)" $ \(apply -> f :: II) x ->-          fmap f (vertex x) == vertex (f x)--    test "fmap f (edge x y) == edge (f x) (f y)" $ \(apply -> f :: II) x y ->-          fmap f (edge x y) == edge (f x) (f y)--    test "fmap id           == id" $ \(x :: G) ->-          fmap id x         == x--    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============ Graph.>>= ============"-    test "empty >>= f       == empty" $ \(apply -> f :: IG) ->-         (empty >>= f)      == empty--    test "vertex x >>= f    == f x" $ \(apply -> f :: IG) x ->-         (vertex x >>= f)   == f x--    test "edge x y   >>= f  == connect (f x) (f y)" $ \(apply -> f :: IG) x y ->-         (edge x y   >>= f) == connect (f x) (f y)--    test "vertices xs >>= f == overlays (map f xs)" $ mapSize (min 10) $ \xs (apply -> f :: IG) ->-         (vertices xs >>= f)== overlays (map f xs)--    test "x >>= const empty == empty" $ \(x :: G) ->-         (x >>= const empty)==(empty :: G)--    test "x >>= vertex      == x" $ \(x :: G) ->-         (x >>= vertex)     == x--    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============ Graph.induce ============"-    test "induce (const True)  x      == x" $ \(x :: G) ->-          induce (const True)  x      == x--    test "induce (const False) x      == empty" $ \(x :: G) ->-          induce (const False) x      == empty--    test "induce (/= x)               == removeVertex x" $ \x (y :: G) ->-          induce (/= x) y             == removeVertex x y--    test "induce p . induce q         == induce (\\x -> p x && q x)" $ \(apply -> p :: IB) (apply -> q :: IB) (y :: G) ->-         (induce p . induce q) y      == induce (\x -> p x && q x) y--    test "isSubgraphOf (induce p x) x == True" $ \(apply -> p :: IB) (x :: G) ->-          isSubgraphOf (induce p x) x == True--    putStrLn "\n============ Graph.simplify ============"-    test "simplify              == id" $ \(x :: G) ->-          simplify x            == x--    test "size (simplify x)     <= size x" $ \(x :: G) ->-          size (simplify x)     <= size x--    test "simplify empty       === empty" $-          simplify (empty :: G)=== empty--    test "simplify 1           === 1" $-          simplify 1           === (1 :: G)--    test "simplify (1 + 1)     === 1" $-          simplify (1 + 1)     === (1 :: G)--    test "simplify (1 + 2 + 1) === 1 + 2" $-          simplify (1 + 2 + 1) === (1 + 2 :: G)--    test "simplify (1 * 1 * 1) === 1 * 1" $-          simplify (1 * 1 * 1) === (1 * 1 :: G)+    testSplitVertex t+    testBind        t+    testSimplify    t      putStrLn "\n============ Graph.box ============"     let unit = fmap $ \(a, ()) -> a@@ -736,10 +139,11 @@     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 "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 "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--

@@ -1,4 +1,3 @@-{-# LANGUAGE ViewPatterns #-} ----------------------------------------------------------------------------- -- | -- Module     : Algebra.Graph.Test.IntAdjacencyMap@@ -7,24 +6,24 @@ -- Maintainer : andrey.mokhov@gmail.com -- Stability  : experimental ----- Testsuite for 'IntAdjacencyMap'.---+-- Testsuite for "Algebra.Graph.IntAdjacencyMap". ----------------------------------------------------------------------------- module Algebra.Graph.Test.IntAdjacencyMap (     -- * Testsuite     testIntAdjacencyMap   ) where -import Data.Tree- import Algebra.Graph.IntAdjacencyMap import Algebra.Graph.IntAdjacencyMap.Internal import Algebra.Graph.Test+import Algebra.Graph.Test.Generic  import qualified Data.Graph  as KL import qualified Data.IntSet as IntSet-import qualified Data.Set    as Set +t :: Testsuite+t = testsuite "IntAdjacencyMap." empty+ testIntAdjacencyMap :: IO () testIntAdjacencyMap = do     putStrLn "\n============ IntAdjacencyMap ============"@@ -36,587 +35,26 @@     test "Consistency of fromAdjacencyList" $ \xs ->         consistent (fromAdjacencyList xs) -    putStrLn "\n============ IntAdjacencyMap.Show ============"-    test "show (empty     :: IntAdjacencyMap) == \"empty\"" $-          show (empty     :: IntAdjacencyMap) == "empty"--    test "show (1         :: IntAdjacencyMap) == \"vertex 1\"" $-          show (1         :: IntAdjacencyMap) == "vertex 1"--    test "show (1 + 2     :: IntAdjacencyMap) == \"vertices [1,2]\"" $-          show (1 + 2     :: IntAdjacencyMap) == "vertices [1,2]"--    test "show (1 * 2     :: IntAdjacencyMap) == \"edge 1 2\"" $-          show (1 * 2     :: IntAdjacencyMap) == "edge 1 2"--    test "show (1 * 2 * 3 :: IntAdjacencyMap) == \"edges [(1,2),(1,3),(2,3)]\"" $-          show (1 * 2 * 3 :: IntAdjacencyMap) == "edges [(1,2),(1,3),(2,3)]"--    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============ IntAdjacencyMap.empty ============"-    test "isEmpty     empty == True" $-          isEmpty     empty == True--    test "hasVertex x empty == False" $ \x ->-          hasVertex x empty == False--    test "vertexCount empty == 0" $-          vertexCount empty == 0--    test "edgeCount   empty == 0" $-          edgeCount   empty == 0--    putStrLn "\n============ IntAdjacencyMap.vertex ============"-    test "isEmpty     (vertex x) == False" $ \x ->-          isEmpty     (vertex x) == False--    test "hasVertex x (vertex x) == True" $ \x ->-          hasVertex x (vertex x) == True--    test "hasVertex 1 (vertex 2) == False" $-          hasVertex 1 (vertex 2) == False--    test "vertexCount (vertex x) == 1" $ \x ->-          vertexCount (vertex x) == 1--    test "edgeCount   (vertex x) == 0" $ \x ->-          edgeCount   (vertex x) == 0--    putStrLn "\n============ IntAdjacencyMap.edge ============"-    test "edge x y               == connect (vertex x) (vertex y)" $ \x y ->-          edge x y               == connect (vertex x) (vertex y)--    test "hasEdge x y (edge x y) == True" $ \x y ->-          hasEdge x y (edge x y) == True--    test "edgeCount   (edge x y) == 1" $ \x y ->-          edgeCount   (edge x y) == 1--    test "vertexCount (edge 1 1) == 1" $-          vertexCount (edge 1 1) == 1--    test "vertexCount (edge 1 2) == 2" $-          vertexCount (edge 1 2) == 2--    putStrLn "\n============ IntAdjacencyMap.overlay ============"-    test "isEmpty     (overlay x y) == isEmpty   x   && isEmpty   y" $ \x y ->-          isEmpty     (overlay x y) == (isEmpty  x   && isEmpty   y)--    test "hasVertex z (overlay x y) == hasVertex z x || hasVertex z y" $ \x y z ->-          hasVertex z (overlay x y) == (hasVertex z x|| hasVertex z y)--    test "vertexCount (overlay x y) >= vertexCount x" $ \x y ->-          vertexCount (overlay x y) >= vertexCount x--    test "vertexCount (overlay x y) <= vertexCount x + vertexCount y" $ \x y ->-          vertexCount (overlay x y) <= vertexCount x + vertexCount y--    test "edgeCount   (overlay x y) >= edgeCount x" $ \x y ->-          edgeCount   (overlay x y) >= edgeCount x--    test "edgeCount   (overlay x y) <= edgeCount x   + edgeCount y" $ \x y ->-          edgeCount   (overlay x y) <= edgeCount x   + edgeCount y--    test "vertexCount (overlay 1 2) == 2" $-          vertexCount (overlay 1 2) == 2--    test "edgeCount   (overlay 1 2) == 0" $-          edgeCount   (overlay 1 2) == 0--    putStrLn "\n============ IntAdjacencyMap.connect ============"-    test "isEmpty     (connect x y) == isEmpty   x   && isEmpty   y" $ \x y ->-          isEmpty     (connect x y) == (isEmpty  x   && isEmpty   y)--    test "hasVertex z (connect x y) == hasVertex z x || hasVertex z y" $ \x y z ->-          hasVertex z (connect x y) == (hasVertex z x || hasVertex z y)--    test "vertexCount (connect x y) >= vertexCount x" $ \x y ->-          vertexCount (connect x y) >= vertexCount x--    test "vertexCount (connect x y) <= vertexCount x + vertexCount y" $ \x y ->-          vertexCount (connect x y) <= vertexCount x + vertexCount y--    test "edgeCount   (connect x y) >= edgeCount x" $ \x y ->-          edgeCount   (connect x y) >= edgeCount x--    test "edgeCount   (connect x y) >= edgeCount y" $ \x y ->-          edgeCount   (connect x y) >= edgeCount y--    test "edgeCount   (connect x y) >= vertexCount x * vertexCount y" $ \x y ->-          edgeCount   (connect x y) >= vertexCount x * vertexCount y--    test "edgeCount   (connect x y) <= vertexCount x * vertexCount y + edgeCount x + edgeCount y" $ \x y ->-          edgeCount   (connect x y) <= vertexCount x * vertexCount y + edgeCount x + edgeCount y--    test "vertexCount (connect 1 2) == 2" $-          vertexCount (connect 1 2) == 2--    test "edgeCount   (connect 1 2) == 1" $-          edgeCount   (connect 1 2) == 1--    putStrLn "\n============ IntAdjacencyMap.vertices ============"-    test "vertices []            == empty" $-          vertices []            == empty--    test "vertices [x]           == vertex x" $ \x ->-          vertices [x]           == vertex x--    test "hasVertex x . vertices == elem x" $ \x xs ->-         (hasVertex x . vertices) xs == elem x xs--    test "vertexCount . vertices == length . nub" $ \xs ->-         (vertexCount . vertices) xs == (length . nubOrd) xs--    test "vertexSet   . vertices == IntSet.fromList" $ \xs ->-         (vertexSet   . vertices) xs == IntSet.fromList xs--    putStrLn "\n============ IntAdjacencyMap.edges ============"-    test "edges []          == empty" $-          edges []          ==  empty--    test "edges [(x,y)]     == edge x y" $ \x y ->-          edges [(x,y)]     == edge x y--    test "edgeCount . edges == length . nub" $ \xs ->-         (edgeCount . edges) xs == (length . nubOrd) xs--    putStrLn "\n============ IntAdjacencyMap.overlays ============"-    test "overlays []        == empty" $-          overlays []        == empty--    test "overlays [x]       == x" $ \x ->-          overlays [x]       == x--    test "overlays [x,y]     == overlay x y" $ \x y ->-          overlays [x,y]     == overlay x y--    test "isEmpty . overlays == all isEmpty" $ mapSize (min 10) $ \xs ->-         (isEmpty . overlays) xs == all isEmpty xs--    putStrLn "\n============ IntAdjacencyMap.connects ============"-    test "connects []        == empty" $-          connects []        == empty--    test "connects [x]       == x" $ \x ->-          connects [x]       == x--    test "connects [x,y]     == connect x y" $ \x y ->-          connects [x,y]     == connect x y--    test "isEmpty . connects == all isEmpty" $ mapSize (min 10) $ \xs ->-         (isEmpty . connects) xs == all isEmpty xs--    putStrLn "\n============ IntAdjacencyMap.graph ============"-    test "graph []  []      == empty" $-          graph []  []      == empty--    test "graph [x] []      == vertex x" $ \x ->-          graph [x] []      == vertex x--    test "graph []  [(x,y)] == edge x y" $ \x y ->-          graph []  [(x,y)] == edge x y--    test "graph vs  es      == overlay (vertices vs) (edges es)" $ \(vs :: [Int]) es ->-          graph vs  es      == overlay (vertices vs) (edges es)--    putStrLn "\n============ IntAdjacencyMap.fromAdjacencyList ============"-    test "fromAdjacencyList []                                  == empty" $-          fromAdjacencyList []                                  == empty--    test "fromAdjacencyList [(x, [])]                           == vertex x" $ \x ->-          fromAdjacencyList [(x, [])]                           == vertex x--    test "fromAdjacencyList [(x, [y])]                          == edge x y" $ \x y ->-          fromAdjacencyList [(x, [y])]                          == edge x y--    test "fromAdjacencyList . adjacencyList                     == id" $ \x ->-         (fromAdjacencyList . adjacencyList) x                  == x--    test "overlay (fromAdjacencyList xs) (fromAdjacencyList ys) == fromAdjacencyList (xs ++ ys)" $ \xs ys ->-          overlay (fromAdjacencyList xs) (fromAdjacencyList ys) == fromAdjacencyList (xs ++ ys)--    putStrLn "\n============ IntAdjacencyMap.isSubgraphOf ============"-    test "isSubgraphOf empty         x             == True" $ \x ->-          isSubgraphOf empty         x             == True--    test "isSubgraphOf (vertex x)    empty         == False" $ \x ->-          isSubgraphOf (vertex x)    empty         == False--    test "isSubgraphOf x             (overlay x y) == True" $ \x y ->-          isSubgraphOf x             (overlay x y) == True--    test "isSubgraphOf (overlay x y) (connect x y) == True" $ \x y ->-          isSubgraphOf (overlay x y) (connect x y) == True--    test "isSubgraphOf (path xs)     (circuit xs)  == True" $ \xs ->-          isSubgraphOf (path xs)     (circuit xs)  == True--    putStrLn "\n============ IntAdjacencyMap.isEmpty ============"-    test "isEmpty empty                       == True" $-          isEmpty empty                       == True--    test "isEmpty (overlay empty empty)       == True" $-          isEmpty (overlay empty empty)       == True--    test "isEmpty (vertex x)                  == False" $ \x ->-          isEmpty (vertex x)                  == False--    test "isEmpty (removeVertex x $ vertex x) == True" $ \x ->-          isEmpty (removeVertex x $ vertex x) == True--    test "isEmpty (removeEdge x y $ edge x y) == False" $ \x y ->-          isEmpty (removeEdge x y $ edge x y) == False--    putStrLn "\n============ IntAdjacencyMap.hasVertex ============"-    test "hasVertex x empty            == False" $ \x ->-          hasVertex x empty            == False--    test "hasVertex x (vertex x)       == True" $ \x ->-          hasVertex x (vertex x)       == True--    test "hasVertex x . removeVertex x == const False" $ \x y ->-          hasVertex x (removeVertex x y)==const False y--    putStrLn "\n============ IntAdjacencyMap.hasEdge ============"-    test "hasEdge x y empty            == False" $ \x y ->-          hasEdge x y empty            == False--    test "hasEdge x y (vertex z)       == False" $ \x y z ->-          hasEdge x y (vertex z)       == False--    test "hasEdge x y (edge x y)       == True" $ \x y ->-          hasEdge x y (edge x y)       == True--    test "hasEdge x y . removeEdge x y == const False" $ \x y z ->-          hasEdge x y (removeEdge x y z)==const False z--    putStrLn "\n============ IntAdjacencyMap.vertexCount ============"-    test "vertexCount empty      == 0" $-          vertexCount empty      == 0--    test "vertexCount (vertex x) == 1" $ \x ->-          vertexCount (vertex x) == 1--    test "vertexCount            == length . vertexList" $ \x ->-          vertexCount x          == (length . vertexList) x--    putStrLn "\n============ IntAdjacencyMap.edgeCount ============"-    test "edgeCount empty      == 0" $-          edgeCount empty      == 0--    test "edgeCount (vertex x) == 0" $ \x ->-          edgeCount (vertex x) == 0--    test "edgeCount (edge x y) == 1" $ \x y ->-          edgeCount (edge x y) == 1--    test "edgeCount            == length . edgeList" $ \x ->-          edgeCount x          == (length . edgeList) x--    putStrLn "\n============ IntAdjacencyMap.vertexList ============"-    test "vertexList empty      == []" $-          vertexList empty      == []--    test "vertexList (vertex x) == [x]" $ \x ->-          vertexList (vertex x) == [x]--    test "vertexList . vertices == nub . sort" $ \xs ->-         (vertexList . vertices) xs == (nubOrd . sort) xs--    putStrLn "\n============ IntAdjacencyMap.edgeList ============"-    test "edgeList empty          == []" $-          edgeList empty          == []--    test "edgeList (vertex x)     == []" $ \x ->-          edgeList (vertex x)     == []--    test "edgeList (edge x y)     == [(x,y)]" $ \x y ->-          edgeList (edge x y)     == [(x,y)]--    test "edgeList (star 2 [3,1]) == [(2,1), (2,3)]" $-          edgeList (star 2 [3,1]) == [(2,1), (2,3)]--    test "edgeList . edges        == nub . sort" $ \xs ->-         (edgeList . edges) xs    == (nubOrd . sort) xs--    putStrLn "\n============ IntAdjacencyMap.adjacencyList ============"-    test "adjacencyList empty          == []" $-          adjacencyList empty          == []--    test "adjacencyList (vertex x)     == [(x, [])]" $ \x ->-          adjacencyList (vertex x)     == [(x, [])]--    test "adjacencyList (edge 1 2)     == [(1, [2]), (2, [])]" $-          adjacencyList (edge 1 2)     == [(1, [2]), (2, [])]--    test "adjacencyList (star 2 [3,1]) == [(1, []), (2, [1,3]), (3, [])]" $-          adjacencyList (star 2 [3,1]) == [(1, []), (2, [1,3]), (3, [])]--    putStrLn "\n============ IntAdjacencyMap.vertexSet ============"-    test "vertexSet empty      == IntSet.empty" $-          vertexSet empty      == IntSet.empty--    test "vertexSet . vertex   == IntSet.singleton" $ \x ->-         (vertexSet . vertex) x== IntSet.singleton x--    test "vertexSet . vertices == IntSet.fromList" $ \xs ->-         (vertexSet . vertices) xs == IntSet.fromList xs--    test "vertexSet . clique   == IntSet.fromList" $ \xs ->-         (vertexSet . clique) xs == IntSet.fromList xs--    putStrLn "\n============ IntAdjacencyMap.edgeSet ============"-    test "edgeSet empty      == Set.empty" $-          edgeSet empty      == Set.empty--    test "edgeSet (vertex x) == Set.empty" $ \x ->-          edgeSet (vertex x) == Set.empty--    test "edgeSet (edge x y) == Set.singleton (x,y)" $ \x y ->-          edgeSet (edge x y) == Set.singleton (x,y)--    test "edgeSet . edges    == Set.fromList" $ \xs ->-         (edgeSet . edges) xs== Set.fromList xs--    putStrLn "\n============ IntAdjacencyMap.postset ============"-    test "postset x empty      == IntSet.empty" $ \x ->-          postset x empty      == IntSet.empty--    test "postset x (vertex x) == IntSet.empty" $ \x ->-          postset x (vertex x) == IntSet.empty--    test "postset x (edge x y) == IntSet.fromList [y]" $ \x y ->-          postset x (edge x y) == IntSet.fromList [y]--    test "postset 2 (edge 1 2) == IntSet.empty" $-          postset 2 (edge 1 2) == IntSet.empty--    putStrLn "\n============ IntAdjacencyMap.path ============"-    test "path []    == empty" $-          path []    == empty--    test "path [x]   == vertex x" $ \x ->-          path [x]   == vertex x--    test "path [x,y] == edge x y" $ \x y ->-          path [x,y] == edge x y--    putStrLn "\n============ IntAdjacencyMap.circuit ============"-    test "circuit []    == empty" $-          circuit []    == empty--    test "circuit [x]   == edge x x" $ \x ->-          circuit [x]   == edge x x--    test "circuit [x,y] == edges [(x,y), (y,x)]" $ \x y ->-          circuit [x,y] == edges [(x,y), (y,x)]--    putStrLn "\n============ IntAdjacencyMap.clique ============"-    test "clique []      == empty" $-          clique []      == empty--    test "clique [x]     == vertex x" $ \x ->-          clique [x]     == vertex x--    test "clique [x,y]   == edge x y" $ \x y ->-          clique [x,y]   == edge x y--    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============ IntAdjacencyMap.biclique ============"-    test "biclique []      []      == empty" $-          biclique []      []      == empty--    test "biclique [x]     []      == vertex x" $ \x ->-          biclique [x]     []      == vertex x--    test "biclique []      [y]     == vertex y" $ \(y) ->-          biclique []      [y]     == vertex y--    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)]--    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--    test "star x [y]   == edge x y" $ \x y ->-          star x [y]   == edge x y--    test "star x [y,z] == edges [(x,y), (x,z)]" $ \x y z ->-          star x [y,z] == edges [(x,y), (x,z)]--    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============ IntAdjacencyMap.removeEdge ============"-    test "removeEdge x y (edge x y)       == vertices [x, y]" $ \x y ->-          removeEdge x y (edge x y)       == vertices [x, y]--    test "removeEdge x y . removeEdge x y == removeEdge x y" $ \x y z ->-         (removeEdge x y . removeEdge x y)z==removeEdge x y z--    test "removeEdge x y . removeVertex x == removeVertex x" $ \x y z ->-         (removeEdge x y . removeVertex x)z==removeVertex x z--    test "removeEdge 1 1 (1 * 1 * 2 * 2)  == 1 * 2 * 2" $-          removeEdge 1 1 (1 * 1 * 2 * 2)  == 1 * 2 * 2--    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============ IntAdjacencyMap.replaceVertex ============"-    test "replaceVertex x x            == id" $ \x (y) ->-          replaceVertex x x y          == y--    test "replaceVertex x y (vertex x) == vertex y" $ \x (y) ->-          replaceVertex x y (vertex x) == vertex y--    test "replaceVertex x y            == mergeVertices (== x) y" $ \x y z ->-          replaceVertex x y z          == mergeVertices (== x) y z--    putStrLn "\n============ IntAdjacencyMap.mergeVertices ============"-    test "mergeVertices (const False) x    == id" $ \x (y) ->-          mergeVertices (const False) x y  == y--    test "mergeVertices (== x) y           == replaceVertex x y" $ \x y (z) ->-          mergeVertices (== x) y z         == replaceVertex x y z--    test "mergeVertices even 1 (0 * 2)     == 1 * 1" $-          mergeVertices even 1 (0 * 2)     == 1 * 1--    test "mergeVertices odd  1 (3 + 4 * 5) == 4 * 1" $-          mergeVertices odd  1 (3 + 4 * 5) == 4 * 1--    putStrLn "\n============ IntAdjacencyMap.gmap ============"-    test "gmap f empty      == empty" $ \(apply -> f) ->-          gmap f empty      == empty--    test "gmap f (vertex x) == vertex (f x)" $ \(apply -> f) x ->-          gmap f (vertex x) == vertex (f x)--    test "gmap f (edge x y) == edge (f x) (f y)" $ \(apply -> f) x y ->-          gmap f (edge x y) == edge (f x) (f y)--    test "gmap id           == id" $ \x ->-          gmap id x         == x--    test "gmap f . gmap g   == gmap (f . g)" $ \(apply -> f) (apply -> g) x ->-         (gmap f . gmap g) x== gmap (f . g) x--    putStrLn "\n============ IntAdjacencyMap.induce ============"-    test "induce (const True)  x      == x" $ \x ->-          induce (const True)  x      == x--    test "induce (const False) x      == empty" $ \x ->-          induce (const False) x      == empty--    test "induce (/= x)               == removeVertex x" $ \x (y) ->-          induce (/= x) y             == removeVertex x y--    test "induce p . induce q         == induce (\\x -> p x && q x)" $ \(apply -> p) (apply -> q) (y) ->-         (induce p . induce q) y      == induce (\x -> p x && q x) y--    test "isSubgraphOf (induce p x) x == True" $ \(apply -> p) x ->-          isSubgraphOf (induce p x) x == True--    putStrLn "\n============ IntAdjacencyMap.dfsForest ============"-    test "forest (dfsForest $ edge 1 1)         == vertex 1" $-          forest (dfsForest $ edge 1 1)         == vertex 1--    test "forest (dfsForest $ edge 1 2)         == edge 1 2" $-          forest (dfsForest $ edge 1 2)         == edge 1 2--    test "forest (dfsForest $ edge 2 1)         == vertices [1, 2]" $-          forest (dfsForest $ edge 2 1)         == vertices [1, 2]--    test "isSubgraphOf (forest $ dfsForest x) x == True" $ \x ->-          isSubgraphOf (forest $ dfsForest x) x == True--    test "dfsForest . forest . dfsForest        == dfsForest" $ \x ->-         (dfsForest . forest . dfsForest) x     == dfsForest x--    test "dfsForest $ 3 * (1 + 4) * (1 + 5)     == <correct result>" $-          dfsForest  (3 * (1 + 4) * (1 + 5))    == [ Node { rootLabel = 1-                                                   , subForest = [ Node { rootLabel = 5-                                                                        , subForest = [] }]}-                                                   , Node { rootLabel = 3-                                                   , subForest = [ Node { rootLabel = 4-                                                                        , subForest = [] }]}]--    putStrLn "\n============ IntAdjacencyMap.topSort ============"-    test "topSort (1 * 2 + 3 * 1)             == Just [3,1,2]" $-          topSort (1 * 2 + 3 * 1)             == Just [3,1,2]--    test "topSort (1 * 2 + 2 * 1)             == Nothing" $-          topSort (1 * 2 + 2 * 1)             == Nothing--    test "fmap (flip isTopSort x) (topSort x) /= Just False" $ \x ->-          fmap (flip isTopSort x) (topSort x) /= Just False--    putStrLn "\n============ IntAdjacencyMap.isTopSort  ============"-    test "isTopSort [3, 1, 2] (1 * 2 + 3 * 1) == True" $-          isTopSort [3, 1, 2] (1 * 2 + 3 * 1) == True--    test "isTopSort [1, 2, 3] (1 * 2 + 3 * 1) == False" $-          isTopSort [1, 2, 3] (1 * 2 + 3 * 1) == False--    test "isTopSort []        (1 * 2 + 3 * 1) == False" $-          isTopSort []        (1 * 2 + 3 * 1) == False--    test "isTopSort []        empty           == True" $-          isTopSort []        empty    == True--    test "isTopSort [x]       (vertex x)      == True" $ \x ->-          isTopSort [x]       (vertex x)      == True--    test "isTopSort [x]       (edge x x)      == False" $ \x ->-          isTopSort [x]       (edge x x)      == False--    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)+    testShow              t+    testBasicPrimitives   t+    testFromAdjacencyList t+    testIsSubgraphOf      t+    testProperties        t+    testAdjacencyList     t+    testPostIntSet        t+    testGraphFamilies     t+    testTransformations   t+    testDfsForest         t+    testDfsForestFrom     t+    testDfs               t+    testTopSort           t+    testIsTopSort         t -    test "map (\\(x, y) -> (getVertex h x, getVertex h y)) (edges $ getGraph h) == edgeList g"-      $ \g -> let h = graphKL g in-        map (\(x, y) -> (getVertex h x, getVertex h y)) (KL.edges $ getGraph h) == edgeList g+    putStrLn "\n============ IntAdjacencyMap.Internal.GraphKL ============"+    test "map (fromVertexKL h) (vertices $ toGraphKL h) == IntSet.toAscList (vertexIntSet g)"+      $ \g -> let h = mkGraphKL (adjacencyMap g) in+        map (fromVertexKL h) (KL.vertices $ toGraphKL h) == IntSet.toAscList (vertexIntSet g) -    test "fromGraphKL . graphKL == id" $ \x ->-        (fromGraphKL . graphKL) x == x+    test "map (\\(x, y) -> (fromVertexKL h x, fromVertexKL h y)) (edges $ toGraphKL h) == edgeList g"+      $ \g -> let h = mkGraphKL (adjacencyMap g) in+        map (\(x, y) -> (fromVertexKL h x, fromVertexKL h y)) (KL.edges $ toGraphKL h) == edgeList g

@@ -1,4 +1,3 @@-{-# LANGUAGE ViewPatterns #-} ----------------------------------------------------------------------------- -- | -- Module     : Algebra.Graph.Test.Relation@@ -7,17 +6,13 @@ -- Maintainer : andrey.mokhov@gmail.com -- Stability  : experimental ----- Testsuite for 'Relation'.---+-- Testsuite for "Algebra.Graph.Relation". ----------------------------------------------------------------------------- module Algebra.Graph.Test.Relation (     -- * Testsuite     testRelation   ) where -import Data.Tree-import Data.Tuple- import Algebra.Graph.Relation import Algebra.Graph.Relation.Internal import Algebra.Graph.Relation.Preorder@@ -25,13 +20,15 @@ import Algebra.Graph.Relation.Symmetric import Algebra.Graph.Relation.Transitive import Algebra.Graph.Test+import Algebra.Graph.Test.Generic  import qualified Algebra.Graph.Class as C import qualified Data.Set            as Set +t :: Testsuite+t = testsuite "Relation." empty+ type RI = Relation Int-type II = Int -> Int-type IB = Int -> Bool  sizeLimit :: Testable prop => prop -> Property sizeLimit = mapSize (min 10)@@ -47,547 +44,16 @@     test "Consistency of fromAdjacencyList" $ \xs ->         consistent (fromAdjacencyList xs :: RI) -    putStrLn "\n============ Relation.Show ============"-    test "show (empty     :: Relation Int) == \"empty\"" $-          show (empty     :: Relation Int) == "empty"--    test "show (1         :: Relation Int) == \"vertex 1\"" $-          show (1         :: Relation Int) == "vertex 1"--    test "show (1 + 2     :: Relation Int) == \"vertices [1,2]\"" $-          show (1 + 2     :: Relation Int) == "vertices [1,2]"--    test "show (1 * 2     :: Relation Int) == \"edge 1 2\"" $-          show (1 * 2     :: Relation Int) == "edge 1 2"--    test "show (1 * 2 * 3 :: Relation Int) == \"edges [(1,2),(1,3),(2,3)]\"" $-          show (1 * 2 * 3 :: Relation Int) == "edges [(1,2),(1,3),(2,3)]"--    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============ Relation.empty ============"-    test "isEmpty     empty == True" $-          isEmpty    (empty :: RI) == True--    test "hasVertex x empty == False" $ \(x :: Int) ->-          hasVertex x empty == False--    test "vertexCount empty == 0" $-          vertexCount(empty :: RI) == 0--    test "edgeCount   empty == 0" $-          edgeCount  (empty :: RI) == 0--    putStrLn "\n============ Relation.vertex ============"-    test "isEmpty     (vertex x) == False" $ \(x :: Int) ->-          isEmpty     (vertex x) == False--    test "hasVertex x (vertex x) == True" $ \(x :: Int) ->-          hasVertex x (vertex x) == True--    test "hasVertex 1 (vertex 2) == False" $-          hasVertex 1 (vertex 2 :: RI) == False--    test "vertexCount (vertex x) == 1" $ \(x :: Int) ->-          vertexCount (vertex x) == 1--    test "edgeCount   (vertex x) == 0" $ \(x :: Int) ->-          edgeCount   (vertex x) == 0--    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)--    test "hasEdge x y (edge x y) == True" $ \(x :: Int) y ->-          hasEdge x y (edge x y) == True--    test "edgeCount   (edge x y) == 1" $ \(x :: Int) y ->-          edgeCount   (edge x y) == 1--    test "vertexCount (edge 1 1) == 1" $-          vertexCount (edge 1 1 :: RI) == 1--    test "vertexCount (edge 1 2) == 2" $-          vertexCount (edge 1 2 :: RI) == 2--    putStrLn "\n============ Relation.overlay ============"-    test "isEmpty     (overlay x y) == isEmpty   x   && isEmpty   y" $ \(x :: RI) y ->-          isEmpty     (overlay x y) == (isEmpty   x   && isEmpty   y)--    test "hasVertex z (overlay x y) == hasVertex z x || hasVertex z y" $ \(x :: RI) y z ->-          hasVertex z (overlay x y) == (hasVertex z x || hasVertex z y)--    test "vertexCount (overlay x y) >= vertexCount x" $ \(x :: RI) y ->-          vertexCount (overlay x y) >= vertexCount x--    test "vertexCount (overlay x y) <= vertexCount x + vertexCount y" $ \(x :: RI) y ->-          vertexCount (overlay x y) <= vertexCount x + vertexCount y--    test "edgeCount   (overlay x y) >= edgeCount x" $ \(x :: RI) y ->-          edgeCount   (overlay x y) >= edgeCount x--    test "edgeCount   (overlay x y) <= edgeCount x   + edgeCount y" $ \(x :: RI) y ->-          edgeCount   (overlay x y) <= edgeCount x   + edgeCount y--    test "vertexCount (overlay 1 2) == 2" $-          vertexCount (overlay 1 2 :: RI) == 2--    test "edgeCount   (overlay 1 2) == 0" $-          edgeCount   (overlay 1 2 :: RI) == 0--    putStrLn "\n============ Relation.connect ============"-    test "isEmpty     (connect x y) == isEmpty   x   && isEmpty   y" $ \(x :: RI) y ->-          isEmpty     (connect x y) == (isEmpty   x   && isEmpty   y)--    test "hasVertex z (connect x y) == hasVertex z x || hasVertex z y" $ \(x :: RI) y z ->-          hasVertex z (connect x y) == (hasVertex z x || hasVertex z y)--    test "vertexCount (connect x y) >= vertexCount x" $ \(x :: RI) y ->-          vertexCount (connect x y) >= vertexCount x--    test "vertexCount (connect x y) <= vertexCount x + vertexCount y" $ \(x :: RI) y ->-          vertexCount (connect x y) <= vertexCount x + vertexCount y--    test "edgeCount   (connect x y) >= edgeCount x" $ \(x :: RI) y ->-          edgeCount   (connect x y) >= edgeCount x--    test "edgeCount   (connect x y) >= edgeCount y" $ \(x :: RI) y ->-          edgeCount   (connect x y) >= edgeCount y--    test "edgeCount   (connect x y) >= vertexCount x * vertexCount y" $ \(x :: RI) y ->-          edgeCount   (connect x y) >= vertexCount x * vertexCount y--    test "edgeCount   (connect x y) <= vertexCount x * vertexCount y + edgeCount x + edgeCount y" $ \(x :: RI) y ->-          edgeCount   (connect x y) <= vertexCount x * vertexCount y + edgeCount x + edgeCount y--    test "vertexCount (connect 1 2) == 2" $-          vertexCount (connect 1 2 :: RI) == 2--    test "edgeCount   (connect 1 2) == 1" $-          edgeCount   (connect 1 2 :: RI) == 1--    putStrLn "\n============ Relation.vertices ============"-    test "vertices []            == empty" $-          vertices []            == (empty :: RI)--    test "vertices [x]           == vertex x" $ \(x :: Int) ->-          vertices [x]           == (vertex x :: RI)--    test "hasVertex x . vertices == elem x" $ \x (xs :: [Int]) ->-         (hasVertex x . vertices) xs == elem x xs--    test "vertexCount . vertices == length . nub" $ \(xs :: [Int]) ->-         (vertexCount . vertices) xs == (length . nubOrd) xs--    test "vertexSet   . vertices == Set.fromList" $ \(xs :: [Int]) ->-         (vertexSet   . vertices) xs == Set.fromList xs--    putStrLn "\n============ Relation.edges ============"-    test "edges []          == empty" $-          edges []          == (empty :: RI)--    test "edges [(x,y)]     == edge x y" $ \(x :: Int) y ->-          edges [(x,y)]     == (edge x y :: RI)--    test "edgeCount . edges == length . nub" $ \(xs :: [(Int, Int)]) ->-         (edgeCount . edges) xs == (length . nubOrd) xs--    putStrLn "\n============ Relation.overlays ============"-    test "overlays []        == empty" $-          overlays []        == (empty :: RI)--    test "overlays [x]       == x" $ \(x :: RI) ->-          overlays [x]       == x--    test "overlays [x,y]     == overlay x y" $ \(x :: RI) y ->-          overlays [x,y]     == overlay x y--    test "isEmpty . overlays == all isEmpty" $ mapSize (min 10) $ \(xs :: [RI]) ->-         (isEmpty . overlays) xs == all isEmpty xs--    putStrLn "\n============ Relation.connects ============"-    test "connects []        == empty" $-          connects []        == (empty :: RI)--    test "connects [x]       == x" $ \(x :: RI) ->-          connects [x]       == x--    test "connects [x,y]     == connect x y" $ \(x :: RI) y ->-          connects [x,y]     == connect x y--    test "isEmpty . connects == all isEmpty" $ mapSize (min 10) $ \(xs :: [RI]) ->-         (isEmpty . connects) xs == all isEmpty xs--    putStrLn "\n============ Relation.graph ============"-    test "graph []  []      == empty" $-          graph []  []      == (empty :: RI)--    test "graph [x] []      == vertex x" $ \(x :: Int) ->-          graph [x] []      == (vertex x :: RI)--    test "graph []  [(x,y)] == edge x y" $ \(x :: Int) y ->-          graph []  [(x,y)] == (edge x y :: RI)--    test "graph vs  es      == overlay (vertices vs) (edges es)" $ \(vs :: [Int]) es ->-          graph vs  es      == (overlay (vertices vs) (edges es) :: RI)--    putStrLn "\n============ Relation.fromAdjacencyList ============"-    test "fromAdjacencyList []                                  == empty" $-          fromAdjacencyList []                                  == (empty :: RI)--    test "fromAdjacencyList [(x, [])]                           == vertex x" $ \(x :: Int) ->-          fromAdjacencyList [(x, [])]                           == vertex x--    test "fromAdjacencyList [(x, [y])]                          == edge x y" $ \(x :: Int) y ->-          fromAdjacencyList [(x, [y])]                          == edge x y--    test "overlay (fromAdjacencyList xs) (fromAdjacencyList ys) == fromAdjacencyList (xs ++ ys)" $ \xs ys ->-          overlay (fromAdjacencyList xs) (fromAdjacencyList ys) ==(fromAdjacencyList (xs ++ ys) :: RI)--    putStrLn "\n============ Relation.isSubgraphOf ============"-    test "isSubgraphOf empty         x             == True" $ \(x :: RI) ->-          isSubgraphOf empty         x             == True--    test "isSubgraphOf (vertex x)    empty         == False" $ \x ->-          isSubgraphOf (vertex x)   (empty :: RI)   == False--    test "isSubgraphOf x             (overlay x y) == True" $ \(x :: RI) y ->-          isSubgraphOf x             (overlay x y) == True--    test "isSubgraphOf (overlay x y) (connect x y) == True" $ \(x :: RI) y ->-          isSubgraphOf (overlay x y) (connect x y) == True--    test "isSubgraphOf (path xs)     (circuit xs)  == True" $ \xs ->-          isSubgraphOf (path xs :: RI)(circuit xs)  == True--    putStrLn "\n============ Relation.isEmpty ============"-    test "isEmpty empty                       == True" $-          isEmpty (empty :: RI)                == True--    test "isEmpty (overlay empty empty)       == True" $-          isEmpty (overlay empty empty :: RI)  == True--    test "isEmpty (vertex x)                  == False" $ \(x :: Int) ->-          isEmpty (vertex x)                  == False--    test "isEmpty (removeVertex x $ vertex x) == True" $ \(x :: Int) ->-          isEmpty (removeVertex x $ vertex x) == True--    test "isEmpty (removeEdge x y $ edge x y) == False" $ \(x :: Int) y ->-          isEmpty (removeEdge x y $ edge x y) == False--    putStrLn "\n============ Relation.hasVertex ============"-    test "hasVertex x empty            == False" $ \(x :: Int) ->-          hasVertex x empty            == False--    test "hasVertex x (vertex x)       == True" $ \(x :: Int) ->-          hasVertex x (vertex x)       == True--    test "hasVertex x . removeVertex x == const False" $ \(x :: Int) y ->-          hasVertex x (removeVertex x y)==const False y--    putStrLn "\n============ Relation.hasEdge ============"-    test "hasEdge x y empty            == False" $ \(x :: Int) y ->-          hasEdge x y empty            == False--    test "hasEdge x y (vertex z)       == False" $ \(x :: Int) y z ->-          hasEdge x y (vertex z)       == False--    test "hasEdge x y (edge x y)       == True" $ \(x :: Int) y ->-          hasEdge x y (edge x y)       == True--    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============ Relation.vertexCount ============"-    test "vertexCount empty      == 0" $-          vertexCount (empty :: RI) == 0--    test "vertexCount (vertex x) == 1" $ \(x :: Int) ->-          vertexCount (vertex x) == 1--    test "vertexCount            == length . vertexList" $ \(x :: RI) ->-          vertexCount x          == (length . vertexList) x--    putStrLn "\n============ Relation.edgeCount ============"-    test "edgeCount empty      == 0" $-          edgeCount (empty :: RI) == 0--    test "edgeCount (vertex x) == 0" $ \(x :: Int) ->-          edgeCount (vertex x) == 0--    test "edgeCount (edge x y) == 1" $ \(x :: Int) y ->-          edgeCount (edge x y) == 1--    test "edgeCount            == length . edgeList" $ \(x :: RI) ->-          edgeCount x          == (length . edgeList) x--    putStrLn "\n============ Relation.vertexList ============"-    test "vertexList empty      == []" $-          vertexList (empty :: RI) == []--    test "vertexList (vertex x) == [x]" $ \(x :: Int) ->-          vertexList (vertex x) == [x]--    test "vertexList . vertices == nub . sort" $ \(xs :: [Int]) ->-         (vertexList . vertices) xs == (nubOrd . sort) xs--    putStrLn "\n============ Relation.edgeList ============"-    test "edgeList empty          == []" $-          edgeList (empty :: RI )  == []--    test "edgeList (vertex x)     == []" $ \(x :: Int) ->-          edgeList (vertex x)     == []--    test "edgeList (edge x y)     == [(x,y)]" $ \(x :: Int) y ->-          edgeList (edge x y)     == [(x,y)]--    test "edgeList (star 2 [3,1]) == [(2,1), (2,3)]" $-          edgeList (star 2 [3,1]) == [(2,1), (2,3 :: Int)]--    test "edgeList . edges        == nub . sort" $ \(xs :: [(Int, Int)]) ->-         (edgeList . edges) xs    == (nubOrd . sort) xs--    putStrLn "\n============ Relation.vertexSet ============"-    test "vertexSet empty      == Set.empty" $-          vertexSet(empty :: RI)== Set.empty--    test "vertexSet . vertex   == Set.singleton" $ \(x :: Int) ->-         (vertexSet . vertex) x== Set.singleton x--    test "vertexSet . vertices == Set.fromList" $ \(xs :: [Int]) ->-         (vertexSet . vertices) xs == Set.fromList xs--    test "vertexSet . clique   == Set.fromList" $ \(xs :: [Int]) ->-         (vertexSet . clique) xs == Set.fromList xs--    putStrLn "\n============ Relation.edgeSet ============"-    test "edgeSet empty      == Set.empty" $-          edgeSet (empty :: RI) == Set.empty--    test "edgeSet (vertex x) == Set.empty" $ \(x :: Int) ->-          edgeSet (vertex x) == Set.empty--    test "edgeSet (edge x y) == Set.singleton (x,y)" $ \(x :: Int) y ->-          edgeSet (edge x y) == Set.singleton (x,y)--    test "edgeSet . edges    == Set.fromList" $ \(xs :: [(Int, Int)]) ->-         (edgeSet . edges) xs== Set.fromList xs--    putStrLn "\n============ Relation.preset ============"-    test "preset x empty      == Set.empty" $ \(x :: Int) ->-          preset x empty      == Set.empty--    test "preset x (vertex x) == Set.empty" $ \(x :: Int) ->-          preset x (vertex x) == Set.empty--    test "preset 1 (edge 1 2) == Set.empty" $-          preset 1 (edge 1 2) ==(Set.empty :: Set.Set Int)--    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============ Relation.postset ============"-    test "postset x empty      == Set.empty" $ \(x :: Int) ->-          postset x empty      == Set.empty--    test "postset x (vertex x) == Set.empty" $ \(x :: Int) ->-          postset x (vertex x) == Set.empty--    test "postset x (edge x y) == Set.fromList [y]" $ \(x :: Int) y ->-          postset x (edge x y) == Set.fromList [y]--    test "postset 2 (edge 1 2) == Set.empty" $-          postset 2 (edge 1 2) ==(Set.empty :: Set.Set Int)--    putStrLn "\n============ Relation.path ============"-    test "path []    == empty" $-          path []    == (empty :: RI)--    test "path [x]   == vertex x" $ \(x :: Int) ->-          path [x]   == (vertex x :: RI)--    test "path [x,y] == edge x y" $ \(x :: Int) y ->-          path [x,y] == (edge x y :: RI)--    putStrLn "\n============ Relation.circuit ============"-    test "circuit []    == empty" $-          circuit []    == (empty :: RI)--    test "circuit [x]   == edge x x" $ \(x :: Int) ->-          circuit [x]   == (edge x x :: RI)--    test "circuit [x,y] == edges [(x,y), (y,x)]" $ \(x :: Int) y ->-          circuit [x,y] == (edges [(x,y), (y,x)] :: RI)--    putStrLn "\n============ Relation.clique ============"-    test "clique []      == empty" $-          clique []      == (empty :: RI)--    test "clique [x]     == vertex x" $ \(x :: Int) ->-          clique [x]     == (vertex x :: RI)--    test "clique [x,y]   == edge x y" $ \(x :: Int) y ->-          clique [x,y]   == (edge x y :: RI)--    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============ Relation.biclique ============"-    test "biclique []      []      == empty" $-          biclique []      []      == (empty :: RI)--    test "biclique [x]     []      == vertex x" $ \(x :: Int) ->-          biclique [x]     []      == (vertex x :: RI)--    test "biclique []      [y]     == vertex y" $ \(y :: Int) ->-          biclique []      [y]     == (vertex y :: RI)--    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)--    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)--    test "star x [y]   == edge x y" $ \(x :: Int) y ->-          star x [y]   == (edge x y :: RI)--    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============ 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============ 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)--    test "removeEdge x y . removeEdge x y == removeEdge x y" $ \(x :: Int) y z ->-         (removeEdge x y . removeEdge x y)z==(removeEdge x y z :: RI)--    test "removeEdge x y . removeVertex x == removeVertex x" $ \(x :: Int) y z ->-         (removeEdge x y . removeVertex x)z==(removeVertex x z :: RI)--    test "removeEdge 1 1 (1 * 1 * 2 * 2)  == 1 * 2 * 2" $-          removeEdge 1 1 (1 * 1 * 2 * 2)  == (1 * 2 * (2 :: RI))--    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============ Relation.replaceVertex ============"-    test "replaceVertex x x            == id" $ \x (y :: RI) ->-          replaceVertex x x y          == y--    test "replaceVertex x y (vertex x) == vertex y" $ \x (y :: Int) ->-          replaceVertex x y (vertex x) == (vertex y :: RI)--    test "replaceVertex x y            == mergeVertices (== x) y" $ \x y z ->-          replaceVertex x y z          == (mergeVertices (== x) y z :: RI)--    putStrLn "\n============ Relation.mergeVertices ============"-    test "mergeVertices (const False) x    == id" $ \x (y :: RI) ->-          mergeVertices (const False) x y  == y--    test "mergeVertices (== x) y           == replaceVertex x y" $ \x y (z :: RI) ->-          mergeVertices (== x) y z         == (replaceVertex x y z :: RI)--    test "mergeVertices even 1 (0 * 2)     == 1 * 1" $-          mergeVertices even 1 (0 * 2)     == (1 * 1 :: RI)--    test "mergeVertices odd  1 (3 + 4 * 5) == 4 * 1" $-          mergeVertices odd  1 (3 + 4 * 5) == (4 * 1 :: RI)--    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--    test "gmap f (vertex x) == vertex (f x)" $ \(apply -> f :: II) x ->-          gmap f (vertex x) == vertex (f x)--    test "gmap f (edge x y) == edge (f x) (f y)" $ \(apply -> f :: II) x y ->-          gmap f (edge x y) == edge (f x) (f y)--    test "gmap id           == id" $ \x ->-          gmap id x         == (x :: RI)--    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============ Relation.induce ============"-    test "induce (const True)  x      == x" $ \(x :: RI) ->-          induce (const True)  x      == x--    test "induce (const False) x      == empty" $ \(x :: RI) ->-          induce (const False) x      == (empty :: RI)--    test "induce (/= x)               == removeVertex x" $ \x (y :: RI) ->-          induce (/= x) y             == (removeVertex x y :: RI)--    test "induce p . induce q         == induce (\\x -> p x && q x)" $ \(apply -> p :: IB) (apply -> q :: IB) (y :: RI) ->-         (induce p . induce q) y      == (induce (\x -> p x && q x) y :: RI)--    test "isSubgraphOf (induce p x) x == True" $ \(apply -> p :: IB) (x :: RI) ->-          isSubgraphOf (induce p x) x == True+    testShow              t+    testBasicPrimitives   t+    testFromAdjacencyList t+    testIsSubgraphOf      t+    testProperties        t+    testAdjacencyList     t+    testPreSet            t+    testPostSet           t+    testGraphFamilies     t+    testTransformations   t      putStrLn "\n============ Relation.compose ============"     test "compose empty            x                == empty" $ \(x :: RI) ->

@@ -1,4 +1,5 @@ import Algebra.Graph.Test.AdjacencyMap+import Algebra.Graph.Test.Export import Algebra.Graph.Test.Fold import Algebra.Graph.Test.Graph import Algebra.Graph.Test.IntAdjacencyMap@@ -7,6 +8,7 @@ main :: IO () main = do     testAdjacencyMap+    testExport     testFold     testGraph     testIntAdjacencyMap