{-# LANGUAGE OverloadedLists, ViewPatterns #-} ----------------------------------------------------------------------------- -- | -- Module : Algebra.Graph.Test.Bipartite.AdjacencyMap -- Copyright : (c) Andrey Mokhov 2016-2022 -- License : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability : experimental -- -- Testsuite for "Algebra.Graph.Bipartite.AdjacencyMap". ----------------------------------------------------------------------------- module Algebra.Graph.Test.Bipartite.AdjacencyMap ( -- * Testsuite testBipartiteAdjacencyMap, testBipartiteAdjacencyMapAlgorithm ) where import Algebra.Graph.Bipartite.AdjacencyMap import Algebra.Graph.Bipartite.AdjacencyMap.Algorithm import Algebra.Graph.Test import Data.Either import Data.Either.Extra import Data.List (nub, sort) import Data.Map.Strict (Map) import Data.Set (Set) import qualified Algebra.Graph.AdjacencyMap as AM import qualified Algebra.Graph.Bipartite.AdjacencyMap as B import qualified Data.Bifunctor as Bifunctor import qualified Data.Map.Strict as Map import qualified Data.Set as Set import qualified Data.Tuple import qualified Algebra.Graph.Bipartite.AdjacencyMap as B type AI = AM.AdjacencyMap Int type AII = AM.AdjacencyMap (Either Int Int) type BAII = AdjacencyMap Int Int type MII = Matching Int Int type MIC = Matching Int Char type LII = List Int Int testBipartiteAdjacencyMap :: IO () testBipartiteAdjacencyMap = do -- Help with type inference by shadowing overly polymorphic functions let consistent :: BAII -> Bool consistent = B.consistent show :: BAII -> String show = Prelude.show leftAdjacencyMap :: BAII -> Map Int (Set Int) leftAdjacencyMap = B.leftAdjacencyMap rightAdjacencyMap :: BAII -> Map Int (Set Int) rightAdjacencyMap = B.rightAdjacencyMap leftAdjacencyList :: BAII -> [(Int, [Int])] leftAdjacencyList = B.leftAdjacencyList rightAdjacencyList :: BAII -> [(Int, [Int])] rightAdjacencyList = B.rightAdjacencyList empty :: BAII empty = B.empty vertex :: Either Int Int -> BAII vertex = B.vertex leftVertex :: Int -> BAII leftVertex = B.leftVertex rightVertex :: Int -> BAII rightVertex = B.rightVertex edge :: Int -> Int -> BAII edge = B.edge isEmpty :: BAII -> Bool isEmpty = B.isEmpty hasLeftVertex :: Int -> BAII -> Bool hasLeftVertex = B.hasLeftVertex hasRightVertex :: Int -> BAII -> Bool hasRightVertex = B.hasRightVertex hasVertex :: Either Int Int -> BAII -> Bool hasVertex = B.hasVertex hasEdge :: Int -> Int -> BAII -> Bool hasEdge = B.hasEdge vertexCount :: BAII -> Int vertexCount = B.vertexCount edgeCount :: BAII -> Int edgeCount = B.edgeCount vertices :: [Int] -> [Int] -> BAII vertices = B.vertices edges :: [(Int, Int)] -> BAII edges = B.edges overlays :: [BAII] -> BAII overlays = B.overlays connects :: [BAII] -> BAII connects = B.connects swap :: BAII -> BAII swap = B.swap toBipartite :: AII -> BAII toBipartite = B.toBipartite toBipartiteWith :: Ord a => (a -> Either Int Int) -> AM.AdjacencyMap a -> BAII toBipartiteWith = B.toBipartiteWith fromBipartite :: BAII -> AII fromBipartite = B.fromBipartite biclique :: [Int] -> [Int] -> BAII biclique = B.biclique star :: Int -> [Int] -> BAII star = B.star stars :: [(Int, [Int])] -> BAII stars = B.stars removeLeftVertex :: Int -> BAII -> BAII removeLeftVertex = B.removeLeftVertex removeRightVertex :: Int -> BAII -> BAII removeRightVertex = B.removeRightVertex removeEdge :: Int -> Int -> BAII -> BAII removeEdge = B.removeEdge putStrLn "\n============ Bipartite.AdjacencyMap.Num ============" test "0 == rightVertex 0" $ 0 == rightVertex 0 test "swap 1 == leftVertex 1" $ swap 1 == leftVertex 1 test "swap 1 + 2 == vertices [1] [2]" $ swap 1 + 2 == vertices [1] [2] test "swap 1 * 2 == edge 1 2" $ swap 1 * 2 == edge 1 2 test "swap 1 + 2 * swap 3 == overlay (leftVertex 1) (edge 3 2)" $ swap 1 + 2 * swap 3 == overlay (leftVertex 1) (edge 3 2) test "swap 1 * (2 + swap 3) == connect (leftVertex 1) (vertices [3] [2])" $ swap 1 * (2 + swap 3) == connect (leftVertex 1) (vertices [3] [2]) putStrLn "\n============ Bipartite.AdjacencyMap.Show ============" test "show empty == \"empty\"" $ show empty == "empty" test "show 1 == \"rightVertex 1\"" $ show 1 == "rightVertex 1" test "show (swap 2) == \"leftVertex 2\"" $ show (swap 2) == "leftVertex 2" test "show 1 + 2 == \"vertices [] [1,2]\"" $ show (1 + 2) == "vertices [] [1,2]" test "show (swap (1 + 2)) == \"vertices [1,2] []\"" $ show (swap (1 + 2)) == "vertices [1,2] []" test "show (swap 1 * 2) == \"edge 1 2\"" $ show (swap 1 * 2) == "edge 1 2" test "show (swap 1 * 2 * swap 3) == \"edges [(1,2),(3,2)]\"" $ show (swap 1 * 2 * swap 3) == "edges [(1,2),(3,2)]" test "show (swap 1 * 2 + swap 3) == \"overlay (leftVertex 3) (edge 1 2)\"" $ show (swap 1 * 2 + swap 3) == "overlay (leftVertex 3) (edge 1 2)" putStrLn "\n============ Bipartite.AdjacencyMap.Eq ============" test "(x == y) == (leftAdjacencyMap x == leftAdjacencyMap y && rightAdjacencyMap x == rightAdjacencyMap y)" $ \(x :: BAII) (y :: BAII) -> (x == y) == (leftAdjacencyMap x == leftAdjacencyMap y && rightAdjacencyMap x == rightAdjacencyMap y) putStrLn "" test " x + y == y + x" $ \(x :: BAII) y -> x + y == y + x test " x + (y + z) == (x + y) + z" $ \(x :: BAII) y z -> x + (y + z) == (x + y) + z test " x * empty == x" $ \(x :: BAII) -> x * empty == x test " empty * x == x" $ \(x :: BAII) -> empty * x == x test " x * y == y * x" $ \(x :: BAII) y -> x * y == y * x test " x * (y * z) == (x * y) * z" $ size10 $ \(x :: BAII) y z -> x * (y * z) == (x * y) * z test " x * (y + z) == x * y + x * z" $ size10 $ \(x :: BAII) y z -> x * (y + z) == x * (y + z) test " (x + y) * z == x * z + y * z" $ size10 $ \(x :: BAII) y z -> (x + y) * z == x * z + y * z test " x * y * z == x * y + x * z + y * z" $ size10 $ \(x :: BAII) y z -> x * y * z == x * y + x * z + y * z test " x + empty == x" $ \(x :: BAII) -> x + empty == x test " empty + x == x" $ \(x :: BAII) -> empty + x == x test " x + x == x" $ \(x :: BAII) -> x + x == x test "x * y + x + y == x * y" $ \(x :: BAII) (y :: BAII) -> x * y + x + y == x * y test " x * x * x == x * x" $ size10 $ \(x :: BAII) -> x * x * x == x * x putStrLn "" test " leftVertex x * leftVertex y == leftVertex x + leftVertex y " $ \x y -> leftVertex x * leftVertex y == leftVertex x + leftVertex y test "rightVertex x * rightVertex y == rightVertex x + rightVertex y" $ \x y -> rightVertex x * rightVertex y == rightVertex x + rightVertex y putStrLn "\n============ Bipartite.AdjacencyMap.leftAdjacencyMap ============" test "leftAdjacencyMap empty == Map.empty" $ leftAdjacencyMap empty == Map.empty test "leftAdjacencyMap (leftVertex x) == Map.singleton x Set.empty" $ \x -> leftAdjacencyMap (leftVertex x) == Map.singleton x Set.empty test "leftAdjacencyMap (rightVertex x) == Map.empty" $ \x -> leftAdjacencyMap (rightVertex x) == Map.empty test "leftAdjacencyMap (edge x y) == Map.singleton x (Set.singleton y)" $ \x y -> leftAdjacencyMap (edge x y) == Map.singleton x (Set.singleton y) putStrLn "\n============ Bipartite.AdjacencyMap.rightAdjacencyMap ============" test "rightAdjacencyMap empty == Map.empty" $ rightAdjacencyMap empty == Map.empty test "rightAdjacencyMap (leftVertex x) == Map.empty" $ \x -> rightAdjacencyMap (leftVertex x) == Map.empty test "rightAdjacencyMap (rightVertex x) == Map.singleton x Set.empty" $ \x -> rightAdjacencyMap (rightVertex x) == Map.singleton x Set.empty test "rightAdjacencyMap (edge x y) == Map.singleton y (Set.singleton x)" $ \x y -> rightAdjacencyMap (edge x y) == Map.singleton y (Set.singleton x) putStrLn "\n============ Bipartite.AdjacencyMap.empty ============" test "isEmpty empty == True" $ isEmpty empty == True test "leftAdjacencyMap empty == Map.empty" $ leftAdjacencyMap empty == Map.empty test "rightAdjacencyMap empty == Map.empty" $ rightAdjacencyMap empty == Map.empty test "hasVertex x empty == False" $ \x -> hasVertex x empty == False putStrLn "\n============ Bipartite.AdjacencyMap.leftVertex ============" test "leftAdjacencyMap (leftVertex x) == Map.singleton x Set.empty" $ \x -> leftAdjacencyMap (leftVertex x) == Map.singleton x Set.empty test "rightAdjacencyMap (leftVertex x) == Map.empty" $ \x -> rightAdjacencyMap (leftVertex x) == Map.empty test "hasLeftVertex x (leftVertex y) == (x == y)" $ \x y -> hasLeftVertex x (leftVertex y) == (x == y) test "hasRightVertex x (leftVertex y) == False" $ \x y -> hasRightVertex x (leftVertex y) == False test "hasEdge x y (leftVertex z) == False" $ \x y z -> hasEdge x y (leftVertex z) == False putStrLn "\n============ Bipartite.AdjacencyMap.rightVertex ============" test "leftAdjacencyMap (rightVertex x) == Map.empty" $ \x -> leftAdjacencyMap (rightVertex x) == Map.empty test "rightAdjacencyMap (rightVertex x) == Map.singleton x Set.empty" $ \x -> rightAdjacencyMap (rightVertex x) == Map.singleton x Set.empty test "hasLeftVertex x (rightVertex y) == False" $ \x y -> hasLeftVertex x (rightVertex y) == False test "hasRightVertex x (rightVertex y) == (x == y)" $ \x y -> hasRightVertex x (rightVertex y) == (x == y) test "hasEdge x y (rightVertex z) == False" $ \x y z -> hasEdge x y (rightVertex z) == False putStrLn "\n============ Bipartite.AdjacencyMap.vertex ============" test "vertex . Left == leftVertex" $ \x -> (vertex . Left) x == leftVertex x test "vertex . Right == rightVertex" $ \x -> (vertex . Right) x == rightVertex x putStrLn "\n============ Bipartite.AdjacencyMap.edge ============" test "edge x y == connect (leftVertex x) (rightVertex y)" $ \x y -> edge x y == connect (leftVertex x) (rightVertex y) test "leftAdjacencyMap (edge x y) == Map.singleton x (Set.singleton y)" $ \x y -> leftAdjacencyMap (edge x y) == Map.singleton x (Set.singleton y) test "rightAdjacencyMap (edge x y) == Map.singleton y (Set.singleton x)" $ \x y -> rightAdjacencyMap (edge x y) == Map.singleton y (Set.singleton x) test "hasEdge x y (edge x y) == True" $ \x y -> hasEdge x y (edge x y) == True test "hasEdge 1 2 (edge 2 1) == False" $ hasEdge 1 2 (edge 2 1) == False putStrLn "\n============ Bipartite.AdjacencyMap.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 putStrLn "\n============ Bipartite.AdjacencyMap.connect ============" test "connect (leftVertex x) (leftVertex y) == vertices [x,y] []" $ \x y -> connect (leftVertex x) (leftVertex y) == vertices [x,y] [] test "connect (leftVertex x) (rightVertex y) == edge x y" $ \x y -> connect (leftVertex x) (rightVertex y) == edge x y test "connect (rightVertex x) (leftVertex y) == edge y x" $ \x y -> connect (rightVertex x) (leftVertex y) == edge y x test "connect (rightVertex x) (rightVertex y) == vertices [] [x,y]" $ \x y -> connect (rightVertex x) (rightVertex y) == vertices [] [x,y] test "connect (vertices xs1 ys1) (vertices xs2 ys2) == overlay (biclique xs1 ys2) (biclique xs2 ys1)" $ \xs1 ys1 xs2 ys2 -> connect (vertices xs1 ys1) (vertices xs2 ys2) == overlay (biclique xs1 ys2) (biclique xs2 ys1) 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) >= leftVertexCount x * rightVertexCount y" $ \x y -> edgeCount (connect x y) >= leftVertexCount x * rightVertexCount y test "edgeCount (connect x y) <= leftVertexCount x * rightVertexCount y + rightVertexCount x * leftVertexCount y + edgeCount x + edgeCount y" $ \x y -> edgeCount (connect x y) <= leftVertexCount x * rightVertexCount y + rightVertexCount x * leftVertexCount y + edgeCount x + edgeCount y putStrLn "\n============ Bipartite.AdjacencyMap.vertices ============" test "vertices [] [] == empty" $ vertices [] [] == empty test "vertices [x] [] == leftVertex x" $ \x -> vertices [x] [] == leftVertex x test "vertices [] [x] == rightVertex x" $ \x -> vertices [] [x] == rightVertex x test "vertices xs ys == overlays (map leftVertex xs ++ map rightVertex ys)" $ \xs ys -> vertices xs ys == overlays (map leftVertex xs ++ map rightVertex ys) test "hasLeftVertex x (vertices xs ys) == elem x xs" $ \x xs ys -> hasLeftVertex x (vertices xs ys) == elem x xs test "hasRightVertex y (vertices xs ys) == elem y ys" $ \y xs ys -> hasRightVertex y (vertices xs ys) == elem y ys putStrLn "\n============ Bipartite.AdjacencyMap.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 "hasEdge x y . edges == elem (x,y)" $ \x y es -> (hasEdge x y . edges) es == elem (x,y) es test "edgeCount . edges == length . nub" $ \es -> (edgeCount . edges) es == (length . nubOrd) es putStrLn "\n============ Bipartite.AdjacencyMap.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 putStrLn "\n============ Bipartite.AdjacencyMap.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 putStrLn "\n============ Bipartite.AdjacencyMap.swap ============" test "swap empty == empty" $ swap empty == empty test "swap . leftVertex == rightVertex" $ \x -> (swap . leftVertex) x == rightVertex x test "swap (vertices xs ys) == vertices ys xs" $ \xs ys -> swap (vertices xs ys) == vertices ys xs test "swap (edge x y) == edge y x" $ \x y -> swap (edge x y) == edge y x test "swap . edges == edges . map Data.Tuple.swap" $ \es -> (swap . edges) es == (edges . map Data.Tuple.swap) es test "swap . swap == id" $ \x -> (swap . swap) x == x putStrLn "\n============ Bipartite.AdjacencyMap.toBipartite ============" test "toBipartite empty == empty" $ toBipartite AM.empty == empty test "toBipartite (vertex (Left x)) == leftVertex x" $ \x -> toBipartite (AM.vertex (Left x)) == leftVertex x test "toBipartite (vertex (Right x)) == rightVertex x" $ \x -> toBipartite (AM.vertex (Right x)) == rightVertex x test "toBipartite (edge (Left x) (Left y)) == vertices [x,y] []" $ \x y -> toBipartite (AM.edge (Left x) (Left y)) == vertices [x,y] [] test "toBipartite (edge (Left x) (Right y)) == edge x y" $ \x y -> toBipartite (AM.edge (Left x) (Right y)) == edge x y test "toBipartite (edge (Right x) (Left y)) == edge y x" $ \x y -> toBipartite (AM.edge (Right x) (Left y)) == edge y x test "toBipartite (edge (Right x) (Right y)) == vertices [] [x,y]" $ \x y -> toBipartite (AM.edge (Right x) (Right y)) == vertices [] [x,y] test "toBipartite . clique == uncurry biclique . partitionEithers" $ \xs -> (toBipartite . AM.clique) xs == (uncurry biclique . partitionEithers) xs test "toBipartite . fromBipartite == id" $ \x -> (toBipartite . fromBipartite) x == x putStrLn "\n============ Bipartite.AdjacencyMap.toBipartiteWith ============" test "toBipartiteWith f empty == empty" $ \(apply -> f) -> toBipartiteWith f (AM.empty :: AII) == empty test "toBipartiteWith Left x == vertices (vertexList x) []" $ \x -> toBipartiteWith Left x == vertices (AM.vertexList x) [] test "toBipartiteWith Right x == vertices [] (vertexList x)" $ \x -> toBipartiteWith Right x == vertices [] (AM.vertexList x) test "toBipartiteWith f == toBipartite . gmap f" $ \(apply -> f) x -> toBipartiteWith f x == (toBipartite . AM.gmap f) (x :: AII) test "toBipartiteWith id == toBipartite" $ \x -> toBipartiteWith id x == toBipartite x putStrLn "\n============ Bipartite.AdjacencyMap.fromBipartite ============" test "fromBipartite empty == empty" $ fromBipartite empty == AM.empty test "fromBipartite (leftVertex x) == vertex (Left x)" $ \x -> fromBipartite (leftVertex x) == AM.vertex (Left x) test "fromBipartite (edge x y) == edges [(Left x, Right y), (Right y, Left x)]" $ \x y -> fromBipartite (edge x y) == AM.edges [(Left x, Right y), (Right y, Left x)] putStrLn "\n============ Bipartite.AdjacencyMap.fromBipartiteWith ============" test "fromBipartiteWith Left Right == fromBipartite" $ \x -> fromBipartiteWith Left Right x == fromBipartite x test "fromBipartiteWith id id (vertices xs ys) == vertices (xs ++ ys)" $ \xs ys -> fromBipartiteWith id id (vertices xs ys) == AM.vertices (xs ++ ys) test "fromBipartiteWith id id . edges == symmetricClosure . edges" $ \xs -> (fromBipartiteWith id id . edges) xs == (AM.symmetricClosure . AM.edges) xs putStrLn "\n============ Bipartite.AdjacencyMap.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 == (==) empty" $ \x -> isEmpty x == (==) empty x putStrLn "\n============ Bipartite.AdjacencyMap.hasLeftVertex ============" test "hasLeftVertex x empty == False" $ \x -> hasLeftVertex x empty == False test "hasLeftVertex x (leftVertex y) == (x == y)" $ \x y -> hasLeftVertex x (leftVertex y) == (x == y) test "hasLeftVertex x (rightVertex y) == False" $ \x y -> hasLeftVertex x (rightVertex y) == False putStrLn "\n============ Bipartite.AdjacencyMap.hasRightVertex ============" test "hasRightVertex x empty == False" $ \x -> hasRightVertex x empty == False test "hasRightVertex x (leftVertex y) == False" $ \x y -> hasRightVertex x (leftVertex y) == False test "hasRightVertex x (rightVertex y) == (x == y)" $ \x y -> hasRightVertex x (rightVertex y) == (x == y) putStrLn "\n============ Bipartite.AdjacencyMap.hasVertex ============" test "hasVertex . Left == hasLeftVertex" $ \x y -> (hasVertex . Left) x y == hasLeftVertex x y test "hasVertex . Right == hasRightVertex" $ \x y -> (hasVertex . Right) x y == hasRightVertex x y putStrLn "\n============ Bipartite.AdjacencyMap.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 == 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 putStrLn "\n============ Bipartite.AdjacencyMap.leftVertexCount ============" test "leftVertexCount empty == 0" $ leftVertexCount empty == 0 test "leftVertexCount (leftVertex x) == 1" $ \x -> leftVertexCount (leftVertex x) == 1 test "leftVertexCount (rightVertex x) == 0" $ \x -> leftVertexCount (rightVertex x) == 0 test "leftVertexCount (edge x y) == 1" $ \x y -> leftVertexCount (edge x y) == 1 test "leftVertexCount . edges == length . nub . map fst" $ \xs -> (leftVertexCount . edges) xs == (length . nub . map fst) xs putStrLn "\n============ Bipartite.AdjacencyMap.rightVertexCount ============" test "rightVertexCount empty == 0" $ rightVertexCount empty == 0 test "rightVertexCount (leftVertex x) == 0" $ \x -> rightVertexCount (leftVertex x) == 0 test "rightVertexCount (rightVertex x) == 1" $ \x -> rightVertexCount (rightVertex x) == 1 test "rightVertexCount (edge x y) == 1" $ \x y -> rightVertexCount (edge x y) == 1 test "rightVertexCount . edges == length . nub . map snd" $ \xs -> (rightVertexCount . edges) xs == (length . nub . map snd) xs putStrLn "\n============ Bipartite.AdjacencyMap.vertexCount ============" test "vertexCount empty == 0" $ vertexCount empty == 0 test "vertexCount (vertex x) == 1" $ \x -> vertexCount (vertex x) == 1 test "vertexCount (edge x y) == 2" $ \x y -> vertexCount (edge x y) == 2 test "vertexCount x == leftVertexCount x + rightVertexCount x" $ \x -> vertexCount x == leftVertexCount x + rightVertexCount x putStrLn "\n============ Bipartite.AdjacencyMap.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 . edges == length . nub" $ \xs -> (edgeCount . edges) xs == (length . nubOrd) xs putStrLn "\n============ Bipartite.AdjacencyMap.leftVertexList ============" test "leftVertexList empty == []" $ leftVertexList empty == [] test "leftVertexList (leftVertex x) == [x]" $ \x -> leftVertexList (leftVertex x) == [x] test "leftVertexList (rightVertex x) == []" $ \x -> leftVertexList (rightVertex x) == [] test "leftVertexList . flip vertices [] == nub . sort" $ \xs -> (leftVertexList . flip vertices []) xs == (nubOrd . sort) xs putStrLn "\n============ Bipartite.AdjacencyMap.rightVertexList ============" test "rightVertexList empty == []" $ rightVertexList empty == [] test "rightVertexList (leftVertex x) == []" $ \x -> rightVertexList (leftVertex x) == [] test "rightVertexList (rightVertex x) == [x]" $ \x -> rightVertexList (rightVertex x) == [x] test "rightVertexList . vertices [] == nub . sort" $ \xs -> (rightVertexList . vertices []) xs == (nubOrd . sort) xs putStrLn "\n============ Bipartite.AdjacencyMap.vertexList ============" test "vertexList empty == []" $ vertexList empty == [] test "vertexList (vertex x) == [x]" $ \x -> vertexList (vertex x) == [x] test "vertexList (edge x y) == [Left x, Right y]" $ \x y -> vertexList (edge x y) == [Left x, Right y] test "vertexList (vertices (lefts xs) (rights xs)) == nub (sort xs)" $ \xs -> vertexList (vertices (lefts xs) (rights xs)) == nubOrd (sort xs) putStrLn "\n============ Bipartite.AdjacencyMap.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 . edges == nub . sort" $ \xs -> (edgeList . edges) xs == (nubOrd . sort) xs putStrLn "\n============ Bipartite.AdjacencyMap.leftVertexSet ============" test "leftVertexSet empty == Set.empty" $ leftVertexSet empty == Set.empty test "leftVertexSet . leftVertex == Set.singleton" $ \x -> (leftVertexSet . leftVertex) x == Set.singleton x test "leftVertexSet . rightVertex == const Set.empty" $ \x -> (leftVertexSet . rightVertex) x == const Set.empty x test "leftVertexSet . flip vertices [] == Set.fromList" $ \xs -> (leftVertexSet . flip vertices []) xs == Set.fromList xs putStrLn "\n============ Bipartite.AdjacencyMap.rightVertexSet ============" test "rightVertexSet empty == Set.empty" $ rightVertexSet empty == Set.empty test "rightVertexSet . leftVertex == const Set.empty" $ \x -> (rightVertexSet . leftVertex) x == const Set.empty x test "rightVertexSet . rightVertex == Set.singleton" $ \x -> (rightVertexSet . rightVertex) x == Set.singleton x test "rightVertexSet . vertices [] == Set.fromList" $ \xs -> (rightVertexSet . vertices []) xs == Set.fromList xs putStrLn "\n============ Bipartite.AdjacencyMap.vertexSet ============" test "vertexSet empty == Set.empty" $ vertexSet empty == Set.empty test "vertexSet . vertex == Set.singleton" $ \x -> (vertexSet . vertex) x == Set.singleton x test "vertexSet (edge x y) == Set.fromList [Left x, Right y]" $ \x y -> vertexSet (edge x y) == Set.fromList [Left x, Right y] test "vertexSet (vertices (lefts xs) (rights xs)) == Set.fromList xs" $ \xs -> vertexSet (vertices (lefts xs) (rights xs)) == Set.fromList xs putStrLn "\n============ Bipartite.AdjacencyMap.edgeSet ============" test "edgeSet empty == Set.empty" $ edgeSet empty == Set.empty test "edgeSet (vertex x) == Set.empty" $ \x -> edgeSet (vertex x) == Set.empty test "edgeSet (edge x y) == Set.singleton (x,y)" $ \x y -> edgeSet (edge x y) == Set.singleton (x,y) test "edgeSet . edges == Set.fromList" $ \xs -> (edgeSet . edges) xs == Set.fromList xs putStrLn "\n============ Bipartite.AdjacencyMap.leftAdjacencyList ============" test "leftAdjacencyList empty == []" $ leftAdjacencyList empty == [] test "leftAdjacencyList (vertices [] xs) == []" $ \xs -> leftAdjacencyList (vertices [] xs) == [] test "leftAdjacencyList (vertices xs []) == []" $ \xs -> leftAdjacencyList (vertices xs []) == [(x, []) | x <- nubOrd (sort xs)] test "leftAdjacencyList (edge x y) == [(x, [y])]" $ \x y -> leftAdjacencyList (edge x y) == [(x, [y])] test "leftAdjacencyList (star x ys) == [(x, nub (sort ys))]" $ \x ys -> leftAdjacencyList (star x ys) == [(x, nubOrd (sort ys))] putStrLn "\n============ Bipartite.AdjacencyMap.rightAdjacencyList ============" test "rightAdjacencyList empty == []" $ rightAdjacencyList empty == [] test "rightAdjacencyList (vertices [] xs) == [(x, []) | x <- nub (sort xs)]" $ \xs -> rightAdjacencyList (vertices [] xs) == [(x, []) | x <- nubOrd (sort xs)] test "rightAdjacencyList (vertices xs []) == []" $ \xs -> rightAdjacencyList (vertices xs []) == [] test "rightAdjacencyList (edge x y) == [(y, [x])]" $ \x y -> rightAdjacencyList (edge x y) == [(y, [x])] test "rightAdjacencyList (star x ys) == [(y, [x]) | y <- nub (sort ys)]" $ \x ys -> rightAdjacencyList (star x ys) == [(y, [x]) | y <- nubOrd (sort ys)] putStrLn "\n============ Bipartite.AdjacencyMap.evenList ============" test "evenList [] == Nil" $ evenList [] == Nil @Int @Int test "evenList [(1,2), (3,4)] == [1, 2, 3, 4] :: List Int Int" $ evenList [(1,2), (3,4)] == ([1, 2, 3, 4] :: List Int Int) test "evenList [(1,'a'), (2,'b')] == Cons 1 (Cons 'a' (Cons 2 (Cons 'b' Nil)))" $ evenList [(1,'a'), (2 :: Int,'b')] == Cons 1 (Cons 'a' (Cons 2 (Cons 'b' Nil))) putStrLn "\n============ Bipartite.AdjacencyMap.oddList ============" test "oddList 1 [] == Cons 1 Nil" $ oddList 1 [] == Cons 1 (Nil @Int @Int) test "oddList 1 [(2,3), (4,5)] == [1, 2, 3, 4, 5] :: List Int Int" $ oddList 1 [(2,3), (4,5)] ==([1, 2, 3, 4, 5] :: List Int Int) test "oddList 1 [('a',2), ('b',3)] == Cons 1 (Cons 'a' (Cons 2 (Cons 'b' (Cons 3 Nil))))" $ oddList 1 [('a',2), ('b',3)] == Cons 1 (Cons 'a' (Cons 2 (Cons 'b' (Cons @Int 3 Nil)))) putStrLn "\n============ Bipartite.AdjacencyMap.path ============" test "path Nil == empty" $ path Nil == empty test "path (Cons x Nil) == leftVertex x" $ \x -> path (Cons x Nil) == leftVertex x test "path (Cons x (Cons y Nil)) == edge x y" $ \x y -> path (Cons x (Cons y Nil)) == edge x y test "path [1, 2, 3, 4, 5] == edges [(1,2), (3,2), (3,4), (5,4)]" $ path [1, 2, 3, 4, 5] == edges [(1,2), (3,2), (3,4), (5,4)] putStrLn "\n============ Bipartite.AdjacencyMap.circuit ============" test "circuit [] == empty" $ circuit [] == empty test "circuit [(x,y)] == edge x y" $ \x y -> circuit [(x,y)] == edge x y test "circuit [(1,2), (3,4), (5,6)] == edges [(1,2), (3,2), (3,4), (5,4), (5,6), (1,6)]" $ circuit [(1,2), (3,4), (5,6)] == edges [(1,2), (3,2), (3,4), (5,4), (5,6), (1,6)] test "circuit . reverse == swap . circuit . map Data.Tuple.swap" $ \xs -> (circuit . reverse) xs == (swap . circuit . map Data.Tuple.swap) xs putStrLn "\n============ Bipartite.AdjacencyMap.biclique ============" test "biclique [] [] == empty" $ biclique [] [] == empty test "biclique xs [] == vertices xs []" $ \xs -> biclique xs [] == vertices xs [] test "biclique [] ys == vertices [] ys" $ \ys -> biclique [] ys == vertices [] ys test "biclique xs ys == connect (vertices xs []) (vertices [] ys)" $ \xs ys -> biclique xs ys == connect (vertices xs []) (vertices [] ys) putStrLn "\n============ Bipartite.AdjacencyMap.star ============" test "star x [] == leftVertex x" $ \x -> star x [] == leftVertex 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 (leftVertex x) (vertices [] ys)" $ \x ys -> star x ys == connect (leftVertex x) (vertices [] ys) putStrLn "\n============ Bipartite.AdjacencyMap.stars ============" test "stars [] == empty" $ stars [] == empty test "stars [(x, [])] == leftVertex x" $ \x -> stars [(x, [])] == leftVertex 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 "star x [y,z] == edges [(x,y), (x,z)]" $ \x y z -> star x [y,z] == edges [(x,y), (x,z)] test "stars == overlays . map (uncurry star)" $ \xs -> stars xs == (overlays . map (uncurry star)) xs test "overlay (stars xs) (stars ys) == stars (xs ++ ys)" $ \xs ys -> overlay (stars xs) (stars ys) == stars (xs ++ ys) putStrLn "\n============ Bipartite.AdjacencyMap.mesh ============" test "mesh xs [] == empty" $ \xs -> mesh xs [] == B.empty @(Int,Int) test "mesh [] ys == empty" $ \ys -> mesh [] ys == B.empty @(Int,Int) test "mesh [x] [y] == leftVertex (x,y)" $ \x y -> mesh [x] [y] == B.leftVertex @(Int,Int) (x,y) test "mesh [1,1] ['a','b'] == biclique [(1,'a'), (1,'b')] [(1,'a'), (1,'b')]" $ mesh [1,1] ['a','b'] == B.biclique @(Int,Char) [(1,'a'), (1,'b')] [(1,'a'), (1,'b')] test "mesh [1,2] ['a','b'] == biclique [(1,'a'), (2,'b')] [(1,'b'), (2,'a')]" $ mesh [1,2] ['a','b'] == B.biclique @(Int,Char) [(1,'a'), (2,'b')] [(1,'b'), (2,'a')] putStrLn "\n============ Bipartite.AdjacencyMap.removeLeftVertex ============" test "removeLeftVertex x (leftVertex x) == empty" $ \x -> removeLeftVertex x (leftVertex x) == empty test "removeLeftVertex 1 (leftVertex 2) == leftVertex 2" $ removeLeftVertex 1 (leftVertex 2) ==(leftVertex 2 :: BAII) test "removeLeftVertex x (rightVertex y) == rightVertex y" $ \x y -> removeLeftVertex x (rightVertex y) == rightVertex y test "removeLeftVertex x (edge x y) == rightVertex y" $ \x y -> removeLeftVertex x (edge x y) == rightVertex y test "removeLeftVertex x . removeLeftVertex x == removeLeftVertex x" $ \x (g :: BAII)-> (removeLeftVertex x . removeLeftVertex x) g == removeLeftVertex x g putStrLn "\n============ Bipartite.AdjacencyMap.removeRightVertex ============" test "removeRightVertex x (rightVertex x) == empty" $ \x -> removeRightVertex x (rightVertex x) == empty test "removeRightVertex 1 (rightVertex 2) == rightVertex 2" $ removeRightVertex 1 (rightVertex 2) ==(rightVertex 2 :: BAII) test "removeRightVertex x (leftVertex y) == leftVertex y" $ \x y -> removeRightVertex x (leftVertex y) == leftVertex y test "removeRightVertex y (edge x y) == leftVertex x" $ \x y -> removeRightVertex y (edge x y) == leftVertex x test "removeRightVertex x . removeRightVertex x == removeRightVertex x" $ \x (y :: BAII)-> (removeRightVertex x . removeRightVertex x) y == removeRightVertex x y putStrLn "\n============ Bipartite.AdjacencyMap.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 . removeLeftVertex x == removeLeftVertex x" $ \x y z -> (removeEdge x y . removeLeftVertex x) z == removeLeftVertex x z test "removeEdge x y . removeRightVertex y == removeRightVertex y" $ \x y z -> (removeEdge x y . removeRightVertex y) z == removeRightVertex y z putStrLn "\n============ Bipartite.AdjacencyMap.bimap ============" test "bimap f g empty == empty" $ \(apply -> f) (apply -> g) -> bimap f g empty == empty test "bimap f g . vertex == vertex . Data.Bifunctor.bimap f g" $ \(apply -> f) (apply -> g) x -> (bimap f g . vertex) x ==(vertex . Bifunctor.bimap f g) x test "bimap f g (edge x y) == edge (f x) (g y)" $ \(apply -> f) (apply -> g) x y -> bimap f g (edge x y) == edge (f x) (g y) test "bimap id id == id" $ \(x :: BAII) -> bimap id id x == id x test "bimap f1 g1 . bimap f2 g2 == bimap (f1 . f2) (g1 . g2)" $ \(apply -> f1 :: Int -> Int) (apply -> g1 :: Int -> Int) (apply -> f2 :: Int -> Int) (apply -> g2 :: Int -> Int) x -> (bimap f1 g1 . bimap f2 g2) x == bimap (f1 . f2) (g1 . g2) x putStrLn "\n============ Bipartite.AdjacencyMap.box ============" test "box (path [0,1]) (path ['a','b']) == " $ box (path [0,1]) (path ['a','b']) == B.edges @(Int,Char) [ ((0,'a'), (0,'b')) , ((0,'a'), (1,'a')) , ((1,'b'), (0,'b')) , ((1,'b'), (1,'a')) ] let unit x = (x, ()) biunit = B.bimap unit unit comm (x, y) = (y, x) bicomm = B.bimap comm comm assoc ((x, y), z) = (x, (y, z)) biassoc = B.bimap assoc assoc putStrLn "" test "box x y ~~ box y x" $ size10 $ \(x :: BAII) (y :: BAII) -> box x y == bicomm (box y x) test "box x (box y z) ~~ box (box x y) z" $ size10 $ \(x :: BAII) (y :: BAII) (z :: BAII) -> box x (box y z) == biassoc (box (box x y) z) test "box x (box y z) ~~ box (box x y) z" $ mapSize (min 3) $ \(x :: BAII) (y :: BAII) (z :: BAII) -> box x (box y z) == biassoc (box (box x y) z) test "box x (leftVertex ()) ~~ x" $ size10 $ \(x :: BAII) -> box x (B.leftVertex ()) == biunit x test "box x (rightVertex ()) ~~ swap x" $ size10 $ \(x :: BAII) -> box x (B.rightVertex ()) == biunit (B.swap x) test "box x empty ~~ empty" $ size10 $ \(x :: BAII) -> box x B.empty == biunit empty test "vertexCount (box x y) <= vertexCount x * vertexCount y" $ size10 $ \(x :: BAII) (y :: BAII) -> B.vertexCount (box x y) <= vertexCount x * vertexCount y test "edgeCount (box x y) <= vertexCount x * edgeCount y + edgeCount x * vertexCount y" $ size10 $ \(x :: BAII) (y :: BAII) -> B.edgeCount (box x y) <= vertexCount x * edgeCount y + edgeCount x * vertexCount y putStrLn "" test "box == boxWith (,) (,) (,) (,)" $ size10 $ \(x :: BAII) (y :: BAII) -> box x y == boxWith (,) (,) (,) (,) x y putStrLn "\n============ Bipartite.AdjacencyMap.consistent ============" test "consistent empty == True" $ consistent empty == True test "consistent (vertex x) == True" $ \x -> consistent (vertex x) == True test "consistent (edge x y) == True" $ \x y -> consistent (edge x y) == True test "consistent (edges x) == True" $ \x -> consistent (edges x) == True test "consistent (toBipartite x) == True" $ \x -> consistent (toBipartite x) == True test "consistent (swap x) == True" $ \x -> consistent (swap x) == True test "consistent (circuit xs) == True" $ \xs -> consistent (circuit xs) == True test "consistent (biclique xs ys) == True" $ \xs ys -> consistent (biclique xs ys) == True testBipartiteAdjacencyMapAlgorithm :: IO () testBipartiteAdjacencyMapAlgorithm = do putStrLn "\n============ Bipartite.AdjacencyMap.Algorithm.detectParts ============" test "detectParts empty == Right empty" $ detectParts (AM.empty :: AI) == Right empty test "detectParts (vertex 1) == Right (leftVertex 1)" $ detectParts (AM.vertex 1 :: AI) == Right (leftVertex 1) test "detectParts (edge 1 1) == Left [1]" $ detectParts (AM.edge 1 1 :: AI) == Left [1] test "detectParts (edge 1 2) == Right (edge 1 2)" $ detectParts (AM.edge 1 2 :: AI) == Right (edge 1 2) test "detectParts (edge 0 (-1)) == Right (edge (-1) 0)" $ detectParts (AM.edge 0 (-1) :: AI) == Right (edge (-1) 0) test "detectParts (1 * (2 + 3)) == Right (edges [(1, 2), (1, 3)])" $ detectParts (1 * (2 + 3) :: AI) == Right (edges [(1, 2), (1, 3)]) test "detectParts ((1 + 3) * (2 + 4) + 6 * 5) == Right (swap (1 + 3) * (2 + 4) + swap 5 * 6" $ detectParts ((1 + 3) * (2 + 4) + 6 * 5 :: AI) == Right (swap (1 + 3) * (2 * 4) + swap 5 * 6) test "detectParts ((1 + 2) * (3 + 4) * (5 + 6)) == Left [1, 3, 2, 4, 5]" $ detectParts ((1 + 2) * (3 + 4) * (5 + 6) :: AI) == Left [1, 3, 2, 4, 5] test "detectParts ((1 + 2) * (3 + 4) + (3 + 4) * 5) == Right (swap (1 + 2) * (3 + 4) + swap 5 * (3 + 4))" $ detectParts ((1 + 2) * (3 + 4) + (3 + 4) * 5 :: AI) == Right (swap (1 + 2) * (3 + 4) + swap 5 * (3 + 4)) test "detectParts (1 * 2 * 3) == Left [2, 3, 1]" $ detectParts (1 * 2 * 3 :: AI) == Left [1, 2, 3] test "detectParts ((1 * 3 * 4) + 2 * (1 + 2)) == Left [2]" $ detectParts ((1 * 3 * 4) + 2 * (1 + 2) :: AI) == Left [2] test "detectParts (clique [1..10]) == Left [1, 2, 3]" $ detectParts (AM.clique [1..10] :: AI) == Left [1, 2, 3] test "detectParts (circuit [1..11]) == Left [1..11]" $ detectParts (AM.circuit [1..11] :: AI) == Left [1..11] test "detectParts (circuit [1..10]) == Right (circuit [(2 * x - 1, 2 * x) | x <- [1..5]])" $ detectParts (AM.circuit [1..10] :: AI) == Right (circuit [(2 * x - 1, 2 * x) | x <- [1..5]]) test "detectParts (biclique [] xs) == Right (vertices xs [])" $ \(xs :: [Int]) -> detectParts (AM.biclique [] xs :: AI) == Right (vertices xs []) test "detectParts (biclique (map Left (x:xs)) (map Right ys)) == Right (biclique (map Left (x:xs)) (map Right ys))" $ \(x :: Int) (xs :: [Int]) (ys :: [Int]) -> detectParts (AM.biclique (map Left (x:xs)) (map Right ys)) == Right (biclique (map Left (x:xs)) (map Right ys)) test "isRight (detectParts (star x ys)) == not (elem x ys)" $ \(x :: Int) (ys :: [Int]) -> isRight (detectParts (AM.star x ys)) == (not $ elem x ys) test "isRight (detectParts (fromBipartite (toBipartite x))) == True" $ \(x :: AII) -> isRight (detectParts (fromBipartite (toBipartite x))) == True -- TODO: Clean up these tests putStrLn "" test "((all ((flip Set.member) $ edgeSet $ symmetricClosure x) . edgeSet) <$> detectParts x) /= Right False" $ \(x :: AI) -> ((all ((flip Set.member) $ AM.edgeSet $ AM.symmetricClosure x) . edgeSet) <$> detectParts x) /= Right False test "(Set.map $ fromEither) <$> (vertexSet <$> (detectParts (fromBipartite (toBipartite x)))) == Right (vertexSet x)" $ \(x :: AII) -> ((Set.map $ fromEither) <$> (vertexSet <$> (detectParts (fromBipartite (toBipartite x))))) == Right (AM.vertexSet x) test "fromEither (Bifunctor.bimap ((flip Set.isSubsetOf) (vertexSet x) . Set.fromList) (const True) (detectParts x)) == True" $ \(x :: AI) -> fromEither (Bifunctor.bimap ((flip Set.isSubsetOf) (AM.vertexSet x) . Set.fromList) (const True) (detectParts x)) test "fromEither (Bifunctor.bimap ((flip Set.isSubsetOf) (edgeSet (symmetricClosure x)) . AM.edgeSet . circuit) (const True) (detectParts x)) == True" $ \(x :: AI) -> fromEither (Bifunctor.bimap ((flip Set.isSubsetOf) (AM.edgeSet (AM.symmetricClosure x)) . AM.edgeSet . AM.circuit) (const True) (detectParts x)) test "fromEither (Bifunctor.bimap (((==) 1) . ((flip mod) 2) . length) (const True) (detectParts x)) == True" $ \(x :: AI) -> fromEither (Bifunctor.bimap (((==) 1) . ((flip mod) 2) . length) (const True) (detectParts x)) putStrLn "\n============ Show (Bipartite.AdjacencyMap.Algorithm.Matching a b) ============" test "show (matching []) == \"matching []\"" $ show (matching [] :: MII) == "matching []" test "show (matching [(2,'a'),(1,'b')]) == \"matching [(1,'b'),(2,'a')]\"" $ show (matching [(2,'a'),(1,'b')] :: MIC) == "matching [(1,'b'),(2,'a')]" putStrLn "\n============ Eq (Bipartite.AdjacencyMap.Algorithm.Matching a b) ============" test "(x == y) == ((pairOfLeft x == pairOfLeft y) && (pairOfRight x == pairOfRight y))" $ \(x :: MII) (y :: MII) -> (x == y) == ((pairOfLeft x == pairOfLeft y) && (pairOfRight x == pairOfRight y)) putStrLn "\n============ Bipartite.AdjacencyMap.Algorithm.pairOfLeft ============" test "pairOfLeft (matching []) == Map.empty" $ pairOfLeft (matching [] :: MII) == Map.empty test "pairOfLeft (matching [(2,'a'), (1,'b')]) == Map.fromList [(2,'a'), (1,'b')]" $ pairOfLeft (matching [(2,'a'), (1,'b')] :: MIC) == Map.fromList [(2,'a'), (1,'b')] test "Map.size . pairOfLeft == Map.size . pairOfRight" $ \(x :: MII) -> (Map.size . pairOfLeft) x ==(Map.size . pairOfRight) x putStrLn "\n============ Bipartite.AdjacencyMap.Algorithm.pairOfRight ============" test "pairOfRight (matching []) == Map.empty" $ pairOfRight (matching [] :: MII) == Map.empty test "pairOfRight (matching [(2,'a'), (1,'b')]) == Map.fromList [('a',2), ('b',1)]" $ pairOfRight (matching [(2,'a'), (1,'b')] :: MIC) == Map.fromList [('a',2), ('b',1)] test "Map.size . pairOfRight == Map.size . pairOfLeft" $ \(x :: MII) -> (Map.size . pairOfRight) x ==(Map.size . pairOfLeft) x putStrLn "\n============ Bipartite.AdjacencyMap.Algorithm.matching ============" test "matching [(1,'a'), (1,'b')] == matching [(1,'b')]" $ matching [(1,'a'), (1,'b')] == (matching [(1,'b')] :: MIC) test "matching [(1,'a'), (1,'b'), (2,'b'), (2,'a')] == matching [(2,'a')]" $ matching [(1,'a'), (1,'b'), (2,'b'), (2,'a')] == (matching [(2,'a')] :: MIC) putStrLn "\n============ Bipartite.AdjacencyMap.Algorithm.isMatchingOf ============" test "isMatchingOf (matching []) x == True" $ \(x :: BAII) -> isMatchingOf (matching []) x == True test "isMatchingOf (matching xs) empty == null xs" $ \(xs :: [(Int, Int)]) -> isMatchingOf (matching xs) empty == null xs test "isMatchingOf (matching [(x,y)]) (edge x y) == True" $ \(x :: Int) (y :: Int) -> isMatchingOf (matching [(x,y)]) (edge x y) == True test "isMatchingOf (matching [(1,2)]) (edge 2 1) == False" $ isMatchingOf (matching [(1,2)]) (edge 2 1 :: BAII) == False putStrLn "\n============ Bipartite.AdjacencyMap.Algorithm.matchingSize ============" test "matchingSize (matching []) == 0" $ matchingSize (matching [] :: MII) == 0 test "matchingSize (matching [(2,'a'), (1,'b')]) == 2" $ matchingSize (matching [(2,'a'), (1,'b')] :: MIC) == 2 test "matchingSize (matching [(1,'a'), (1,'b')]) == 1" $ matchingSize (matching [(1,'a'), (1,'b')] :: MIC) == 1 test "matchingSize (matching xs) <= length xs" $ \(xs :: [(Int, Int)]) -> matchingSize (matching xs) <= length xs test "matchingSize x == Map.size . pairOfLeft" $ \(x :: MII) -> matchingSize x ==(Map.size . pairOfLeft) x putStrLn "\n============ Bipartite.AdjacencyMap.Algorithm.maxMatching ============" test "maxMatching empty == matching []" $ maxMatching (empty :: BAII) == matching [] test "maxMatching (vertices xs ys) == matching []" $ \(xs :: [Int]) (ys :: [Int]) -> maxMatching (vertices xs ys) == matching [] test "maxMatching (path [1,2,3,4]) == matching [(1,2), (3,4)]" $ maxMatching (path ([1,2,3,4] :: LII)) == matching [(1,2), (3,4)] test "matchingSize (maxMatching (circuit [(1,2), (3,4), (5,6)])) == 3" $ matchingSize (maxMatching (circuit [(1,2), (3,4), (5,6)] :: BAII)) == 3 test "matchingSize (maxMatching (star x (y:ys))) == 1" $ \(x :: Int) (y :: Int) (ys :: [Int]) -> matchingSize (maxMatching (star x (y:ys))) == 1 test "matchingSize (maxMatching (biclique xs ys)) == min (length (nub xs)) (length (nub ys))" $ \(xs :: [Int]) (ys :: [Int]) -> matchingSize (maxMatching (biclique xs ys)) == min (length (nub xs)) (length (nub ys)) test "isMatchingOf (maxMatching x) x == True" $ \(x :: BAII) -> isMatchingOf (maxMatching x) x == True putStrLn "\n============ Bipartite.AdjacencyMap.Algorithm.isVertexCoverOf ============" test "isVertexCoverOf (xs , ys ) empty == Set.null xs && Set.null ys" $ \(xs :: Set Int) (ys :: Set Int) -> isVertexCoverOf (xs , ys ) empty ==(Set.null xs && Set.null ys) test "isVertexCoverOf (xs , ys ) (leftVertex x) == Set.isSubsetOf xs (Set.singleton x) && Set.null ys" $ \(x :: Int) (xs :: Set Int) (ys :: Set Int) -> isVertexCoverOf (xs , ys ) (leftVertex x) ==(Set.isSubsetOf xs (Set.singleton x) && Set.null ys) test "isVertexCoverOf (Set.empty , Set.empty ) (edge x y) == False" $ \(x :: Int) (y :: Int) -> isVertexCoverOf (Set.empty , Set.empty ) (edge x y) == False test "isVertexCoverOf (Set.singleton x, ys ) (edge x y) == Set.isSubsetOf ys (Set.singleton y)" $ \(x :: Int) (y :: Int) (ys :: Set Int) -> isVertexCoverOf (Set.singleton x, ys ) (edge x y) == Set.isSubsetOf ys (Set.singleton y) test "isVertexCoverOf (xs , Set.singleton y) (edge x y) == Set.isSubsetOf xs (Set.singleton x)" $ \(x :: Int) (y :: Int) (xs :: Set Int) -> isVertexCoverOf (xs , Set.singleton y) (edge x y) == Set.isSubsetOf xs (Set.singleton x) putStrLn "\n============ Bipartite.AdjacencyMap.Algorithm.minVertexCover ============" test "minVertexCover empty == (Set.empty, Set.empty)" $ minVertexCover (empty :: BAII) == (Set.empty, Set.empty) test "minVertexCover (vertices xs ys) == (Set.empty, Set.empty)" $ \(xs :: [Int]) (ys :: [Int]) -> minVertexCover (vertices xs ys) == (Set.empty, Set.empty) test "minVertexCover (path [1,2,3]) == (Set.empty, Set.singleton 2)" $ minVertexCover (path [1,2,3] :: BAII) == (Set.empty, Set.singleton 2) test "minVertexCover (star x (1:2:ys)) == (Set.singleton x, Set.empty)" $ \(x :: Int) (ys :: [Int]) -> minVertexCover (star x (1:2:ys) :: BAII) == (Set.singleton x, Set.empty) test "vertexCoverSize (minVertexCover (biclique xs ys)) == min (length (nub xs)) (length (nub ys))" $ size10 $ \(xs :: [Int]) (ys :: [Int]) -> vertexCoverSize (minVertexCover (biclique xs ys)) == min (length (nub xs)) (length (nub ys)) test "vertexCoverSize . minVertexCover == matchingSize . maxMatching" $ \(x :: BAII) -> (vertexCoverSize . minVertexCover) x ==(matchingSize . maxMatching) x test "isVertexCoverOf (minVertexCover x) x == True" $ \(x :: BAII) -> isVertexCoverOf (minVertexCover x) x == True putStrLn "\n============ Bipartite.AdjacencyMap.Algorithm.isIndependentSetOf ============" test "isIndependentSetOf (xs , ys ) empty == Set.null xs && Set.null ys" $ \(xs :: Set Int) (ys :: Set Int) -> isIndependentSetOf (xs , ys ) empty ==(Set.null xs && Set.null ys) test "isIndependentSetOf (xs , ys ) (leftVertex x) == Set.isSubsetOf xs (Set.singleton x) && Set.null ys" $ \(x :: Int) (xs :: Set Int) (ys :: Set Int) -> isIndependentSetOf (xs , ys ) (leftVertex x) ==(Set.isSubsetOf xs (Set.singleton x) && Set.null ys) test "isIndependentSetOf (Set.empty , Set.empty ) (edge x y) == True" $ \(x :: Int) (y :: Int) -> isIndependentSetOf (Set.empty , Set.empty ) (edge x y) == True test "isIndependentSetOf (Set.singleton x, ys ) (edge x y) == Set.null ys" $ \(x :: Int) (y :: Int) (ys :: Set Int) -> isIndependentSetOf (Set.singleton x, ys ) (edge x y) == Set.null ys test "isIndependentSetOf (xs , Set.singleton y) (edge x y) == Set.null xs" $ \(x :: Int) (y :: Int) (xs :: Set Int) -> isIndependentSetOf (xs , Set.singleton y) (edge x y) == Set.null xs putStrLn "\n============ Bipartite.AdjacencyMap.Algorithm.maxIndependentSet ============" test "maxIndependentSet empty == (Set.empty, Set.empty)" $ maxIndependentSet (empty :: BAII) == (Set.empty, Set.empty) test "maxIndependentSet (vertices xs ys) == (Set.fromList xs, Set.fromList ys)" $ \(xs :: [Int]) (ys :: [Int]) -> maxIndependentSet (vertices xs ys) == (Set.fromList xs, Set.fromList ys) test "maxIndependentSet (path [1,2,3]) == (Set.fromList [1,3], Set.empty)" $ maxIndependentSet (path [1,2,3] :: BAII) == (Set.fromList [1,3], Set.empty) test "maxIndependentSet (star x (1:2:ys)) == (Set.empty, Set.fromList (1:2:ys))" $ \(x :: Int) (ys :: [Int]) -> maxIndependentSet (star x (1:2:ys)) == (Set.empty, Set.fromList (1:2:ys)) test "independentSetSize (maxIndependentSet (biclique xs ys)) == max (length (nub xs)) (length (nub ys))" $ \(xs :: [Int]) (ys :: [Int]) -> independentSetSize (maxIndependentSet (biclique xs ys)) == max (length (nub xs)) (length (nub ys)) test "independentSetSize (maxIndependentSet x) == vertexCount x - vertexCoverSize (minVertexCover x)" $ \(x :: BAII) -> independentSetSize (maxIndependentSet x) == vertexCount x - vertexCoverSize (minVertexCover x) test "isIndependentSetOf (maxIndependentSet x) x == True" $ \(x :: BAII) -> isIndependentSetOf (maxIndependentSet x) x == True putStrLn "\n============ Bipartite.AdjacencyMap.Algorithm.augmentingPath ============" test "augmentingPath (matching []) empty == Left (Set.empty, Set.empty)" $ augmentingPath (matching []) (empty :: BAII) == Left (Set.empty, Set.empty) test "augmentingPath (matching []) (edge 1 2) == Right [1,2]" $ augmentingPath (matching []) (edge 1 2) == Right ([1,2] :: LII) test "augmentingPath (matching [(1,2)]) (path [1,2,3]) == Left (Set.empty, Set.singleton 2)" $ augmentingPath (matching [(1,2)]) (path [1,2,3] :: BAII) == Left (Set.empty, Set.singleton 2) test "augmentingPath (matching [(3,2)]) (path [1,2,3,4]) == Right [1,2,3,4]" $ augmentingPath (matching [(3,2)]) (path [1,2,3,4]) == Right ([1,2,3,4] :: LII) test "isLeft (augmentingPath (maxMatching x) x) == True" $ \(x :: BAII) -> isLeft (augmentingPath (maxMatching x) x) == True putStrLn "\n============ Bipartite.AdjacencyMap.Algorithm.consistentMatching ============" test "consistentMatching (matching xs) == True" $ \(xs :: [(Int,Int)]) -> consistentMatching (matching xs) == True test "consistentMatching (maxMatching x) == True" $ \(x :: BAII) -> consistentMatching (maxMatching x) == True