{-# LANGUAGE CPP, OverloadedLists, ViewPatterns #-} ----------------------------------------------------------------------------- -- | -- Module : Algebra.Graph.Test.NonEmpty.AdjacencyMap -- Copyright : (c) Andrey Mokhov 2016-2018 -- License : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability : experimental -- -- Testsuite for "Algebra.Graph.NonEmpty.AdjacencyMap". ----------------------------------------------------------------------------- module Algebra.Graph.Test.NonEmpty.AdjacencyMap ( -- * Testsuite testNonEmptyAdjacencyMap ) where import Prelude () import Prelude.Compat #if !MIN_VERSION_base(4,11,0) import Data.Semigroup #endif import Control.Monad import Data.Tree import Data.Tuple import Algebra.Graph.NonEmpty.AdjacencyMap import Algebra.Graph.Test hiding (axioms, theorems) import Algebra.Graph.ToGraph (toAdjacencyMap, reachable) import qualified Algebra.Graph.AdjacencyMap as AM import qualified Algebra.Graph.NonEmpty.AdjacencyMap as NonEmpty import qualified Data.List.NonEmpty as NonEmpty import qualified Data.Set as Set sizeLimit :: Testable prop => prop -> Property sizeLimit = mapSize (min 10) type G = NonEmpty.AdjacencyMap Int axioms :: G -> G -> G -> Property axioms x y z = conjoin [ x + y == y + x // "Overlay commutativity" , x + (y + z) == (x + y) + z // "Overlay associativity" , x * (y * z) == (x * y) * z // "Connect associativity" , x * (y + z) == x * y + x * z // "Left distributivity" , (x + y) * z == x * z + y * z // "Right distributivity" , x * y * z == x * y + x * z + y * z // "Decomposition" ] theorems :: G -> G -> Property theorems x y = conjoin [ x + x == x // "Overlay idempotence" , x + y + x * y == x * y // "Absorption" , x * x == x * x * x // "Connect saturation" , x <= x + y // "Overlay order" , x + y <= x * y // "Overlay-connect order" ] testNonEmptyAdjacencyMap :: IO () testNonEmptyAdjacencyMap = do putStrLn "\n============ NonEmpty.AdjacencyMap ============" test "Axioms of non-empty graphs" axioms test "Theorems of non-empty graphs" theorems putStrLn $ "\n============ Ord (NonEmpty.AdjacencyMap a) ============" test "vertex 1 < vertex 2" $ vertex 1 < vertex (2 :: Int) test "vertex 3 < edge 1 2" $ vertex 3 < edge 1 (2 :: Int) test "vertex 1 < edge 1 1" $ vertex 1 < edge 1 (1 :: Int) test "edge 1 1 < edge 1 2" $ edge 1 1 < edge 1 (2 :: Int) test "edge 1 2 < edge 1 1 + edge 2 2" $ edge 1 2 < edge 1 1 + edge 2 (2 :: Int) test "edge 1 2 < edge 1 3" $ edge 1 2 < edge 1 (3 :: Int) test "x <= x + y" $ \(x :: G) y -> x <= x + y test "x + y <= x * y" $ \(x :: G) y -> x + y <= x * y putStrLn $ "\n============ Show (NonEmpty.AdjacencyMap a) ============" test "show (1 :: AdjacencyMap Int) == \"vertex 1\"" $ show (1 :: AdjacencyMap Int) == "vertex 1" test "show (1 + 2 :: AdjacencyMap Int) == \"vertices1 [1,2]\"" $ show (1 + 2 :: AdjacencyMap Int) == "vertices1 [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) == \"edges1 [(1,2),(1,3),(2,3)]\"" $ show (1 * 2 * 3 :: AdjacencyMap Int) == "edges1 [(1,2),(1,3),(2,3)]" test "show (1 * 2 + 3 :: AdjacencyMap Int) == \"overlay (vertex 3) (edge 1 2)\"" $ show (1 * 2 + 3 :: AdjacencyMap Int) == "overlay (vertex 3) (edge 1 2)" test "show (vertex (-1) :: AdjacencyMap Int) == \"vertex (-1)\"" $ show (vertex (-1) :: AdjacencyMap Int) == "vertex (-1)" test "show (vertex (-1) + vertex (-2) :: AdjacencyMap Int) == \"vertices1 [-2,-1]\"" $ show (vertex (-1) + vertex (-2) :: AdjacencyMap Int) == "vertices1 [-2,-1]" test "show (vertex (-1) * vertex (-2) :: AdjacencyMap Int) == \"edge (-1) (-2)\"" $ show (vertex (-1) * vertex (-2) :: AdjacencyMap Int) == "edge (-1) (-2)" test "show (vertex (-1) * vertex (-2) * vertex (-3) :: AdjacencyMap Int) == \"edges1 [(-2,-3),(-1,-3),(-1,-2)]\"" $ show (vertex (-1) * vertex (-2) * vertex (-3) :: AdjacencyMap Int) == "edges1 [(-2,-3),(-1,-3),(-1,-2)]" test "show (vertex (-1) * vertex (-2) + vertex (-3) :: AdjacencyMap Int) == \"overlay (vertex (-3)) (edge (-1) (-2))\"" $ show (vertex (-1) * vertex (-2) + vertex (-3) :: AdjacencyMap Int) == "overlay (vertex (-3)) (edge (-1) (-2))" putStrLn $ "\n============ NonEmpty.AdjacencyMap.toNonEmpty ============" test "toNonEmpty empty == Nothing" $ toNonEmpty (AM.empty :: AM.AdjacencyMap Int) == Nothing test "toNonEmpty (toAdjacencyMap x) == Just (x :: NonEmpty.AdjacencyMap a)" $ \x -> toNonEmpty (toAdjacencyMap x) == Just (x :: G) putStrLn $ "\n============ NonEmpty.AdjacencyMap.vertex ============" test "hasVertex x (vertex x) == True" $ \(x :: Int) -> hasVertex x (vertex x) == True test "vertexCount (vertex x) == 1" $ \(x :: Int) -> vertexCount (vertex x) == 1 test "edgeCount (vertex x) == 0" $ \(x :: Int) -> edgeCount (vertex x) == 0 putStrLn $ "\n============ NonEmpty.AdjacencyMap.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============ NonEmpty.AdjacencyMap.overlay ============" 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 "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============ NonEmpty.AdjacencyMap.connect ============" 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 "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============ NonEmpty.AdjacencyMap.vertices1 ============" test "vertices1 [x] == vertex x" $ \(x :: Int) -> vertices1 [x] == vertex x test "hasVertex x . vertices1 == elem x" $ \(x :: Int) (xs' :: NonEmptyList Int) -> let xs = NonEmpty.fromList (getNonEmpty xs') in (hasVertex x . vertices1) xs == elem x (NonEmpty.toList xs) test "vertexCount . vertices1 == length . nub" $ \(xs' :: NonEmptyList Int) -> let xs = NonEmpty.fromList (getNonEmpty xs') in (vertexCount . vertices1) xs == (NonEmpty.length . NonEmpty.nub) xs test "vertexSet . vertices1 == Set.fromList . toList" $ \(xs' :: NonEmptyList Int) -> let xs = NonEmpty.fromList (getNonEmpty xs') in (vertexSet . vertices1) xs == (Set.fromList . NonEmpty.toList) xs putStrLn $ "\n============ NonEmpty.AdjacencyMap.edges1 ============" test "edges1 [(x,y)] == edge x y" $ \(x :: Int) y -> edges1 [(x,y)] == edge x y test "edgeCount . edges1 == length . nub" $ \(xs' :: NonEmptyList (Int, Int)) -> let xs = NonEmpty.fromList (getNonEmpty xs') in (edgeCount . edges1) xs == (NonEmpty.length . NonEmpty.nub) xs putStrLn $ "\n============ NonEmpty.AdjacencyMap.overlays1 ============" test "overlays1 [x] == x" $ \(x :: G) -> overlays1 [x] == x test "overlays1 [x,y] == overlay x y" $ \(x :: G) y -> overlays1 [x,y] == overlay x y putStrLn $ "\n============ NonEmpty.AdjacencyMap.connects1 ============" test "connects1 [x] == x" $ \(x :: G) -> connects1 [x] == x test "connects1 [x,y] == connect x y" $ \(x :: G) y -> connects1 [x,y] == connect x y putStrLn $ "\n============ NonEmpty.AdjacencyMap.isSubgraphOf ============" 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 (path1 xs) (circuit1 xs) == True" $ \(xs' :: NonEmptyList Int) -> let xs = NonEmpty.fromList (getNonEmpty xs') in isSubgraphOf (path1 xs) (circuit1 xs) == True test "isSubgraphOf x y ==> x <= y" $ \(x :: G) z -> let y = x + z -- Make sure we hit the precondition in isSubgraphOf x y ==> x <= y putStrLn $ "\n============ NonEmpty.AdjacencyMap.hasVertex ============" 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 putStrLn $ "\n============ NonEmpty.AdjacencyMap.hasEdge ============" 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 == False test "hasEdge x y == elem (x,y) . edgeList" $ \(x :: Int) y z -> do (u, v) <- elements ((x, y) : edgeList z) return $ hasEdge u v z == elem (u, v) (edgeList z) putStrLn $ "\n============ NonEmpty.AdjacencyMap.vertexCount ============" test "vertexCount (vertex x) == 1" $ \(x :: Int) -> vertexCount (vertex x) == 1 test "vertexCount x >= 1" $ \(x :: G) -> vertexCount x >= 1 test "vertexCount == length . vertexList1" $ \(x :: G) -> vertexCount x == (NonEmpty.length . vertexList1) x putStrLn $ "\n============ NonEmpty.AdjacencyMap.edgeCount ============" 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============ NonEmpty.AdjacencyMap.vertexList1 ============" test "vertexList1 (vertex x) == [x]" $ \(x :: Int) -> vertexList1 (vertex x) == [x] test "vertexList1 . vertices1 == nub . sort" $ \(xs' :: NonEmptyList Int) -> let xs = NonEmpty.fromList (getNonEmpty xs') in (vertexList1 . vertices1) xs == (NonEmpty.nub . NonEmpty.sort) xs putStrLn $ "\n============ NonEmpty.AdjacencyMap.edgeList ============" 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 . edges1 == nub . sort . toList" $ \(xs' :: NonEmptyList (Int, Int)) -> let xs = NonEmpty.fromList (getNonEmpty xs') in (edgeList . edges1) xs == (nubOrd . sort . NonEmpty.toList) xs test "edgeList . transpose == sort . map swap . edgeList" $ \(x :: G) -> (edgeList . transpose) x == (sort . map swap . edgeList) x putStrLn $ "\n============ NonEmpty.AdjacencyMap.vertexSet ============" test "vertexSet . vertex == Set.singleton" $ \(x :: Int) -> (vertexSet . vertex) x == Set.singleton x test "vertexSet . vertices1 == Set.fromList . toList" $ \(xs' :: NonEmptyList Int) -> let xs = NonEmpty.fromList (getNonEmpty xs') in (vertexSet . vertices1) xs == (Set.fromList . NonEmpty.toList) xs test "vertexSet . clique1 == Set.fromList . toList" $ \(xs' :: NonEmptyList Int) -> let xs = NonEmpty.fromList (getNonEmpty xs') in (vertexSet . clique1) xs == (Set.fromList . NonEmpty.toList) xs putStrLn $ "\n============ NonEmpty.AdjacencyMap.edgeSet ============" 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 . edges1 == Set.fromList . toList" $ \(xs' :: NonEmptyList (Int, Int)) -> let xs = NonEmpty.fromList (getNonEmpty xs') in (edgeSet . edges1) xs == (Set.fromList . NonEmpty.toList) xs putStrLn $ "\n============ NonEmpty.AdjacencyMap.preSet ============" test "preSet x (vertex x) == Set.empty" $ \(x :: G) -> preSet x (vertex x) == Set.empty test "preSet 1 (edge 1 2) == Set.empty" $ preSet 1 (edge 1 2 :: G) == Set.empty test "preSet y (edge x y) == Set.fromList [x]" $ \(x :: G) y -> preSet y (edge x y) == Set.fromList [x] putStrLn $ "\n============ NonEmpty.AdjacencyMap.postSet ============" test "postSet x (vertex x) == Set.empty" $ \(x :: G) -> postSet x (vertex x) == Set.empty test "postSet x (edge x y) == Set.fromList [y]" $ \(x :: G) y -> postSet x (edge x y) == Set.fromList [y] test "postSet 2 (edge 1 2) == Set.empty" $ postSet 2 (edge 1 2 :: G) == Set.empty putStrLn $ "\n============ NonEmpty.AdjacencyMap.path1 ============" test "path1 [x] == vertex x" $ \(x :: Int) -> path1 [x] == vertex x test "path1 [x,y] == edge x y" $ \(x :: Int) y -> path1 [x,y] == edge x y test "path1 . reverse == transpose . path1" $ \(xs' :: NonEmptyList Int) -> let xs = NonEmpty.fromList (getNonEmpty xs') in (path1 . NonEmpty.reverse) xs == (transpose . path1) xs putStrLn $ "\n============ NonEmpty.AdjacencyMap.circuit1 ============" test "circuit1 [x] == edge x x" $ \(x :: Int) -> circuit1 [x] == edge x x test "circuit1 [x,y] == edges1 [(x,y), (y,x)]" $ \(x :: Int) y -> circuit1 [x,y] == edges1 [(x,y), (y,x)] test "circuit1 . reverse == transpose . circuit1" $ \(xs' :: NonEmptyList Int) -> let xs = NonEmpty.fromList (getNonEmpty xs') in (circuit1 . NonEmpty.reverse) xs == (transpose . circuit1) xs putStrLn $ "\n============ NonEmpty.AdjacencyMap.clique1 ============" test "clique1 [x] == vertex x" $ \(x :: Int) -> clique1 [x] == vertex x test "clique1 [x,y] == edge x y" $ \(x :: Int) y -> clique1 [x,y] == edge x y test "clique1 [x,y,z] == edges1 [(x,y), (x,z), (y,z)]" $ \(x :: Int) y z -> clique1 [x,y,z] == edges1 [(x,y), (x,z), (y,z)] test "clique1 (xs <> ys) == connect (clique1 xs) (clique1 ys)" $ \(xs' :: NonEmptyList Int) ys' -> let xs = NonEmpty.fromList (getNonEmpty xs') ys = NonEmpty.fromList (getNonEmpty ys') in clique1 (xs <> ys) == connect (clique1 xs) (clique1 ys) test "clique1 . reverse == transpose . clique1" $ \(xs' :: NonEmptyList Int) -> let xs = NonEmpty.fromList (getNonEmpty xs') in (clique1 . NonEmpty.reverse) xs == (transpose . clique1) xs putStrLn $ "\n============ NonEmpty.AdjacencyMap.biclique1 ============" test "biclique1 [x1,x2] [y1,y2] == edges1 [(x1,y1), (x1,y2), (x2,y1), (x2,y2)]" $ \(x1 :: Int) x2 y1 y2 -> biclique1 [x1,x2] [y1,y2] == edges1 [(x1,y1), (x1,y2), (x2,y1), (x2,y2)] test "biclique1 xs ys == connect (vertices1 xs) (vertices1 ys)" $ \(xs' :: NonEmptyList Int) ys' -> let xs = NonEmpty.fromList (getNonEmpty xs') ys = NonEmpty.fromList (getNonEmpty ys') in biclique1 xs ys == connect (vertices1 xs) (vertices1 ys) putStrLn $ "\n============ NonEmpty.AdjacencyMap.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] == edges1 [(x,y), (x,z)]" $ \(x :: Int) y z -> star x [y,z] == edges1 [(x,y), (x,z)] putStrLn $ "\n============ NonEmpty.AdjacencyMap.stars1 ============" test "stars1 [(x, [] )] == vertex x" $ \(x :: Int) -> stars1 [(x, [] )] == vertex x test "stars1 [(x, [y])] == edge x y" $ \(x :: Int) y -> stars1 [(x, [y])] == edge x y test "stars1 [(x, ys )] == star x ys" $ \(x :: Int) ys -> stars1 [(x, ys )] == star x ys test "stars1 == overlays1 . fmap (uncurry star)" $ \(xs' :: NonEmptyList (Int, [Int])) -> let xs = NonEmpty.fromList (getNonEmpty xs') in stars1 xs == overlays1 (fmap (uncurry star) xs) test "overlay (stars1 xs) (stars1 ys) == stars1 (xs <> ys)" $ \(xs' :: NonEmptyList (Int, [Int])) (ys' :: NonEmptyList (Int, [Int])) -> let xs = NonEmpty.fromList (getNonEmpty xs') ys = NonEmpty.fromList (getNonEmpty ys') in overlay (stars1 xs) (stars1 ys) == stars1 (xs <> ys) putStrLn $ "\n============ NonEmpty.AdjacencyMap.tree ============" test "tree (Node x []) == vertex x" $ \(x :: Int) -> tree (Node x []) == vertex x test "tree (Node x [Node y [Node z []]]) == path1 [x,y,z]" $ \(x :: Int) y z -> tree (Node x [Node y [Node z []]]) == path1 [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 []]]) == edges1 [(1,2), (1,3), (3,4), (3,5)]" $ tree (Node 1 [Node 2 [], Node 3 [Node 4 [], Node 5 []]]) == edges1 [(1,2), (1,3), (3,4), (3,5::Int)] putStrLn $ "\n============ NonEmpty.AdjacencyMap.removeVertex1 ============" test "removeVertex1 x (vertex x) == Nothing" $ \(x :: Int) -> removeVertex1 x (vertex x) == Nothing test "removeVertex1 1 (vertex 2) == Just (vertex 2)" $ removeVertex1 1 (vertex 2) == Just (vertex 2 :: G) test "removeVertex1 x (edge x x) == Nothing" $ \(x :: Int) -> removeVertex1 x (edge x x) == Nothing test "removeVertex1 1 (edge 1 2) == Just (vertex 2)" $ removeVertex1 1 (edge 1 2) == Just (vertex 2 :: G) test "removeVertex1 x >=> removeVertex1 x == removeVertex1 x" $ \(x :: Int) y -> (removeVertex1 x >=> removeVertex1 x) y == removeVertex1 x y putStrLn $ "\n============ NonEmpty.AdjacencyMap.removeEdge ============" test "removeEdge x y (edge x y) == vertices1 [x,y]" $ \(x :: Int) y -> removeEdge x y (edge x y) == vertices1 [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 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============ NonEmpty.AdjacencyMap.replaceVertex ============" test "replaceVertex x x == id" $ \(x :: Int) y -> replaceVertex x x y == y test "replaceVertex x y (vertex x) == vertex y" $ \(x :: Int) y -> replaceVertex x y (vertex x) == vertex y test "replaceVertex x y == mergeVertices (== x) y" $ \(x :: Int) y z -> replaceVertex x y z == mergeVertices (== x) y z putStrLn $ "\n============ NonEmpty.AdjacencyMap.mergeVertices ============" test "mergeVertices (const False) x == id" $ \(x :: Int) y -> mergeVertices (const False) x y == y test "mergeVertices (== x) y == replaceVertex x y" $ \(x :: Int) 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 :: G) test "mergeVertices odd 1 (3 + 4 * 5) == 4 * 1" $ mergeVertices odd 1 (3 + 4 * 5) == (4 * 1 :: G) putStrLn $ "\n============ NonEmpty.AdjacencyMap.transpose ============" 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 "edgeList . transpose == sort . map swap . edgeList" $ \(x :: G) -> (edgeList . transpose) x == (sort . map swap . edgeList) x putStrLn $ "\n============ NonEmpty.AdjacencyMap.gmap ============" test "gmap f (vertex x) == vertex (f x)" $ \(apply -> f) (x :: Int) -> gmap f (vertex x) == vertex (f x :: Int) test "gmap f (edge x y) == edge (f x) (f y)" $ \(apply -> f) (x :: Int) y -> gmap f (edge x y) == edge (f x) (f y :: Int) test "gmap id == id" $ \(x :: G) -> gmap id x == x test "gmap f . gmap g == gmap (f . g)" $ \(apply -> f) (apply -> g) (x :: G) -> (gmap f . gmap g) x == (gmap (f . (g :: Int -> Int)) x :: G) putStrLn $ "\n============ NonEmpty.AdjacencyMap.induce1 ============" test "induce1 (const True ) x == Just x" $ \(x :: G) -> induce1 (const True ) x == Just x test "induce1 (const False) x == Nothing" $ \(x :: G) -> induce1 (const False) x == Nothing test "induce1 (/= x) == removeVertex1 x" $ \(x :: Int) y -> induce1 (/= x) y == removeVertex1 x y test "induce1 p >=> induce1 q == induce1 (\\x -> p x && q x)" $ \(apply -> p) (apply -> q) (y :: G) -> (induce1 p >=> induce1 q) y == induce1 (\x -> p x && q x) y putStrLn $ "\n============ NonEmpty.AdjacencyMap.closure ============" test "closure (vertex x) == edge x x" $ \(x :: Int) -> closure (vertex x) == edge x x test "closure (edge x x) == edge x x" $ \(x :: Int) -> closure (edge x x) == edge x x test "closure (edge x y) == edges1 [(x,x), (x,y), (y,y)]" $ \(x :: Int) y -> closure (edge x y) == edges1 [(x,x), (x,y), (y,y)] test "closure (path1 $ nub xs) == reflexiveClosure (clique1 $ nub xs)" $ \(xs :: NonEmptyList Int) -> let ys = NonEmpty.fromList (nubOrd $ getNonEmpty xs) in closure (path1 $ ys) == reflexiveClosure (clique1 $ ys) test "closure == reflexiveClosure . transitiveClosure" $ sizeLimit $ \(x :: G) -> closure x == (reflexiveClosure . transitiveClosure) x test "closure == transitiveClosure . reflexiveClosure" $ sizeLimit $ \(x :: G) -> closure x == (transitiveClosure . reflexiveClosure) x test "closure . closure == closure" $ sizeLimit $ \(x :: G) -> (closure . closure) x == closure x test "postSet x (closure y) == Set.fromList (reachable x y)" $ sizeLimit $ \x (y :: G) -> postSet x (closure y) == Set.fromList (reachable x y) putStrLn $ "\n============ NonEmpty.AdjacencyMap.reflexiveClosure ============" test "reflexiveClosure (vertex x) == edge x x" $ \(x :: Int) -> reflexiveClosure (vertex x) == edge x x test "reflexiveClosure (edge x x) == edge x x" $ \(x :: Int) -> reflexiveClosure (edge x x) == edge x x test "reflexiveClosure (edge x y) == edges1 [(x,x), (x,y), (y,y)]" $ \(x :: Int) y -> reflexiveClosure (edge x y) == edges1 [(x,x), (x,y), (y,y)] test "reflexiveClosure . reflexiveClosure == reflexiveClosure" $ \(x :: G) -> (reflexiveClosure . reflexiveClosure) x == reflexiveClosure x putStrLn $ "\n============ NonEmpty.AdjacencyMap.symmetricClosure ============" test "symmetricClosure (vertex x) == vertex x" $ \(x :: Int) -> symmetricClosure (vertex x) == vertex x test "symmetricClosure (edge x y) == edges1 [(x,y), (y,x)]" $ \(x :: G) y -> symmetricClosure (edge x y) == edges1 [(x,y), (y,x)] test "symmetricClosure x == overlay x (transpose x)" $ \(x :: G) -> symmetricClosure x == overlay x (transpose x) test "symmetricClosure . symmetricClosure == symmetricClosure" $ \(x :: G) -> (symmetricClosure . symmetricClosure) x == symmetricClosure x putStrLn $ "\n============ NonEmpty.AdjacencyMap.transitiveClosure ============" test "transitiveClosure (vertex x) == vertex x" $ \(x :: Int) -> transitiveClosure (vertex x) == vertex x test "transitiveClosure (edge x y) == edge x y" $ \(x :: G) y -> transitiveClosure (edge x y) == edge x y test "transitiveClosure (path1 $ nub xs) == clique1 (nub $ xs)" $ \(xs :: NonEmptyList Int) -> let ys = NonEmpty.fromList (nubOrd $ getNonEmpty xs) in transitiveClosure (path1 ys) == clique1 ys test "transitiveClosure . transitiveClosure == transitiveClosure" $ sizeLimit $ \(x :: G) -> (transitiveClosure . transitiveClosure) x == transitiveClosure x