algebraic-graphs-0.7: test/Algebra/Graph/Test/Generic.hs
{-# LANGUAGE RecordWildCards, ViewPatterns #-}
-----------------------------------------------------------------------------
-- |
-- Module : Algebra.Graph.Test.Generic
-- Copyright : (c) Andrey Mokhov 2016-2022
-- License : MIT (see the file LICENSE)
-- Maintainer : andrey.mokhov@gmail.com
-- Stability : experimental
--
-- Generic graph API testing.
-----------------------------------------------------------------------------
module Algebra.Graph.Test.Generic where
import Control.Monad (when)
import Data.Either
import Data.List (nub, sort)
import Data.List.NonEmpty (NonEmpty (..))
import Data.Tree
import Data.Tuple
import qualified Data.List as List
import Algebra.Graph.Test
import Algebra.Graph.Test.API
import qualified Algebra.Graph as G
import qualified Algebra.Graph.AdjacencyMap as AM
import qualified Algebra.Graph.AdjacencyMap.Algorithm as AM
import qualified Algebra.Graph.AdjacencyIntMap as AIM
import qualified Data.Set as Set
import qualified Data.IntSet as IntSet
type ModulePrefix = String
type Testsuite g c = (ModulePrefix, API g c)
type TestsuiteInt g = (ModulePrefix, API g ((~) Int))
testBasicPrimitives :: TestsuiteInt g -> IO ()
testBasicPrimitives = mconcat [ testOrd
, testEmpty
, testVertex
, testEdge
, testOverlay
, testConnect
, testVertices
, testEdges
, testOverlays
, testConnects ]
testSymmetricBasicPrimitives :: TestsuiteInt g -> IO ()
testSymmetricBasicPrimitives = mconcat [ testSymmetricOrd
, testEmpty
, testVertex
, testSymmetricEdge
, testOverlay
, testSymmetricConnect
, testVertices
, testSymmetricEdges
, testOverlays
, testSymmetricConnects ]
testToGraph :: TestsuiteInt g -> IO ()
testToGraph = mconcat [ testToGraphDefault
, testFoldg
, testIsEmpty
, testHasVertex
, testHasEdge
, testVertexCount
, testEdgeCount
, testVertexList
, testVertexSet
, testVertexIntSet
, testEdgeList
, testEdgeSet
, testAdjacencyList
, testPreSet
, testPreIntSet
, testPostSet
, testPostIntSet ]
testSymmetricToGraph :: TestsuiteInt g -> IO ()
testSymmetricToGraph = mconcat [ testSymmetricToGraphDefault
, testIsEmpty
, testHasVertex
, testSymmetricHasEdge
, testVertexCount
, testEdgeCount
, testVertexList
, testVertexSet
, testVertexIntSet
, testSymmetricEdgeList
, testSymmetricEdgeSet
, testSymmetricAdjacencyList
, testNeighbours ]
testRelational :: TestsuiteInt g -> IO ()
testRelational = mconcat [ testCompose
, testClosure
, testReflexiveClosure
, testSymmetricClosure
, testTransitiveClosure ]
testGraphFamilies :: TestsuiteInt g -> IO ()
testGraphFamilies = mconcat [ testPath
, testCircuit
, testClique
, testBiclique
, testStar
, testStars
, testTree
, testForest ]
testSymmetricGraphFamilies :: TestsuiteInt g -> IO ()
testSymmetricGraphFamilies = mconcat [ testSymmetricPath
, testSymmetricCircuit
, testSymmetricClique
, testBiclique
, testStar
, testStars
, testTree
, testForest ]
testTransformations :: TestsuiteInt g -> IO ()
testTransformations = mconcat [ testRemoveVertex
, testRemoveEdge
, testReplaceVertex
, testMergeVertices
, testTranspose
, testGmap
, testInduce ]
testSymmetricTransformations :: TestsuiteInt g -> IO ()
testSymmetricTransformations = mconcat [ testRemoveVertex
, testSymmetricRemoveEdge
, testReplaceVertex
, testMergeVertices
, testGmap
, testInduce ]
testConsistent :: TestsuiteInt g -> IO ()
testConsistent (prefix, API{..}) = do
putStrLn $ "\n============ " ++ prefix ++ "consistent ============"
test "Consistency of the Arbitrary instance" $ \x -> consistent x
putStrLn ""
test "consistent empty == True" $
consistent empty == True
test "consistent (vertex x) == True" $ \x ->
consistent (vertex x) == True
test "consistent (overlay x y) == True" $ \x y ->
consistent (overlay x y) == True
test "consistent (connect x y) == True" $ \x y ->
consistent (connect x y) == True
test "consistent (edge x y) == True" $ \x y ->
consistent (edge x y) == True
test "consistent (edges xs) == True" $ \xs ->
consistent (edges xs) == True
test "consistent (stars xs) == True" $ \xs ->
consistent (stars xs) == True
testShow :: TestsuiteInt g -> IO ()
testShow (prefix, API{..}) = do
putStrLn $ "\n============ " ++ prefix ++ "Show ============"
test "show (empty ) == \"empty\"" $
show (empty ) == "empty"
test "show (1 ) == \"vertex 1\"" $
show (1 `asTypeOf` empty) == "vertex 1"
test "show (1 + 2 ) == \"vertices [1,2]\"" $
show (1 + 2 `asTypeOf` empty) == "vertices [1,2]"
test "show (1 * 2 ) == \"edge 1 2\"" $
show (1 * 2 `asTypeOf` empty) == "edge 1 2"
test "show (1 * 2 * 3) == \"edges [(1,2),(1,3),(2,3)]\"" $
show (1 * 2 * 3 `asTypeOf` empty) == "edges [(1,2),(1,3),(2,3)]"
test "show (1 * 2 + 3) == \"overlay (vertex 3) (edge 1 2)\"" $
show (1 * 2 + 3 `asTypeOf` empty) == "overlay (vertex 3) (edge 1 2)"
putStrLn ""
test "show (vertex (-1) ) == \"vertex (-1)\"" $
show (vertex (-1) ) == "vertex (-1)"
test "show (vertex (-1) + vertex (-2) ) == \"vertices [-2,-1]\"" $
show (vertex (-1) + vertex (-2) ) == "vertices [-2,-1]"
test "show (vertex (-2) * vertex (-1) ) == \"edge (-2) (-1)\"" $
show (vertex (-2) * vertex (-1) ) == "edge (-2) (-1)"
test "show (vertex (-3) * vertex (-2) * vertex (-1)) == \"edges [(-3,-2),(-3,-1),(-2,-1)]\"" $
show (vertex (-3) * vertex (-2) * vertex (-1)) == "edges [(-3,-2),(-3,-1),(-2,-1)]"
test "show (vertex (-3) * vertex (-2) + vertex (-1)) == \"overlay (vertex (-1)) (edge (-3) (-2))\"" $
show (vertex (-3) * vertex (-2) + vertex (-1)) == "overlay (vertex (-1)) (edge (-3) (-2))"
testSymmetricShow :: TestsuiteInt g -> IO ()
testSymmetricShow t@(_, API{..}) = do
testShow t
putStrLn ""
test "show (2 * 1 ) == \"edge 1 2\"" $
show (2 * 1 `asTypeOf` empty) == "edge 1 2"
test "show (1 * 2 * 1) == \"edges [(1,1),(1,2)]\"" $
show (1 * 2 * 1 `asTypeOf` empty) == "edges [(1,1),(1,2)]"
test "show (3 * 2 * 1) == \"edges [(1,2),(1,3),(2,3)]\"" $
show (3 * 2 * 1 `asTypeOf` empty) == "edges [(1,2),(1,3),(2,3)]"
testOrd :: TestsuiteInt g -> IO ()
testOrd (prefix, API{..}) = do
putStrLn $ "\n============ " ++ prefix ++ "Ord ============"
test "vertex 1 < vertex 2" $
vertex 1 < vertex 2
test "vertex 3 < edge 1 2" $
vertex 3 < edge 1 2
test "vertex 1 < edge 1 1" $
vertex 1 < edge 1 1
test "edge 1 1 < edge 1 2" $
edge 1 1 < edge 1 2
test "edge 1 2 < edge 1 1 + edge 2 2" $
edge 1 2 < edge 1 1 + edge 2 2
test "edge 1 2 < edge 1 3" $
edge 1 2 < edge 1 3
test "x <= x + y" $ \x y ->
x <= x + (y `asTypeOf` empty)
test "x + y <= x * y" $ \x y ->
x + y <= x * (y `asTypeOf` empty)
testSymmetricOrd :: TestsuiteInt g -> IO ()
testSymmetricOrd (prefix, API{..}) = do
putStrLn $ "\n============ " ++ prefix ++ "Ord ============"
test "vertex 1 < vertex 2" $
vertex 1 < vertex 2
test "vertex 3 < edge 1 2" $
vertex 3 < edge 1 2
test "vertex 1 < edge 1 1" $
vertex 1 < edge 1 1
test "edge 1 1 < edge 1 2" $
edge 1 1 < edge 1 2
test "edge 1 2 < edge 1 1 + edge 2 2" $
edge 1 2 < edge 1 1 + edge 2 2
test "edge 2 1 < edge 1 3" $
edge 2 1 < edge 1 3
test "edge 1 2 == edge 2 1" $
edge 1 2 == edge 2 1
test "x <= x + y" $ \x y ->
x <= x + (y `asTypeOf` empty)
test "x + y <= x * y" $ \x y ->
x + y <= x * (y `asTypeOf` empty)
testEmpty :: TestsuiteInt g -> IO ()
testEmpty (prefix, API{..}) = 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 :: TestsuiteInt g -> IO ()
testVertex (prefix, API{..}) = do
putStrLn $ "\n============ " ++ prefix ++ "vertex ============"
test "isEmpty (vertex x) == False" $ \x ->
isEmpty (vertex x) == False
test "hasVertex x (vertex y) == (x == y)" $ \x y ->
hasVertex x (vertex y) == (x == y)
test "vertexCount (vertex x) == 1" $ \x ->
vertexCount (vertex x) == 1
test "edgeCount (vertex x) == 0" $ \x ->
edgeCount (vertex x) == 0
testEdge :: TestsuiteInt g -> IO ()
testEdge (prefix, API{..}) = 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
testSymmetricEdge :: TestsuiteInt g -> IO ()
testSymmetricEdge (prefix, API{..}) = 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 "edge x y == edge y x" $ \x y ->
edge x y == edge y x
test "edge x y == edges [(x,y), (y,x)]" $ \x y ->
edge x y == edges [(x,y), (y,x)]
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 :: TestsuiteInt g -> IO ()
testOverlay (prefix, API{..}) = 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 :: TestsuiteInt g -> IO ()
testConnect (prefix, API{..}) = 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
testSymmetricConnect :: TestsuiteInt g -> IO ()
testSymmetricConnect (prefix, API{..}) = do
putStrLn $ "\n============ " ++ prefix ++ "connect ============"
test "connect x y == connect y x" $ \x y ->
connect x y == connect y x
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 `div` 2" $ \x y ->
edgeCount (connect x y) >= vertexCount x * vertexCount y `div` 2
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 :: TestsuiteInt g -> IO ()
testVertices (prefix, API{..}) = do
putStrLn $ "\n============ " ++ prefix ++ "vertices ============"
test "vertices [] == empty" $
vertices [] == empty
test "vertices [x] == vertex x" $ \x ->
vertices [x] == vertex x
test "vertices == overlays . map vertex" $ \xs ->
vertices xs ==(overlays . map vertex) xs
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 :: TestsuiteInt g -> IO ()
testEdges (prefix, API{..}) = do
putStrLn $ "\n============ " ++ prefix ++ "edges ============"
test "edges [] == empty" $
edges [] == empty
test "edges [(x,y)] == edge x y" $ \x y ->
edges [(x,y)] == edge x y
test "edges == overlays . map (uncurry edge)" $ \xs ->
edges xs == (overlays . map (uncurry edge)) xs
test "edgeCount . edges == length . nub" $ \xs ->
(edgeCount . edges) xs == (length . nubOrd) xs
testSymmetricEdges :: TestsuiteInt g -> IO ()
testSymmetricEdges (prefix, API{..}) = do
putStrLn $ "\n============ " ++ prefix ++ "edges ============"
test "edges [] == empty" $
edges [] == empty
test "edges [(x,y)] == edge x y" $ \x y ->
edges [(x,y)] == edge x y
test "edges [(x,y), (y,x)] == edge x y" $ \x y ->
edges [(x,y), (y,x)] == edge x y
testOverlays :: TestsuiteInt g -> IO ()
testOverlays (prefix, API{..}) = do
putStrLn $ "\n============ " ++ prefix ++ "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 "overlays == foldr overlay empty" $ size10 $ \xs ->
overlays xs == foldr overlay empty xs
test "isEmpty . overlays == all isEmpty" $ size10 $ \xs ->
(isEmpty . overlays) xs == all isEmpty xs
testConnects :: TestsuiteInt g -> IO ()
testConnects (prefix, API{..}) = do
putStrLn $ "\n============ " ++ prefix ++ "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 "connects == foldr connect empty" $ size10 $ \xs ->
connects xs == foldr connect empty xs
test "isEmpty . connects == all isEmpty" $ size10 $ \xs ->
(isEmpty . connects) xs == all isEmpty xs
testSymmetricConnects :: TestsuiteInt g -> IO ()
testSymmetricConnects t@(_, API{..}) = do
testConnects t
test "connects == connects . reverse" $ size10 $ \xs ->
connects xs == connects (reverse xs)
testStars :: TestsuiteInt g -> IO ()
testStars (prefix, API{..}) = do
putStrLn $ "\n============ " ++ prefix ++ "stars ============"
test "stars [] == empty" $
stars [] == empty
test "stars [(x, [])] == vertex x" $ \x ->
stars [(x, [])] == vertex x
test "stars [(x, [y])] == edge x y" $ \x y ->
stars [(x, [y])] == edge x y
test "stars [(x, ys)] == star x ys" $ \x ys ->
stars [(x, ys)] == star x ys
test "stars == overlays . map (uncurry star)" $ \xs ->
stars xs == overlays (map (uncurry star) xs)
test "stars . adjacencyList == id" $ \x ->
(stars . adjacencyList) x == id x
test "overlay (stars xs) (stars ys) == stars (xs ++ ys)" $ \xs ys ->
overlay (stars xs) (stars ys) == stars (xs ++ ys)
testFromAdjacencySets :: TestsuiteInt g -> IO ()
testFromAdjacencySets (prefix, API{..}) = do
putStrLn $ "\n============ " ++ prefix ++ "fromAdjacencySets ============"
test "fromAdjacencySets [] == empty" $
fromAdjacencySets [] == empty
test "fromAdjacencySets [(x, Set.empty)] == vertex x" $ \x ->
fromAdjacencySets [(x, Set.empty)] == vertex x
test "fromAdjacencySets [(x, Set.singleton y)] == edge x y" $ \x y ->
fromAdjacencySets [(x, Set.singleton y)] == edge x y
test "fromAdjacencySets . map (fmap Set.fromList) == stars" $ \x ->
(fromAdjacencySets . map (fmap Set.fromList)) x == stars x
test "overlay (fromAdjacencySets xs) (fromAdjacencySets ys) == fromAdjacencySets (xs ++ ys)" $ \xs ys ->
overlay (fromAdjacencySets xs) (fromAdjacencySets ys) == fromAdjacencySets (xs ++ ys)
testFromAdjacencyIntSets :: TestsuiteInt g -> IO ()
testFromAdjacencyIntSets (prefix, API{..}) = do
putStrLn $ "\n============ " ++ prefix ++ "fromAdjacencyIntSets ============"
test "fromAdjacencyIntSets [] == empty" $
fromAdjacencyIntSets [] == empty
test "fromAdjacencyIntSets [(x, IntSet.empty)] == vertex x" $ \x ->
fromAdjacencyIntSets [(x, IntSet.empty)] == vertex x
test "fromAdjacencyIntSets [(x, IntSet.singleton y)] == edge x y" $ \x y ->
fromAdjacencyIntSets [(x, IntSet.singleton y)] == edge x y
test "fromAdjacencyIntSets . map (fmap IntSet.fromList) == stars" $ \x ->
(fromAdjacencyIntSets . map (fmap IntSet.fromList)) x == stars x
test "overlay (fromAdjacencyIntSets xs) (fromAdjacencyIntSets ys) == fromAdjacencyIntSets (xs ++ ys)" $ \xs ys ->
overlay (fromAdjacencyIntSets xs) (fromAdjacencyIntSets ys) == fromAdjacencyIntSets (xs ++ ys)
testIsSubgraphOf :: TestsuiteInt g -> IO ()
testIsSubgraphOf (prefix, API{..}) = 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
test "isSubgraphOf x y ==> x <= y" $ \x z ->
let y = x + z -- Make sure we hit the precondition
in isSubgraphOf x y ==> x <= y
testSymmetricIsSubgraphOf :: TestsuiteInt g -> IO ()
testSymmetricIsSubgraphOf t@(_, API{..}) = do
testIsSubgraphOf t
test "isSubgraphOf (edge x y) (edge y x) == True" $ \x y ->
isSubgraphOf (edge x y) (edge y x) == True
testToGraphDefault :: TestsuiteInt g -> IO ()
testToGraphDefault (prefix, API{..}) = do
putStrLn $ "\n============ " ++ prefix ++ "toGraph et al. ============"
test "toGraph == foldg Empty Vertex Overlay Connect" $ \x ->
toGraph x == foldg G.Empty G.Vertex G.Overlay G.Connect x
test "foldg == Algebra.Graph.foldg . toGraph" $ \e (apply -> v) (applyFun2 -> o) (applyFun2 -> c) x ->
foldg e v o c x == (G.foldg (e :: Int) v o c . toGraph) x
test "isEmpty == foldg True (const False) (&&) (&&)" $ \x ->
isEmpty x == foldg True (const False) (&&) (&&) x
test "size == foldg 1 (const 1) (+) (+)" $ \x ->
size x == foldg 1 (const 1) (+) (+) x
test "hasVertex x == foldg False (==x) (||) (||)" $ \x y ->
hasVertex x y == foldg False (==x) (||) (||) y
test "hasEdge x y == Algebra.Graph.hasEdge x y . toGraph" $ \x y z ->
hasEdge x y z == (G.hasEdge x y . toGraph) z
test "vertexCount == Set.size . vertexSet" $ \x ->
vertexCount x == (Set.size . vertexSet) x
test "edgeCount == Set.size . edgeSet" $ \x ->
edgeCount x == (Set.size . edgeSet) x
test "vertexList == Set.toAscList . vertexSet" $ \x ->
vertexList x == (Set.toAscList . vertexSet) x
test "edgeList == Set.toAscList . edgeSet" $ \x ->
edgeList x == (Set.toAscList . edgeSet) x
test "vertexSet == foldg Set.empty Set.singleton Set.union Set.union" $ \x ->
vertexSet x == foldg Set.empty Set.singleton Set.union Set.union x
test "vertexIntSet == foldg IntSet.empty IntSet.singleton IntSet.union IntSet.union" $ \x ->
vertexIntSet x == foldg IntSet.empty IntSet.singleton IntSet.union IntSet.union x
test "edgeSet == Algebra.Graph.AdjacencyMap.edgeSet . foldg empty vertex overlay connect" $ \x ->
edgeSet x == (AM.edgeSet . foldg AM.empty AM.vertex AM.overlay AM.connect) x
test "preSet x == Algebra.Graph.AdjacencyMap.preSet x . toAdjacencyMap" $ \x y ->
preSet x y == (AM.preSet x . toAdjacencyMap) y
test "preIntSet x == Algebra.Graph.AdjacencyIntMap.preIntSet x . toAdjacencyIntMap" $ \x y ->
preIntSet x y == (AIM.preIntSet x . toAdjacencyIntMap) y
test "postSet x == Algebra.Graph.AdjacencyMap.postSet x . toAdjacencyMap" $ \x y ->
postSet x y == (AM.postSet x . toAdjacencyMap) y
test "postIntSet x == Algebra.Graph.AdjacencyIntMap.postIntSet x . toAdjacencyIntMap" $ \x y ->
postIntSet x y == (AIM.postIntSet x . toAdjacencyIntMap) y
test "adjacencyList == Algebra.Graph.AdjacencyMap.adjacencyList . toAdjacencyMap" $ \x ->
adjacencyList x == (AM.adjacencyList . toAdjacencyMap) x
test "adjacencyMap == Algebra.Graph.AdjacencyMap.adjacencyMap . toAdjacencyMap" $ \x ->
adjacencyMap x == (AM.adjacencyMap . toAdjacencyMap) x
test "adjacencyIntMap == Algebra.Graph.AdjacencyIntMap.adjacencyIntMap . toAdjacencyIntMap" $ \x ->
adjacencyIntMap x == (AIM.adjacencyIntMap . toAdjacencyIntMap) x
test "adjacencyMapTranspose == Algebra.Graph.AdjacencyMap.adjacencyMap . toAdjacencyMapTranspose" $ \x ->
adjacencyMapTranspose x == (AM.adjacencyMap . toAdjacencyMapTranspose) x
test "adjacencyIntMapTranspose == Algebra.Graph.AdjacencyIntMap.adjacencyIntMap . toAdjacencyIntMapTranspose" $ \x ->
adjacencyIntMapTranspose x == (AIM.adjacencyIntMap . toAdjacencyIntMapTranspose) x
test "dfsForest == Algebra.Graph.AdjacencyMap.dfsForest . toAdjacencyMap" $ \x ->
dfsForest x == (AM.dfsForest . toAdjacencyMap) x
test "dfsForestFrom == Algebra.Graph.AdjacencyMap.dfsForestFrom . toAdjacencyMap" $ \x vs ->
dfsForestFrom x vs == (AM.dfsForestFrom . toAdjacencyMap) x vs
test "dfs == Algebra.Graph.AdjacencyMap.dfs . toAdjacencyMap" $ \x vs ->
dfs x vs == (AM.dfs . toAdjacencyMap) x vs
test "reachable == Algebra.Graph.AdjacencyMap.reachable . toAdjacencyMap" $ \x y ->
reachable x y == (AM.reachable . toAdjacencyMap) x y
test "topSort == Algebra.Graph.AdjacencyMap.topSort . toAdjacencyMap" $ \x ->
topSort x == (AM.topSort . toAdjacencyMap) x
test "isAcyclic == Algebra.Graph.AdjacencyMap.isAcyclic . toAdjacencyMap" $ \x ->
isAcyclic x == (AM.isAcyclic . toAdjacencyMap) x
test "isTopSortOf vs == Algebra.Graph.AdjacencyMap.isTopSortOf vs . toAdjacencyMap" $ \vs x ->
isTopSortOf vs x == (AM.isTopSortOf vs . toAdjacencyMap) x
test "toAdjacencyMap == foldg empty vertex overlay connect" $ \x ->
toAdjacencyMap x == foldg AM.empty AM.vertex AM.overlay AM.connect x
test "toAdjacencyMapTranspose == foldg empty vertex overlay (flip connect)" $ \x ->
toAdjacencyMapTranspose x == foldg AM.empty AM.vertex AM.overlay (flip AM.connect) x
test "toAdjacencyIntMap == foldg empty vertex overlay connect" $ \x ->
toAdjacencyIntMap x == foldg AIM.empty AIM.vertex AIM.overlay AIM.connect x
test "toAdjacencyIntMapTranspose == foldg empty vertex overlay (flip connect)" $ \x ->
toAdjacencyIntMapTranspose x == foldg AIM.empty AIM.vertex AIM.overlay (flip AIM.connect) x
test "isDfsForestOf f == Algebra.Graph.AdjacencyMap.isDfsForestOf f . toAdjacencyMap" $ \f x ->
isDfsForestOf f x == (AM.isDfsForestOf f . toAdjacencyMap) x
test "isTopSortOf vs == Algebra.Graph.AdjacencyMap.isTopSortOf vs . toAdjacencyMap" $ \vs x ->
isTopSortOf vs x == (AM.isTopSortOf vs . toAdjacencyMap) x
-- TODO: We currently do not test 'edgeSet'.
testSymmetricToGraphDefault :: TestsuiteInt g -> IO ()
testSymmetricToGraphDefault (prefix, API{..}) = do
putStrLn $ "\n============ " ++ prefix ++ "toGraph et al. ============"
test "toGraph == foldg Empty Vertex Overlay Connect" $ \x ->
toGraph x == foldg G.Empty G.Vertex G.Overlay G.Connect x
test "foldg == Algebra.Graph.foldg . toGraph" $ \e (apply -> v) (applyFun2 -> o) (applyFun2 -> c) x ->
foldg e v o c x == (G.foldg (e :: Int) v o c . toGraph) x
test "isEmpty == foldg True (const False) (&&) (&&)" $ \x ->
isEmpty x == foldg True (const False) (&&) (&&) x
test "size == foldg 1 (const 1) (+) (+)" $ \x ->
size x == foldg 1 (const 1) (+) (+) x
test "hasVertex x == foldg False (==x) (||) (||)" $ \x y ->
hasVertex x y == foldg False (==x) (||) (||) y
test "hasEdge x y == Algebra.Graph.hasEdge x y . toGraph" $ \x y z ->
hasEdge x y z == (G.hasEdge x y . toGraph) z
test "vertexCount == Set.size . vertexSet" $ \x ->
vertexCount x == (Set.size . vertexSet) x
test "edgeCount == Set.size . edgeSet" $ \x ->
edgeCount x == (Set.size . edgeSet) x
test "vertexList == Set.toAscList . vertexSet" $ \x ->
vertexList x == (Set.toAscList . vertexSet) x
test "edgeList == Set.toAscList . edgeSet" $ \x ->
edgeList x == (Set.toAscList . edgeSet) x
test "vertexSet == foldg Set.empty Set.singleton Set.union Set.union" $ \x ->
vertexSet x == foldg Set.empty Set.singleton Set.union Set.union x
test "vertexIntSet == foldg IntSet.empty IntSet.singleton IntSet.union IntSet.union" $ \x ->
vertexIntSet x == foldg IntSet.empty IntSet.singleton IntSet.union IntSet.union x
test "adjacencyList == Algebra.Graph.AdjacencyMap.adjacencyList . toAdjacencyMap" $ \x ->
adjacencyList x == (AM.adjacencyList . toAdjacencyMap) x
test "adjacencyMap == Algebra.Graph.AdjacencyMap.adjacencyMap . toAdjacencyMap" $ \x ->
adjacencyMap x == (AM.adjacencyMap . toAdjacencyMap) x
test "adjacencyIntMap == Algebra.Graph.AdjacencyIntMap.adjacencyIntMap . toAdjacencyIntMap" $ \x ->
adjacencyIntMap x == (AIM.adjacencyIntMap . toAdjacencyIntMap) x
test "adjacencyMapTranspose == Algebra.Graph.AdjacencyMap.adjacencyMap . toAdjacencyMapTranspose" $ \x ->
adjacencyMapTranspose x == (AM.adjacencyMap . toAdjacencyMapTranspose) x
test "adjacencyIntMapTranspose == Algebra.Graph.AdjacencyIntMap.adjacencyIntMap . toAdjacencyIntMapTranspose" $ \x ->
adjacencyIntMapTranspose x == (AIM.adjacencyIntMap . toAdjacencyIntMapTranspose) x
test "dfsForest == Algebra.Graph.AdjacencyMap.dfsForest . toAdjacencyMap" $ \x ->
dfsForest x == (AM.dfsForest . toAdjacencyMap) x
test "dfsForestFrom == Algebra.Graph.AdjacencyMap.dfsForestFrom . toAdjacencyMap" $ \x vs ->
dfsForestFrom x vs == (AM.dfsForestFrom . toAdjacencyMap) x vs
test "dfs == Algebra.Graph.AdjacencyMap.dfs . toAdjacencyMap" $ \x vs ->
dfs x vs == (AM.dfs . toAdjacencyMap) x vs
test "reachable == Algebra.Graph.AdjacencyMap.reachable . toAdjacencyMap" $ \x y ->
reachable x y == (AM.reachable . toAdjacencyMap) x y
test "topSort == Algebra.Graph.AdjacencyMap.topSort . toAdjacencyMap" $ \x ->
topSort x == (AM.topSort . toAdjacencyMap) x
test "isAcyclic == Algebra.Graph.AdjacencyMap.isAcyclic . toAdjacencyMap" $ \x ->
isAcyclic x == (AM.isAcyclic . toAdjacencyMap) x
test "isTopSortOf vs == Algebra.Graph.AdjacencyMap.isTopSortOf vs . toAdjacencyMap" $ \vs x ->
isTopSortOf vs x == (AM.isTopSortOf vs . toAdjacencyMap) x
test "toAdjacencyMap == foldg empty vertex overlay connect" $ \x ->
toAdjacencyMap x == foldg AM.empty AM.vertex AM.overlay AM.connect x
test "toAdjacencyMapTranspose == foldg empty vertex overlay (flip connect)" $ \x ->
toAdjacencyMapTranspose x == foldg AM.empty AM.vertex AM.overlay (flip AM.connect) x
test "toAdjacencyIntMap == foldg empty vertex overlay connect" $ \x ->
toAdjacencyIntMap x == foldg AIM.empty AIM.vertex AIM.overlay AIM.connect x
test "toAdjacencyIntMapTranspose == foldg empty vertex overlay (flip connect)" $ \x ->
toAdjacencyIntMapTranspose x == foldg AIM.empty AIM.vertex AIM.overlay (flip AIM.connect) x
test "isDfsForestOf f == Algebra.Graph.AdjacencyMap.isDfsForestOf f . toAdjacencyMap" $ \f x ->
isDfsForestOf f x == (AM.isDfsForestOf f . toAdjacencyMap) x
test "isTopSortOf vs == Algebra.Graph.AdjacencyMap.isTopSortOf vs . toAdjacencyMap" $ \vs x ->
isTopSortOf vs x == (AM.isTopSortOf vs . toAdjacencyMap) x
testFoldg :: TestsuiteInt g -> IO ()
testFoldg (prefix, API{..}) = 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 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
testIsEmpty :: TestsuiteInt g -> IO ()
testIsEmpty (prefix, API{..}) = 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 :: TestsuiteInt g -> IO ()
testSize (prefix, API{..}) = 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 :: TestsuiteInt g -> IO ()
testHasVertex (prefix, API{..}) = do
putStrLn $ "\n============ " ++ prefix ++ "hasVertex ============"
test "hasVertex x empty == False" $ \x ->
hasVertex x empty == False
test "hasVertex x (vertex y) == (x == y)" $ \x y ->
hasVertex x (vertex y) == (x == y)
test "hasVertex x . removeVertex x == const False" $ \x y ->
(hasVertex x . removeVertex x) y == const False y
testHasEdge :: TestsuiteInt g -> IO ()
testHasEdge (prefix, API{..}) = 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
let es = edgeList z
(x, y) <- elements ((x, y) : es)
return $ hasEdge x y z == elem (x, y) es
testSymmetricHasEdge :: TestsuiteInt g -> IO ()
testSymmetricHasEdge (prefix, API{..}) = 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 (edge y x) == True" $ \x y ->
hasEdge x y (edge y x) == 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 (min x y, max x y) . edgeList" $ \x y z -> do
(u, v) <- elements ((x, y) : edgeList z)
return $ hasEdge u v z == elem (min u v, max u v) (edgeList z)
testVertexCount :: TestsuiteInt g -> IO ()
testVertexCount (prefix, API{..}) = 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
test "vertexCount x < vertexCount y ==> x < y" $ \x y ->
if vertexCount x < vertexCount y
then property (x < y)
else (vertexCount x > vertexCount y ==> x > y)
testEdgeCount :: TestsuiteInt g -> IO ()
testEdgeCount (prefix, API{..}) = 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 :: TestsuiteInt g -> IO ()
testVertexList (prefix, API{..}) = 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 :: TestsuiteInt g -> IO ()
testEdgeList (prefix, API{..}) = 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
testSymmetricEdgeList :: TestsuiteInt g -> IO ()
testSymmetricEdgeList (prefix, API{..}) = do
putStrLn $ "\n============ " ++ prefix ++ "edgeList ============"
test "edgeList empty == []" $
edgeList empty == []
test "edgeList (vertex x) == []" $ \x ->
edgeList (vertex x) == []
test "edgeList (edge x y) == [(min x y, max y x)]" $ \x y ->
edgeList (edge x y) == [(min x y, max y x)]
test "edgeList (star 2 [3,1]) == [(1,2), (2,3)]" $
edgeList (star 2 [3,1]) == [(1,2), (2,3)]
testAdjacencyList :: TestsuiteInt g -> IO ()
testAdjacencyList (prefix, API{..}) = 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, [])]
testSymmetricAdjacencyList :: TestsuiteInt g -> IO ()
testSymmetricAdjacencyList (prefix, API{..}) = 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, [1])]" $
adjacencyList (edge 1 2) == [(1, [2]), (2, [1])]
test "adjacencyList (star 2 [3,1]) == [(1, [2]), (2, [1,3]), (3, [2])]" $
adjacencyList (star 2 [3,1]) == [(1, [2]), (2, [1,3]), (3, [2])]
testVertexSet :: TestsuiteInt g -> IO ()
testVertexSet (prefix, API{..}) = 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
testVertexIntSet :: TestsuiteInt g -> IO ()
testVertexIntSet (prefix, API{..}) = 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 :: TestsuiteInt g -> IO ()
testEdgeSet (prefix, API{..}) = 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
testSymmetricEdgeSet :: TestsuiteInt g -> IO ()
testSymmetricEdgeSet (prefix, API{..}) = 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 (min x y, max x y)" $ \x y ->
edgeSet (edge x y) == Set.singleton (min x y, max x y)
testPreSet :: TestsuiteInt g -> IO ()
testPreSet (prefix, API{..}) = 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 :: TestsuiteInt g -> IO ()
testPostSet (prefix, API{..}) = 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
testPreIntSet :: TestsuiteInt g -> IO ()
testPreIntSet (prefix, API{..}) = do
putStrLn $ "\n============ " ++ prefix ++ "preIntSet ============"
test "preIntSet x empty == IntSet.empty" $ \x ->
preIntSet x empty == IntSet.empty
test "preIntSet x (vertex x) == IntSet.empty" $ \x ->
preIntSet x (vertex x) == IntSet.empty
test "preIntSet 1 (edge 1 2) == IntSet.empty" $
preIntSet 1 (edge 1 2) == IntSet.empty
test "preIntSet y (edge x y) == IntSet.fromList [x]" $ \x y ->
preIntSet y (edge x y) == IntSet.fromList [x]
testPostIntSet :: TestsuiteInt g -> IO ()
testPostIntSet (prefix, API{..}) = 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 2 (edge 1 2) == IntSet.empty" $
postIntSet 2 (edge 1 2) == IntSet.empty
test "postIntSet x (edge x y) == IntSet.fromList [y]" $ \x y ->
postIntSet x (edge x y) == IntSet.fromList [y]
testNeighbours :: TestsuiteInt g -> IO ()
testNeighbours (prefix, API{..}) = do
putStrLn $ "\n============ " ++ prefix ++ "neighbours ============"
test "neighbours x empty == Set.empty" $ \x ->
neighbours x empty == Set.empty
test "neighbours x (vertex x) == Set.empty" $ \x ->
neighbours x (vertex x) == Set.empty
test "neighbours x (edge x y) == Set.fromList [y]" $ \x y ->
neighbours x (edge x y) == Set.fromList [y]
test "neighbours y (edge x y) == Set.fromList [x]" $ \x y ->
neighbours y (edge x y) == Set.fromList [x]
testPath :: TestsuiteInt g -> IO ()
testPath (prefix, API{..}) = do
putStrLn $ "\n============ " ++ prefix ++ "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
testSymmetricPath :: TestsuiteInt g -> IO ()
testSymmetricPath t@(_, API{..}) = do
testPath t
test "path == path . reverse" $ \xs ->
path xs ==(path . reverse) xs
testCircuit :: TestsuiteInt g -> IO ()
testCircuit (prefix, API{..}) = do
putStrLn $ "\n============ " ++ prefix ++ "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)]
testSymmetricCircuit :: TestsuiteInt g -> IO ()
testSymmetricCircuit t@(_, API{..}) = do
testCircuit t
test "circuit == circuit . reverse" $ \xs ->
circuit xs ==(circuit . reverse) xs
testClique :: TestsuiteInt g -> IO ()
testClique (prefix, API{..}) = do
putStrLn $ "\n============ " ++ prefix ++ "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)]
test "clique (xs ++ ys) == connect (clique xs) (clique ys)" $ \xs ys ->
clique (xs ++ ys) == connect (clique xs) (clique ys)
testSymmetricClique :: TestsuiteInt g -> IO ()
testSymmetricClique t@(_, API{..}) = do
testClique t
test "clique == clique . reverse" $ \xs->
clique xs ==(clique . reverse) xs
testBiclique :: TestsuiteInt g -> IO ()
testBiclique (prefix, API{..}) = do
putStrLn $ "\n============ " ++ prefix ++ "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)
testStar :: TestsuiteInt g -> IO ()
testStar (prefix, API{..}) = do
putStrLn $ "\n============ " ++ prefix ++ "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)]
test "star x ys == connect (vertex x) (vertices ys)" $ \x ys ->
star x ys == connect (vertex x) (vertices ys)
testTree :: TestsuiteInt g -> IO ()
testTree (prefix, API{..}) = do
putStrLn $ "\n============ " ++ prefix ++ "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)]
testForest :: TestsuiteInt g -> IO ()
testForest (prefix, API{..}) = do
putStrLn $ "\n============ " ++ prefix ++ "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
testMesh :: Testsuite g Ord -> IO ()
testMesh (prefix, API{..}) = do
putStrLn $ "\n============ " ++ prefix ++ "mesh ============"
test "mesh xs [] == empty" $ \(xs :: [Int]) ->
mesh xs ([] :: [Int]) == empty
test "mesh [] ys == empty" $ \(ys :: [Int]) ->
mesh ([] :: [Int]) ys == empty
test "mesh [x] [y] == vertex (x, y)" $ \(x :: Int) (y :: Int) ->
mesh [x] [y] == vertex (x, y)
test "mesh xs ys == box (path xs) (path ys)" $ \(xs :: [Int]) (ys :: [Int]) ->
mesh xs ys == box (path xs) (path ys)
test "mesh [1..3] \"ab\" == <correct result>" $
mesh [1..3] "ab" == edges [ ((1,'a'),(1,'b')), ((1,'a'),(2,'a')), ((1,'b'),(2,'b')), ((2,'a'),(2,'b'))
, ((2,'a'),(3,'a')), ((2,'b'),(3,'b')), ((3,'a'),(3 :: Int,'b')) ]
test "size (mesh xs ys) == max 1 (3 * length xs * length ys - length xs - length ys -1)" $ \(xs :: [Int]) (ys :: [Int]) ->
size (mesh xs ys) == max 1 (3 * length xs * length ys - length xs - length ys -1)
testTorus :: Testsuite g Ord -> IO ()
testTorus (prefix, API{..}) = do
putStrLn $ "\n============ " ++ prefix ++ "torus ============"
test "torus xs [] == empty" $ \(xs :: [Int]) ->
torus xs ([] :: [Int]) == empty
test "torus [] ys == empty" $ \(ys :: [Int]) ->
torus ([] :: [Int]) ys == empty
test "torus [x] [y] == edge (x,y) (x,y)" $ \(x :: Int) (y :: Int) ->
torus [x] [y] == edge (x,y) (x,y)
test "torus xs ys == box (circuit xs) (circuit ys)" $ \(xs :: [Int]) (ys :: [Int]) ->
torus xs ys == box (circuit xs) (circuit ys)
test "torus [1,2] \"ab\" == <correct result>" $
torus [1,2] "ab" == edges [ ((1,'a'),(1,'b')), ((1,'a'),(2,'a')), ((1,'b'),(1,'a')), ((1,'b'),(2,'b'))
, ((2,'a'),(1,'a')), ((2,'a'),(2,'b')), ((2,'b'),(1,'b')), ((2,'b'),(2 :: Int,'a')) ]
test "size (torus xs ys) == max 1 (3 * length xs * length ys)" $ \(xs :: [Int]) (ys :: [Int]) ->
size (torus xs ys) == max 1 (3 * length xs * length ys)
testDeBruijn :: Testsuite g Ord -> IO ()
testDeBruijn (prefix, API{..}) = do
putStrLn $ "\n============ " ++ prefix ++ "deBruijn ============"
test " deBruijn 0 xs == edge [] []" $ \(xs :: [Int]) ->
deBruijn 0 xs == edge [] []
test "n > 0 ==> deBruijn n [] == empty" $ \n ->
n > 0 ==> deBruijn n ([] :: [Int]) == empty
test " deBruijn 1 [0,1] == edges [ ([0],[0]), ([0],[1]), ([1],[0]), ([1],[1]) ]" $
deBruijn 1 [0,1::Int] == edges [ ([0],[0]), ([0],[1]), ([1],[0]), ([1],[1]) ]
test " deBruijn 2 \"0\" == edge \"00\" \"00\"" $
deBruijn 2 "0" == edge "00" "00"
test " deBruijn 2 \"01\" == <correct result>" $
deBruijn 2 "01" == edges [ ("00","00"), ("00","01"), ("01","10"), ("01","11")
, ("10","00"), ("10","01"), ("11","10"), ("11","11") ]
test " 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)
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)
testBox :: Testsuite g Ord -> IO ()
testBox (prefix, API{..}) = do
putStrLn $ "\n============ " ++ prefix ++ "box ============"
let unit = gmap $ \(a :: Int, () ) -> a
comm = gmap $ \(a :: Int, b :: Int) -> (b, a)
test "box x y ~~ box y x" $ mapSize (min 10) $ \x y ->
comm (box x y) == box y x
test "box x (overlay y z) == overlay (box x y) (box x z)" $ mapSize (min 10) $ \x y z ->
let _ = x + y + z + vertex (0 :: Int) in
box x (overlay y z) == overlay (box x y) (box x z)
test "box x (vertex ()) ~~ x" $ mapSize (min 10) $ \x ->
unit(box x (vertex ())) == (x `asTypeOf` empty)
test "box x empty ~~ empty" $ mapSize (min 10) $ \x ->
unit(box x empty) == empty
let assoc = gmap $ \(a :: Int, (b :: Int, c :: Int)) -> ((a, b), c)
test "box x (box y z) ~~ box (box x y) z" $ mapSize (min 10) $ \x y z ->
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 y ->
let _ = x + y + vertex (0 :: Int) in
transpose (box x y) == box (transpose x) (transpose y)
test "vertexCount (box x y) == vertexCount x * vertexCount y" $ mapSize (min 10) $ \x y ->
let _ = x + y + vertex (0 :: Int) in
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 y ->
let _ = x + y + vertex (0 :: Int) in
edgeCount (box x y) <= vertexCount x * edgeCount y + edgeCount x * vertexCount y
testRemoveVertex :: TestsuiteInt g -> IO ()
testRemoveVertex (prefix, API{..}) = do
putStrLn $ "\n============ " ++ prefix ++ "removeVertex ============"
test "removeVertex x (vertex x) == empty" $ \x ->
removeVertex x (vertex x) == empty
test "removeVertex 1 (vertex 2) == vertex 2" $
removeVertex 1 (vertex 2) == vertex 2
test "removeVertex x (edge x x) == empty" $ \x ->
removeVertex x (edge x x) == empty
test "removeVertex 1 (edge 1 2) == vertex 2" $
removeVertex 1 (edge 1 2) == vertex 2
test "removeVertex x . removeVertex x == removeVertex x" $ \x y ->
(removeVertex x . removeVertex x) y == removeVertex x y
testRemoveEdge :: TestsuiteInt g -> IO ()
testRemoveEdge (prefix, API{..}) = 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
-- TODO: Ouch. Generic tests are becoming awkward. We need a better way.
when (prefix == "Fold." || prefix == "Graph.") $ do
test "size (removeEdge x y z) <= 3 * size z" $ \x y z ->
size (removeEdge x y z) <= 3 * size z
testSymmetricRemoveEdge :: TestsuiteInt g -> IO ()
testSymmetricRemoveEdge t@(_, API{..}) = do
testRemoveEdge t
test "removeEdge x y == removeEdge y x" $ \x y z ->
removeEdge x y z == removeEdge y x z
testReplaceVertex :: TestsuiteInt g -> IO ()
testReplaceVertex (prefix, API{..}) = do
putStrLn $ "\n============ " ++ prefix ++ "replaceVertex ============"
test "replaceVertex x x == id" $ \x y ->
replaceVertex x x y == id 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 :: TestsuiteInt g -> IO ()
testMergeVertices (prefix, API{..}) = do
putStrLn $ "\n============ " ++ prefix ++ "mergeVertices ============"
test "mergeVertices (const False) x == id" $ \x y ->
mergeVertices (const False) x y == id 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 :: TestsuiteInt g -> IO ()
testTranspose (prefix, API{..}) = 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" $ size10 $ \x ->
(transpose . transpose) x == id x
test "edgeList . transpose == sort . map swap . edgeList" $ \x ->
(edgeList . transpose) x == (sort . map swap . edgeList) x
testGmap :: TestsuiteInt g -> IO ()
testGmap (prefix, API{..}) = 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 == id x
test "gmap f . gmap g == gmap (f . g)" $ \(apply -> f :: Int -> Int) (apply -> g :: Int -> Int) x ->
(gmap f . gmap g) x == gmap (f . g) x
testInduce :: TestsuiteInt g -> IO ()
testInduce (prefix, API{..}) = 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
testInduceJust :: Testsuite g Ord -> IO ()
testInduceJust (prefix, API{..}) = do
putStrLn $ "\n============ " ++ prefix ++ "induceJust ============"
test "induceJust (vertex Nothing) == empty" $
induceJust (vertex (Nothing :: Maybe Int)) == empty
test "induceJust (edge (Just x) Nothing) == vertex x" $ \x ->
induceJust (edge (Just x) (Nothing :: Maybe Int)) == vertex x
test "induceJust . gmap Just == id" $ \(x :: g Int) ->
(induceJust . gmap Just) x == id x
test "induceJust . gmap (\\x -> if p x then Just x else Nothing) == induce p" $ \(x :: g Int) (apply -> p) ->
(induceJust . gmap (\x -> if p x then Just x else Nothing)) x == induce p x
testCompose :: TestsuiteInt g -> IO ()
testCompose (prefix, API{..}) = do
putStrLn $ "\n============ " ++ prefix ++ "compose ============"
test "compose empty x == empty" $ \x ->
compose empty x == empty
test "compose x empty == empty" $ \x ->
compose x empty == empty
test "compose (vertex x) y == empty" $ \x y ->
compose (vertex x) y == empty
test "compose x (vertex y) == empty" $ \x y ->
compose x (vertex y) == empty
test "compose x (compose y z) == compose (compose x y) z" $ size10 $ \x y z ->
compose x (compose y z) == compose (compose x y) z
test "compose x (overlay y z) == overlay (compose x y) (compose x z)" $ size10 $ \x y z ->
compose x (overlay y z) == overlay (compose x y) (compose x z)
test "compose (overlay x y) z == overlay (compose x z) (compose y z)" $ size10 $ \x y z ->
compose (overlay x y) z == overlay (compose x z) (compose y z)
test "compose (edge x y) (edge y z) == edge x z" $ \x y z ->
compose (edge x y) (edge y z) == edge x z
test "compose (path [1..5]) (path [1..5]) == edges [(1,3),(2,4),(3,5)]" $
compose (path [1..5]) (path [1..5]) == edges [(1,3),(2,4),(3,5)]
test "compose (circuit [1..5]) (circuit [1..5]) == circuit [1,3,5,2,4]" $
compose (circuit [1..5]) (circuit [1..5]) == circuit [1,3,5,2,4]
testClosure :: TestsuiteInt g -> IO ()
testClosure (prefix, API{..}) = do
putStrLn $ "\n============ " ++ prefix ++ "closure ============"
test "closure empty == empty" $
closure empty == empty
test "closure (vertex x) == edge x x" $ \x ->
closure (vertex x) == edge x x
test "closure (edge x x) == edge x x" $ \x ->
closure (edge x x) == edge x x
test "closure (edge x y) == edges [(x,x), (x,y), (y,y)]" $ \x y ->
closure (edge x y) == edges [(x,x), (x,y), (y,y)]
test "closure (path $ nub xs) == reflexiveClosure (clique $ nub xs)" $ \xs ->
closure (path $ nubOrd xs) == reflexiveClosure (clique $ nubOrd xs)
test "closure == reflexiveClosure . transitiveClosure" $ size10 $ \x ->
closure x == (reflexiveClosure . transitiveClosure) x
test "closure == transitiveClosure . reflexiveClosure" $ size10 $ \x ->
closure x == (transitiveClosure . reflexiveClosure) x
test "closure . closure == closure" $ size10 $ \x ->
(closure . closure) x == closure x
test "postSet x (closure y) == Set.fromList (reachable y x)" $ size10 $ \x y ->
postSet x (closure y) == Set.fromList (reachable y x)
testReflexiveClosure :: TestsuiteInt g -> IO ()
testReflexiveClosure (prefix, API{..}) = do
putStrLn $ "\n============ " ++ prefix ++ "reflexiveClosure ============"
test "reflexiveClosure empty == empty" $
reflexiveClosure empty == empty
test "reflexiveClosure (vertex x) == edge x x" $ \x ->
reflexiveClosure (vertex x) == edge x x
test "reflexiveClosure (edge x x) == edge x x" $ \x ->
reflexiveClosure (edge x x) == edge x x
test "reflexiveClosure (edge x y) == edges [(x,x), (x,y), (y,y)]" $ \x y ->
reflexiveClosure (edge x y) == edges [(x,x), (x,y), (y,y)]
test "reflexiveClosure . reflexiveClosure == reflexiveClosure" $ \x ->
(reflexiveClosure . reflexiveClosure) x == reflexiveClosure x
testSymmetricClosure :: TestsuiteInt g -> IO ()
testSymmetricClosure (prefix, API{..}) = do
putStrLn $ "\n============ " ++ prefix ++ "symmetricClosure ============"
test "symmetricClosure empty == empty" $
symmetricClosure empty == empty
test "symmetricClosure (vertex x) == vertex x" $ \x ->
symmetricClosure (vertex x) == vertex x
test "symmetricClosure (edge x y) == edges [(x,y), (y,x)]" $ \x y ->
symmetricClosure (edge x y) == edges [(x,y), (y,x)]
test "symmetricClosure x == overlay x (transpose x)" $ \x ->
symmetricClosure x == overlay x (transpose x)
test "symmetricClosure . symmetricClosure == symmetricClosure" $ \x ->
(symmetricClosure . symmetricClosure) x == symmetricClosure x
testTransitiveClosure :: TestsuiteInt g -> IO ()
testTransitiveClosure (prefix, API{..}) = do
putStrLn $ "\n============ " ++ prefix ++ "transitiveClosure ============"
test "transitiveClosure empty == empty" $
transitiveClosure empty == empty
test "transitiveClosure (vertex x) == vertex x" $ \x ->
transitiveClosure (vertex x) == vertex x
test "transitiveClosure (edge x y) == edge x y" $ \x y ->
transitiveClosure (edge x y) == edge x y
test "transitiveClosure (path $ nub xs) == clique (nub $ xs)" $ \xs ->
transitiveClosure (path $ nubOrd xs) == clique (nubOrd xs)
test "transitiveClosure . transitiveClosure == transitiveClosure" $ size10 $ \x ->
(transitiveClosure . transitiveClosure) x == transitiveClosure x
testSplitVertex :: TestsuiteInt g -> IO ()
testSplitVertex (prefix, API{..}) = 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 == id 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 :: TestsuiteInt g -> IO ()
testBind (prefix, API{..}) = do
putStrLn $ "\n============ " ++ prefix ++ "bind ============"
test "bind empty f == empty" $ \(apply -> f) ->
bind empty f == empty
test "bind (vertex x) f == f x" $ \(apply -> f) x ->
bind (vertex x) f == 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)" $ size10 $ \xs (apply -> f) ->
bind (vertices xs) f == overlays (map f xs)
test "bind x (const empty) == empty" $ \x ->
bind x (const empty) == empty
test "bind x vertex == x" $ \x ->
bind x vertex == x
test "bind (bind x f) g == bind x (\\y -> bind (f y) g)" $ size10 $ \x (apply -> f) (apply -> g) ->
bind (bind x f) g == bind x (\y -> bind (f y) g)
testSimplify :: TestsuiteInt g -> IO ()
testSimplify (prefix, API{..}) = do
putStrLn $ "\n============ " ++ prefix ++ "simplify ============"
test "simplify == id" $ \x ->
simplify x == id x
test "size (simplify x) <= size x" $ \x ->
size (simplify x) <= size x
testBfsForest :: TestsuiteInt g -> IO ()
testBfsForest (prefix, API{..}) = do
putStrLn $ "\n============ " ++ prefix ++ "bfsForest ============"
test "forest $ bfsForest (edge 1 2) [0] == empty" $
(forest $ bfsForest (edge 1 2) [0]) == empty
test "forest $ bfsForest (edge 1 2) [1] == edge 1 2" $
(forest $ bfsForest (edge 1 2) [1]) == edge 1 2
test "forest $ bfsForest (edge 1 2) [2] == vertex 2" $
(forest $ bfsForest (edge 1 2) [2]) == vertex 2
test "forest $ bfsForest (edge 1 2) [0,1,2] == vertices [1,2]" $
(forest $ bfsForest (edge 1 2) [0,1,2]) == vertices [1,2]
test "forest $ bfsForest (edge 1 2) [2,1,0] == vertices [1,2]" $
(forest $ bfsForest (edge 1 2) [2,1,0]) == vertices [1,2]
test "forest $ bfsForest (edge 1 1) [1] == vertex 1" $
(forest $ bfsForest (edge 1 1) [1]) == vertex 1
test "isSubgraphOf (forest $ bfsForest x vs) x == True" $ \x vs ->
isSubgraphOf (forest $ bfsForest x vs) x == True
test "bfsForest x (vertexList x) == map (\v -> Node v []) (nub $ vertexList x)" $ \x ->
bfsForest x (vertexList x) == map (\v -> Node v []) (nub $ vertexList x)
test "bfsForest x [] == []" $ \x ->
bfsForest x [] == []
test "bfsForest empty vs == []" $ \vs ->
bfsForest empty vs == []
test "bfsForest (3 * (1 + 4) * (1 + 5)) [1,4] == <correct result>" $
bfsForest (3 * (1 + 4) * (1 + 5)) [1,4] == [ Node { rootLabel = 1
, subForest = [ Node { rootLabel = 5
, subForest = [] }]}
, Node { rootLabel = 4
, subForest = [] }]
test "forest $ bfsForest (circuit [1..5] + circuit [5,4..1]) [3] == path [3,2,1] + path [3,4,5]" $
(forest $ bfsForest (circuit [1..5] + circuit [5,4..1]) [3])== path [3,2,1] + path [3,4,5]
testBfs :: TestsuiteInt g -> IO ()
testBfs (prefix, API{..}) = do
putStrLn $ "\n============ " ++ prefix ++ "bfs ============"
test "bfs (edge 1 2) [0] == []" $
bfs (edge 1 2) [0] == []
test "bfs (edge 1 2) [1] == [[1], [2]]" $
bfs (edge 1 2) [1] == [[1], [2]]
test "bfs (edge 1 2) [2] == [[2]]" $
bfs (edge 1 2) [2] == [[2]]
test "bfs (edge 1 2) [1,2] == [[1,2]]" $
bfs (edge 1 2) [1,2] == [[1,2]]
test "bfs (edge 1 2) [2,1] == [[2,1]]" $
bfs (edge 1 2) [2,1] == [[2,1]]
test "bfs (edge 1 1) [1] == [[1]]" $
bfs (edge 1 1) [1] == [[1]]
test "bfs empty vs == []" $ \vs ->
bfs empty vs == []
test "bfs x [] == []" $ \x ->
bfs x [] == []
test "bfs (1 * 2 + 3 * 4 + 5 * 6) [1,2] == [[1,2]]" $
bfs (1 * 2 + 3 * 4 + 5 * 6) [1,2] == [[1,2]]
test "bfs (1 * 2 + 3 * 4 + 5 * 6) [1,3] == [[1,3], [2,4]]" $
bfs (1 * 2 + 3 * 4 + 5 * 6) [1,3] == [[1,3], [2,4]]
test "bfs (3 * (1 + 4) * (1 + 5)) [3] == [[3], [1,4,5]]" $
bfs (3 * (1 + 4) * (1 + 5)) [3] == [[3], [1,4,5]]
test "bfs (circuit [1..5] + circuit [5,4..1]) [2] == [[2], [1,3], [5,4]]" $
bfs (circuit [1..5] + circuit [5,4..1]) [2] == [[2], [1,3], [5,4]]
test "concat $ bfs (circuit [1..5] + circuit [5,4..1]) [3] == [3,2,4,1,5]" $
(concat $ bfs (circuit [1..5] + circuit [5,4..1]) [3])== [3,2,4,1,5]
test "map concat . transpose . map levels . bfsForest x == bfs x" $ \x vs ->
(map concat . List.transpose . map levels . bfsForest x) vs == bfs x vs
testDfsForest :: TestsuiteInt g -> IO ()
testDfsForest (prefix, API{..}) = do
putStrLn $ "\n============ " ++ prefix ++ "dfsForest ============"
test "forest $ dfsForest empty == empty" $
(forest $ dfsForest empty) == empty
test "forest $ dfsForest (edge 1 1) == vertex 1" $
(forest $ dfsForest (edge 1 1)) == vertex 1
test "forest $ dfsForest (edge 1 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 "isDfsForestOf (dfsForest x) x == True" $ \x ->
isDfsForestOf (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 = [] }]}]
test "forest (dfsForest $ circuit [1..5] + circuit [5,4..1]) == path [1,2,3,4,5]" $
forest (dfsForest $ circuit [1..5] + circuit [5,4..1]) == path [1,2,3,4,5]
testDfsForestFrom :: TestsuiteInt g -> IO ()
testDfsForestFrom (prefix, API{..}) = do
putStrLn $ "\n============ " ++ prefix ++ "dfsForestFrom ============"
test "forest $ dfsForestFrom empty vs == empty" $ \vs ->
(forest $ dfsForestFrom empty vs) == empty
test "forest $ dfsForestFrom (edge 1 1) [1] == vertex 1" $
(forest $ dfsForestFrom (edge 1 1) [1]) == vertex 1
test "forest $ dfsForestFrom (edge 1 2) [0] == empty" $
(forest $ dfsForestFrom (edge 1 2) [0]) == empty
test "forest $ dfsForestFrom (edge 1 2) [1] == edge 1 2" $
(forest $ dfsForestFrom (edge 1 2) [1]) == edge 1 2
test "forest $ dfsForestFrom (edge 1 2) [2] == vertex 2" $
(forest $ dfsForestFrom (edge 1 2) [2]) == vertex 2
test "forest $ dfsForestFrom (edge 1 2) [1,2] == edge 1 2" $
(forest $ dfsForestFrom (edge 1 2) [1,2]) == edge 1 2
test "forest $ dfsForestFrom (edge 1 2) [2,1] == vertices [1,2]" $
(forest $ dfsForestFrom (edge 1 2) [2,1]) == vertices [1,2]
test "isSubgraphOf (forest $ dfsForestFrom x vs) x == True" $ \x vs ->
isSubgraphOf (forest $ dfsForestFrom x vs) x == True
test "isDfsForestOf (dfsForestFrom x (vertexList x)) x == True" $ \x ->
isDfsForestOf (dfsForestFrom x (vertexList x)) x == True
test "dfsForestFrom x (vertexList x) == dfsForest x" $ \x ->
dfsForestFrom x (vertexList x) == dfsForest x
test "dfsForestFrom x [] == []" $ \x ->
dfsForestFrom x [] == []
test "dfsForestFrom (3 * (1 + 4) * (1 + 5)) [1,4] == <correct result>" $
dfsForestFrom (3 * (1 + 4) * (1 + 5)) [1,4] == [ Node { rootLabel = 1
, subForest = [ Node { rootLabel = 5
, subForest = [] }]}
, Node { rootLabel = 4
, subForest = [] }]
test "forest $ dfsForestFrom (circuit [1..5] + circuit [5,4..1]) [3] == path [3,2,1,5,4]" $
(forest $ dfsForestFrom (circuit [1..5] + circuit [5,4..1]) [3])== path [3,2,1,5,4]
testDfs :: TestsuiteInt g -> IO ()
testDfs (prefix, API{..}) = do
putStrLn $ "\n============ " ++ prefix ++ "dfs ============"
test "dfs empty vs == []" $ \vs ->
dfs empty vs == []
test "dfs (edge 1 1) [1] == [1]" $
dfs (edge 1 1) [1] == [1]
test "dfs (edge 1 2) [0] == []" $
dfs (edge 1 2) [0] == []
test "dfs (edge 1 2) [1] == [1,2]" $
dfs (edge 1 2) [1] == [1,2]
test "dfs (edge 1 2) [2] == [2]" $
dfs (edge 1 2) [2] == [2]
test "dfs (edge 1 2) [1,2] == [1,2]" $
dfs (edge 1 2) [1,2] == [1,2]
test "dfs (edge 1 2) [2,1] == [2,1]" $
dfs (edge 1 2) [2,1] == [2,1]
test "dfs x [] == []" $ \x ->
dfs x [] == []
putStrLn ""
test "and [ hasVertex v x | v <- dfs x vs ] == True" $ \x vs ->
and [ hasVertex v x | v <- dfs x vs ] == True
test "dfs (3 * (1 + 4) * (1 + 5)) [1,4] == [1,5,4]" $
dfs (3 * (1 + 4) * (1 + 5)) [1,4] == [1,5,4]
test "dfs (circuit [1..5] + circuit [5,4..1]) [3] == [3,2,1,5,4]" $
dfs (circuit [1..5] + circuit [5,4..1]) [3] == [3,2,1,5,4]
testReachable :: TestsuiteInt g -> IO ()
testReachable (prefix, API{..}) = do
putStrLn $ "\n============ " ++ prefix ++ "dfs ============"
test "reachable empty x == []" $ \x ->
reachable empty x == []
test "reachable (vertex 1) 1 == [1]" $
reachable (vertex 1) 1 == [1]
test "reachable (edge 1 1) 1 == [1]" $
reachable (edge 1 1) 1 == [1]
test "reachable (edge 1 2) 0 == []" $
reachable (edge 1 2) 0 == []
test "reachable (edge 1 2) 1 == [1,2]" $
reachable (edge 1 2) 1 == [1,2]
test "reachable (edge 1 2) 2 == [2]" $
reachable (edge 1 2) 2 == [2]
test "reachable (path [1..8] ) 4 == [4..8]" $
reachable (path [1..8] ) 4 == [4..8]
test "reachable (circuit [1..8] ) 4 == [4..8] ++ [1..3]" $
reachable (circuit [1..8] ) 4 == [4..8] ++ [1..3]
test "reachable (clique [8,7..1]) 8 == [8] ++ [1..7]" $
reachable (clique [8,7..1]) 8 == [8] ++ [1..7]
putStrLn ""
test "and [ hasVertex v x | v <- reachable x y ] == True" $ \x y ->
and [ hasVertex v x | v <- reachable x y ] == True
testTopSort :: TestsuiteInt g -> IO ()
testTopSort (prefix, API{..}) = do
putStrLn $ "\n============ " ++ prefix ++ "topSort ============"
test "topSort (1 * 2 + 3 * 1) == Right [3,1,2]" $
topSort (1 * 2 + 3 * 1) == Right [3,1,2]
test "topSort (path [1..5]) == Right [1..5]" $
topSort (path [1..5]) == Right [1..5]
test "topSort (3 * (1 * 4 + 2 * 5)) == Right [3,1,2,4,5]" $
topSort (3 * (1 * 4 + 2 * 5)) == Right [3,1,2,4,5]
test "topSort (1 * 2 + 2 * 1) == Left (2 :| [1])" $
topSort (1 * 2 + 2 * 1) == Left (2 :| [1])
test "topSort (path [5,4..1] + edge 2 4) == Left (4 :| [3,2])" $
topSort (path [5,4..1] + edge 2 4) == Left (4 :| [3,2])
test "topSort (circuit [1..5]) == Left (3 :| [1,2])" $
topSort (circuit [1..3]) == Left (3 :| [1,2])
test "topSort (circuit [1..3] + circuit [3,2,1]) == Left (3 :| [2])" $
topSort (circuit [1..3] + circuit [3,2,1]) == Left (3 :| [2])
test "topSort (1 * 2 + (5 + 2) * 1 + 3 * 4 * 3) == Left (1 :| [2])" $
topSort (1 * 2 + (5 + 2) * 1 + 3 * 4 * 3) == Left (1 :| [2])
test "fmap (flip isTopSortOf x) (topSort x) /= Right False" $ \x ->
fmap (flip isTopSortOf x) (topSort x) /= Right False
test "topSort . vertices == Right . nub . sort" $ \vs ->
(topSort . vertices) vs == (Right . nubOrd . sort) vs
testIsAcyclic :: TestsuiteInt g -> IO ()
testIsAcyclic (prefix, API{..}) = do
putStrLn $ "\n============ " ++ prefix ++ "testIsAcyclic ============"
test "isAcyclic (1 * 2 + 3 * 1) == True" $
isAcyclic (1 * 2 + 3 * 1) == True
test "isAcyclic (1 * 2 + 2 * 1) == False" $
isAcyclic (1 * 2 + 2 * 1) == False
test "isAcyclic . circuit == null" $ \xs ->
(isAcyclic . circuit) xs == null xs
test "isAcyclic == isRight . topSort" $ \x ->
isAcyclic x == isRight (topSort x)
testIsDfsForestOf :: TestsuiteInt g -> IO ()
testIsDfsForestOf (prefix, API{..}) = do
putStrLn $ "\n============ " ++ prefix ++ "isDfsForestOf ============"
test "isDfsForestOf [] empty == True" $
isDfsForestOf [] empty == True
test "isDfsForestOf [] (vertex 1) == False" $
isDfsForestOf [] (vertex 1) == False
test "isDfsForestOf [Node 1 []] (vertex 1) == True" $
isDfsForestOf [Node 1 []] (vertex 1) == True
test "isDfsForestOf [Node 1 []] (vertex 2) == False" $
isDfsForestOf [Node 1 []] (vertex 2) == False
test "isDfsForestOf [Node 1 [], Node 1 []] (vertex 1) == False" $
isDfsForestOf [Node 1 [], Node 1 []] (vertex 1) == False
test "isDfsForestOf [Node 1 []] (edge 1 1) == True" $
isDfsForestOf [Node 1 []] (edge 1 1) == True
test "isDfsForestOf [Node 1 []] (edge 1 2) == False" $
isDfsForestOf [Node 1 []] (edge 1 2) == False
test "isDfsForestOf [Node 1 [], Node 2 []] (edge 1 2) == False" $
isDfsForestOf [Node 1 [], Node 2 []] (edge 1 2) == False
test "isDfsForestOf [Node 2 [], Node 1 []] (edge 1 2) == True" $
isDfsForestOf [Node 2 [], Node 1 []] (edge 1 2) == True
test "isDfsForestOf [Node 1 [Node 2 []]] (edge 1 2) == True" $
isDfsForestOf [Node 1 [Node 2 []]] (edge 1 2) == True
test "isDfsForestOf [Node 1 [], Node 2 []] (vertices [1,2]) == True" $
isDfsForestOf [Node 1 [], Node 2 []] (vertices [1,2]) == True
test "isDfsForestOf [Node 2 [], Node 1 []] (vertices [1,2]) == True" $
isDfsForestOf [Node 2 [], Node 1 []] (vertices [1,2]) == True
test "isDfsForestOf [Node 1 [Node 2 []]] (vertices [1,2]) == False" $
isDfsForestOf [Node 1 [Node 2 []]] (vertices [1,2]) == False
test "isDfsForestOf [Node 1 [Node 2 [Node 3 []]]] (path [1,2,3]) == True" $
isDfsForestOf [Node 1 [Node 2 [Node 3 []]]] (path [1,2,3]) == True
test "isDfsForestOf [Node 1 [Node 3 [Node 2 []]]] (path [1,2,3]) == False" $
isDfsForestOf [Node 1 [Node 3 [Node 2 []]]] (path [1,2,3]) == False
test "isDfsForestOf [Node 3 [], Node 1 [Node 2 []]] (path [1,2,3]) == True" $
isDfsForestOf [Node 3 [], Node 1 [Node 2 []]] (path [1,2,3]) == True
test "isDfsForestOf [Node 2 [Node 3 []], Node 1 []] (path [1,2,3]) == True" $
isDfsForestOf [Node 2 [Node 3 []], Node 1 []] (path [1,2,3]) == True
test "isDfsForestOf [Node 1 [], Node 2 [Node 3 []]] (path [1,2,3]) == False" $
isDfsForestOf [Node 1 [], Node 2 [Node 3 []]] (path [1,2,3]) == False
testIsTopSortOf :: TestsuiteInt g -> IO ()
testIsTopSortOf (prefix, API{..}) = do
putStrLn $ "\n============ " ++ prefix ++ "isTopSortOf ============"
test "isTopSortOf [3,1,2] (1 * 2 + 3 * 1) == True" $
isTopSortOf [3,1,2] (1 * 2 + 3 * 1) == True
test "isTopSortOf [1,2,3] (1 * 2 + 3 * 1) == False" $
isTopSortOf [1,2,3] (1 * 2 + 3 * 1) == False
test "isTopSortOf [] (1 * 2 + 3 * 1) == False" $
isTopSortOf [] (1 * 2 + 3 * 1) == False
test "isTopSortOf [] empty == True" $
isTopSortOf [] empty == True
test "isTopSortOf [x] (vertex x) == True" $ \x ->
isTopSortOf [x] (vertex x) == True
test "isTopSortOf [x] (edge x x) == False" $ \x ->
isTopSortOf [x] (edge x x) == False