algebraic-graphs-0.0.2: test/Algebra/Graph/Test/Fold.hs
{-# LANGUAGE ViewPatterns #-}
-----------------------------------------------------------------------------
-- |
-- Module : Algebra.Graph.Test.Fold
-- Copyright : (c) Andrey Mokhov 2016-2017
-- License : MIT (see the file LICENSE)
-- Maintainer : andrey.mokhov@gmail.com
-- Stability : experimental
--
-- Testsuite for 'Fold' and polymorphic functions defined in
-- "Algebra.Graph.Class".
--
-----------------------------------------------------------------------------
module Algebra.Graph.Test.Fold (
-- * Testsuite
testFold
) where
import Data.Foldable
import Algebra.Graph.Fold
import Algebra.Graph.Test
import qualified Data.Set as Set
import qualified Data.IntSet as IntSet
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============ 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============ 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============ 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============ 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============ 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============ 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============ 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============ 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============ 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============ 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============ 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============ 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============ 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============ 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============ 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============ 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============ 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============ 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============ 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============ 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============ 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============ 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============ 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============ 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============ 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============ 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============ 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============ biclique ============"
test "biclique [] [] == empty" $
biclique [] [] == (empty :: F)
test "biclique [x] [] == vertex x" $ \(x :: Int) ->
biclique [x] [] == (vertex x :: F)
test "biclique [] [y] == vertex y" $ \(y :: Int) ->
biclique [] [y] == (vertex y :: F)
test "biclique [x1,x2] [y1,y2] == edges [(x1,y1), (x1,y2), (x2,y1), (x2,y2)]" $ \(x1 :: Int) x2 y1 y2 ->
biclique [x1,x2] [y1,y2] == (edges [(x1,y1), (x1,y2), (x2,y1), (x2,y2)] :: F)
putStrLn "\n============ 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============ mesh ============"
test "mesh xs [] == empty" $ \xs ->
mesh xs [] == (empty :: Fold (Int, Int))
test "mesh [] ys == empty" $ \ys ->
mesh [] ys == (empty :: Fold (Int, Int))
test "mesh [x] [y] == vertex (x, y)" $ \(x :: Int) (y :: Int) ->
mesh [x] [y] == (vertex (x, y) :: Fold (Int, Int))
test "mesh xs ys == box (path xs) (path ys)" $ \(xs :: [Int]) (ys :: [Int]) ->
mesh xs ys == (box (path xs) (path ys) :: Fold (Int, Int))
test ("mesh [1..3] \"ab\" == <correct result>") $
(mesh [1..3] "ab" :: Fold (Int, Char)) == edges [ ((1,'a'),(1,'b')), ((1,'a'),(2,'a')), ((1,'b'),(2,'b')), ((2,'a'),(2,'b'))
, ((2,'a'),(3,'a')), ((2,'b'),(3,'b')), ((3,'a'),(3,'b')) ]
putStrLn "\n============ torus ============"
test "torus xs [] == empty" $ \xs ->
torus xs [] == (empty :: Fold (Int, Int))
test "torus [] ys == empty" $ \ys ->
torus [] ys == (empty :: Fold (Int, Int))
test "torus [x] [y] == edge (x, y) (x, y)" $ \(x :: Int) (y :: Int) ->
torus [x] [y] == (edge (x, y) (x, y) :: Fold (Int, Int))
test "torus xs ys == box (circuit xs) (circuit ys)" $ \(xs :: [Int]) (ys :: [Int]) ->
torus xs ys == (box (circuit xs) (circuit ys) :: Fold (Int, Int))
test ("torus [1,2] \"ab\" == <correct result>") $
(torus [1,2] "ab" :: Fold (Int, Char)) == edges [ ((1,'a'),(1,'b')), ((1,'a'),(2,'a')), ((1,'b'),(1,'a')), ((1,'b'),(2,'b'))
, ((2,'a'),(1,'a')), ((2,'a'),(2,'b')), ((2,'b'),(1,'b')), ((2,'b'),(2,'a')) ]
putStrLn "\n============ deBruijn ============"
test "deBruijn k [] == empty" $ \k ->
deBruijn k [] == (empty :: Fold [Int])
test "deBruijn 1 [0,1] == edges [ ([0],[0]), ([0],[1]), ([1],[0]), ([1],[1]) ]" $
deBruijn 1 [0,1] == (edges [ ([0],[0]), ([0],[1]), ([1],[0]), ([1],[1]) ] :: Fold [Int])
test "deBruijn 2 \"0\" == edge \"00\" \"00\"" $
deBruijn 2 "0" == (edge "00" "00" :: Fold String)
test ("deBruijn 2 \"01\" == <correct result>") $
(deBruijn 2 "01" :: Fold String) == edges [ ("00","00"), ("00","01"), ("01","10"), ("01","11")
, ("10","00"), ("10","01"), ("11","10"), ("11","11") ]
putStrLn "\n============ removeVertex ============"
test "removeVertex x (vertex x) == empty" $ \(x :: Int) ->
removeVertex x (vertex x) == (empty :: F)
test "removeVertex x . removeVertex x == removeVertex x" $ \x (y :: F) ->
(removeVertex x . removeVertex x)y==(removeVertex x y :: F)
putStrLn "\n============ removeEdge ============"
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============ 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============ 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============ 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============ 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
putStrLn "\n============ 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============ 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============ 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============ simplify ============"
test "simplify == id" $ \(x :: F) ->
simplify x == x
test "size (simplify x) <= size x" $ \(x :: F) ->
size (simplify x) <= size x
putStrLn "\n============ box ============"
let unit = fmap $ \(a, ()) -> a
comm = fmap $ \(a, b) -> (b, a)
test "box x y ~~ box y x" $ mapSize (min 10) $ \(x :: F) (y :: F) ->
comm (box x y) == (box y x :: Fold (Int, Int))
test "box x (overlay y z) == overlay (box x y) (box x z)" $ mapSize (min 10) $ \(x :: F) (y :: F) z ->
box x (overlay y z) == (overlay (box x y) (box x z) :: Fold (Int, Int))
test "box x (vertex ()) ~~ x" $ mapSize (min 10) $ \(x :: F) ->
unit(box x (vertex ())) == x
test "box x empty ~~ empty" $ mapSize (min 10) $ \(x :: F) ->
unit(box x empty) == empty
let assoc = fmap $ \(a, (b, c)) -> ((a, b), c)
test "box x (box y z) ~~ box (box x y) z" $ mapSize (min 10) $ \(x :: F) (y :: F) (z :: F) ->
assoc (box x (box y z)) == (box (box x y) z :: Fold ((Int, Int), Int))