1{-# LANGUAGE ViewPatterns #-} 2----------------------------------------------------------------------------- 3-- | 4-- Module : Algebra.Graph.Test.Bipartite.Undirected.AdjacencyMap 5-- Copyright : (c) Andrey Mokhov 2016-2020 6-- License : MIT (see the file LICENSE) 7-- Maintainer : andrey.mokhov@gmail.com 8-- Stability : experimental 9-- 10-- Testsuite for "Algebra.Graph.Bipartite.Undirected.AdjacencyMap". 11----------------------------------------------------------------------------- 12module Algebra.Graph.Test.Bipartite.Undirected.AdjacencyMap ( 13 -- * Testsuite 14 testBipartiteUndirectedAdjacencyMap 15 ) where 16 17import Algebra.Graph.Bipartite.Undirected.AdjacencyMap 18import Algebra.Graph.Test 19import Data.Either 20import Data.Either.Extra 21import Data.List 22import Data.Map.Strict (Map) 23import Data.Set (Set) 24 25import qualified Algebra.Graph.AdjacencyMap as AM 26import qualified Algebra.Graph.Bipartite.Undirected.AdjacencyMap as B 27import qualified Data.Map.Strict as Map 28import qualified Data.Set as Set 29import qualified Data.Tuple 30 31type AI = AM.AdjacencyMap Int 32type AII = AM.AdjacencyMap (Either Int Int) 33type BAII = AdjacencyMap Int Int 34 35testBipartiteUndirectedAdjacencyMap :: IO () 36testBipartiteUndirectedAdjacencyMap = do 37 -- Help with type inference by shadowing overly polymorphic functions 38 let consistent :: BAII -> Bool 39 consistent = B.consistent 40 show :: BAII -> String 41 show = Prelude.show 42 leftAdjacencyMap :: BAII -> Map Int (Set Int) 43 leftAdjacencyMap = B.leftAdjacencyMap 44 rightAdjacencyMap :: BAII -> Map Int (Set Int) 45 empty :: BAII 46 empty = B.empty 47 vertex :: Either Int Int -> BAII 48 vertex = B.vertex 49 leftVertex :: Int -> BAII 50 leftVertex = B.leftVertex 51 rightVertex :: Int -> BAII 52 rightVertex = B.rightVertex 53 edge :: Int -> Int -> BAII 54 edge = B.edge 55 rightAdjacencyMap = B.rightAdjacencyMap 56 isEmpty :: BAII -> Bool 57 isEmpty = B.isEmpty 58 hasLeftVertex :: Int -> BAII -> Bool 59 hasLeftVertex = B.hasLeftVertex 60 hasRightVertex :: Int -> BAII -> Bool 61 hasRightVertex = B.hasRightVertex 62 hasVertex :: Either Int Int -> BAII -> Bool 63 hasVertex = B.hasVertex 64 hasEdge :: Int -> Int -> BAII -> Bool 65 hasEdge = B.hasEdge 66 vertexCount :: BAII -> Int 67 vertexCount = B.vertexCount 68 edgeCount :: BAII -> Int 69 edgeCount = B.edgeCount 70 vertices :: [Int] -> [Int] -> BAII 71 vertices = B.vertices 72 edges :: [(Int, Int)] -> BAII 73 edges = B.edges 74 overlays :: [BAII] -> BAII 75 overlays = B.overlays 76 connects :: [BAII] -> BAII 77 connects = B.connects 78 swap :: BAII -> BAII 79 swap = B.swap 80 toBipartite :: AII -> BAII 81 toBipartite = B.toBipartite 82 toBipartiteWith :: Ord a => (a -> Either Int Int) -> AM.AdjacencyMap a -> BAII 83 toBipartiteWith = B.toBipartiteWith 84 fromBipartite :: BAII -> AII 85 fromBipartite = B.fromBipartite 86 biclique :: [Int] -> [Int] -> BAII 87 biclique = B.biclique 88 89 putStrLn "\n============ Bipartite.Undirected.AdjacencyMap.consistent ============" 90 test "consistent empty == True" $ 91 consistent empty == True 92 test "consistent (vertex x) == True" $ \x -> 93 consistent (vertex x) == True 94 test "consistent (edge x y) == True" $ \x y -> 95 consistent (edge x y) == True 96 test "consistent (edges x) == True" $ \x -> 97 consistent (edges x) == True 98 test "consistent (toBipartite x) == True" $ \x -> 99 consistent (toBipartite x) == True 100 test "consistent (swap x) == True" $ \x -> 101 consistent (swap x) == True 102 test "consistent (biclique xs ys) == True" $ \xs ys -> 103 consistent (biclique xs ys) == True 104 test "consistent (circuit xs) == True" $ \xs -> 105 consistent (circuit xs) == True 106 107 putStrLn "\n============ Bipartite.Undirected.AdjacencyMap.leftAdjacencyMap ============" 108 test "leftAdjacencyMap empty == Map.empty" $ 109 leftAdjacencyMap empty == Map.empty 110 test "leftAdjacencyMap (leftVertex x) == Map.singleton x Set.empty" $ \x -> 111 leftAdjacencyMap (leftVertex x) == Map.singleton x Set.empty 112 test "leftAdjacencyMap (rightVertex x) == Map.empty" $ \x -> 113 leftAdjacencyMap (rightVertex x) == Map.empty 114 test "leftAdjacencyMap (edge x y) == Map.singleton x (Set.singleton y)" $ \x y -> 115 leftAdjacencyMap (edge x y) == Map.singleton x (Set.singleton y) 116 117 putStrLn "\n============ Bipartite.Undirected.AdjacencyMap.rightAdjacencyMap ============" 118 test "rightAdjacencyMap empty == Map.empty" $ 119 rightAdjacencyMap empty == Map.empty 120 test "rightAdjacencyMap (leftVertex x) == Map.empty" $ \x -> 121 rightAdjacencyMap (leftVertex x) == Map.empty 122 test "rightAdjacencyMap (rightVertex x) == Map.singleton x Set.empty" $ \x -> 123 rightAdjacencyMap (rightVertex x) == Map.singleton x Set.empty 124 test "rightAdjacencyMap (edge x y) == Map.singleton y (Set.singleton x)" $ \x y -> 125 rightAdjacencyMap (edge x y) == Map.singleton y (Set.singleton x) 126 127 putStrLn "\n============ Bipartite.Undirected.AdjacencyMap.Num ============" 128 test "0 == rightVertex 0" $ 129 0 == rightVertex 0 130 test "swap 1 == leftVertex 1" $ 131 swap 1 == leftVertex 1 132 test "swap 1 + 2 == vertices [1] [2]" $ 133 swap 1 + 2 == vertices [1] [2] 134 test "swap 1 * 2 == edge 1 2" $ 135 swap 1 * 2 == edge 1 2 136 test "swap 1 + 2 * swap 3 == overlay (leftVertex 1) (edge 3 2)" $ 137 swap 1 + 2 * swap 3 == overlay (leftVertex 1) (edge 3 2) 138 test "swap 1 * (2 + swap 3) == connect (leftVertex 1) (vertices [3] [2])" $ 139 swap 1 * (2 + swap 3) == connect (leftVertex 1) (vertices [3] [2]) 140 141 putStrLn "\n============ Bipartite.Undirected.AdjacencyMap.Eq ============" 142 test "(x == y) == (leftAdjacencyMap x == leftAdjacencyMap y && rightAdjacencyMap x == rightAdjacencyMap y)" $ \(x :: BAII) (y :: BAII) -> 143 (x == y) == (leftAdjacencyMap x == leftAdjacencyMap y && rightAdjacencyMap x == rightAdjacencyMap y) 144 145 putStrLn "" 146 test " x + y == y + x" $ \(x :: BAII) y -> 147 x + y == y + x 148 test "x + (y + z) == (x + y) + z" $ \(x :: BAII) y z -> 149 x + (y + z) == (x + y) + z 150 test " x * empty == x" $ \(x :: BAII) -> 151 x * empty == x 152 test " empty * x == x" $ \(x :: BAII) -> 153 empty * x == x 154 test " x * y == y * x" $ \(x :: BAII) y -> 155 x * y == y * x 156 test "x * (y * z) == (x * y) * z" $ size10 $ \(x :: BAII) y z -> 157 x * (y * z) == (x * y) * z 158 test "x * (y + z) == x * y + x * z" $ size10 $ \(x :: BAII) y z -> 159 x * (y + z) == x * (y + z) 160 test "(x + y) * z == x * z + y * z" $ size10 $ \(x :: BAII) y z -> 161 (x + y) * z == x * z + y * z 162 test " x * y * z == x * y + x * z + y * z" $ size10 $ \(x :: BAII) y z -> 163 x * y * z == x * y + x * z + y * z 164 test " x + empty == x" $ \(x :: BAII) -> 165 x + empty == x 166 test " empty + x == x" $ \(x :: BAII) -> 167 empty + x == x 168 test " x + x == x" $ \(x :: BAII) -> 169 x + x == x 170 test "x * y + x + y == x * y" $ \(x :: BAII) (y :: BAII) -> 171 x * y + x + y == x * y 172 test " x * x * x == x * x" $ size10 $ \(x :: BAII) -> 173 x * x * x == x * x 174 175 putStrLn "" 176 test " leftVertex x * leftVertex y == leftVertex x + leftVertex y " $ \(x :: Int) y -> 177 leftVertex x * leftVertex y == leftVertex x + leftVertex y 178 test "rightVertex x * rightVertex y == rightVertex x + rightVertex y" $ \(x :: Int) y -> 179 rightVertex x * rightVertex y == rightVertex x + rightVertex y 180 181 putStrLn "\n============ Bipartite.Undirected.AdjacencyMap.Show ============" 182 test "show empty == \"empty\"" $ 183 show empty == "empty" 184 test "show 1 == \"rightVertex 1\"" $ 185 show 1 == "rightVertex 1" 186 test "show (swap 2) == \"leftVertex 2\"" $ 187 show (swap 2) == "leftVertex 2" 188 test "show 1 + 2 == \"vertices [] [1,2]\"" $ 189 show (1 + 2) == "vertices [] [1,2]" 190 test "show (swap (1 + 2)) == \"vertices [1,2] []\"" $ 191 show (swap (1 + 2)) == "vertices [1,2] []" 192 test "show (swap 1 * 2) == \"edge 1 2\"" $ 193 show (swap 1 * 2) == "edge 1 2" 194 test "show (swap 1 * 2 * swap 3) == \"edges [(1,2),(3,2)]\"" $ 195 show (swap 1 * 2 * swap 3) == "edges [(1,2),(3,2)]" 196 test "show (swap 1 * 2 + swap 3) == \"overlay (leftVertex 3) (edge 1 2)\"" $ 197 show (swap 1 * 2 + swap 3) == "overlay (leftVertex 3) (edge 1 2)" 198 199 putStrLn "\n============ Bipartite.Undirected.AdjacencyMap.empty ============" 200 test "isEmpty empty == True" $ 201 isEmpty empty == True 202 test "leftAdjacencyMap empty == Map.empty" $ 203 leftAdjacencyMap empty == Map.empty 204 test "rightAdjacencyMap empty == Map.empty" $ 205 rightAdjacencyMap empty == Map.empty 206 test "hasVertex x empty == False" $ \x -> 207 hasVertex x empty == False 208 209 putStrLn "\n============ Bipartite.Undirected.AdjacencyMap.leftVertex ============" 210 test "leftAdjacencyMap (leftVertex x) == Map.singleton x Set.empty" $ \x -> 211 leftAdjacencyMap (leftVertex x) == Map.singleton x Set.empty 212 test "rightAdjacencyMap (leftVertex x) == Map.empty" $ \x -> 213 rightAdjacencyMap (leftVertex x) == Map.empty 214 test "hasLeftVertex x (leftVertex y) == (x == y)" $ \x y -> 215 hasLeftVertex x (leftVertex y) == (x == y) 216 test "hasRightVertex x (leftVertex y) == False" $ \x y -> 217 hasRightVertex x (leftVertex y) == False 218 test "hasEdge x y (leftVertex z) == False" $ \x y z -> 219 hasEdge x y (leftVertex z) == False 220 221 putStrLn "\n============ Bipartite.Undirected.AdjacencyMap.rightVertex ============" 222 test "leftAdjacencyMap (rightVertex x) == Map.empty" $ \x -> 223 leftAdjacencyMap (rightVertex x) == Map.empty 224 test "rightAdjacencyMap (rightVertex x) == Map.singleton x Set.empty" $ \x -> 225 rightAdjacencyMap (rightVertex x) == Map.singleton x Set.empty 226 test "hasLeftVertex x (rightVertex y) == False" $ \x y -> 227 hasLeftVertex x (rightVertex y) == False 228 test "hasRightVertex x (rightVertex y) == (x == y)" $ \x y -> 229 hasRightVertex x (rightVertex y) == (x == y) 230 test "hasEdge x y (rightVertex z) == False" $ \x y z -> 231 hasEdge x y (rightVertex z) == False 232 233 putStrLn "\n============ Bipartite.Undirected.AdjacencyMap.vertex ============" 234 test "vertex (Left x) == leftVertex x" $ \x -> 235 vertex (Left x) == leftVertex x 236 test "vertex (Right x) == rightVertex x" $ \x -> 237 vertex (Right x) == rightVertex x 238 239 putStrLn "\n============ Bipartite.Undirected.AdjacencyMap.edge ============" 240 test "edge x y == connect (leftVertex x) (rightVertex y)" $ \x y -> 241 edge x y == connect (leftVertex x) (rightVertex y) 242 test "leftAdjacencyMap (edge x y) == Map.singleton x (Set.singleton y)" $ \x y -> 243 leftAdjacencyMap (edge x y) == Map.singleton x (Set.singleton y) 244 test "rightAdjacencyMap (edge x y) == Map.singleton y (Set.singleton x)" $ \x y -> 245 rightAdjacencyMap (edge x y) == Map.singleton y (Set.singleton x) 246 test "hasEdge x y (edge x y) == True" $ \x y -> 247 hasEdge x y (edge x y) == True 248 test "hasEdge 1 2 (edge 2 1) == False" $ 249 hasEdge 1 2 (edge 2 1) == False 250 251 putStrLn "\n============ Bipartite.Undirected.AdjacencyMap.overlay ============" 252 test "isEmpty (overlay x y) == isEmpty x && isEmpty y" $ \x y -> 253 isEmpty (overlay x y) ==(isEmpty x && isEmpty y) 254 test "hasVertex z (overlay x y) == hasVertex z x || hasVertex z y" $ \x y z -> 255 hasVertex z (overlay x y) ==(hasVertex z x || hasVertex z y) 256 test "vertexCount (overlay x y) >= vertexCount x" $ \x y -> 257 vertexCount (overlay x y) >= vertexCount x 258 test "vertexCount (overlay x y) <= vertexCount x + vertexCount y" $ \x y -> 259 vertexCount (overlay x y) <= vertexCount x + vertexCount y 260 test "edgeCount (overlay x y) >= edgeCount x" $ \x y -> 261 edgeCount (overlay x y) >= edgeCount x 262 test "edgeCount (overlay x y) <= edgeCount x + edgeCount y" $ \x y -> 263 edgeCount (overlay x y) <= edgeCount x + edgeCount y 264 265 putStrLn "\n============ Bipartite.Undirected.AdjacencyMap.connect ============" 266 test "connect (leftVertex x) (leftVertex y) == vertices [x,y] []" $ \x y -> 267 connect (leftVertex x) (leftVertex y) == vertices [x,y] [] 268 test "connect (leftVertex x) (rightVertex y) == edge x y" $ \x y -> 269 connect (leftVertex x) (rightVertex y) == edge x y 270 test "connect (rightVertex x) (leftVertex y) == edge y x" $ \x y -> 271 connect (rightVertex x) (leftVertex y) == edge y x 272 test "connect (rightVertex x) (rightVertex y) == vertices [] [x,y]" $ \x y -> 273 connect (rightVertex x) (rightVertex y) == vertices [] [x,y] 274 test "connect (vertices xs1 ys1) (vertices xs2 ys2) == overlay (biclique xs1 ys2) (biclique xs2 ys1)" $ \xs1 ys1 xs2 ys2 -> 275 connect (vertices xs1 ys1) (vertices xs2 ys2) == overlay (biclique xs1 ys2) (biclique xs2 ys1) 276 test "isEmpty (connect x y) == isEmpty x && isEmpty y" $ \x y -> 277 isEmpty (connect x y) ==(isEmpty x && isEmpty y) 278 test "hasVertex z (connect x y) == hasVertex z x || hasVertex z y" $ \x y z -> 279 hasVertex z (connect x y) ==(hasVertex z x || hasVertex z y) 280 test "vertexCount (connect x y) >= vertexCount x" $ \x y -> 281 vertexCount (connect x y) >= vertexCount x 282 test "vertexCount (connect x y) <= vertexCount x + vertexCount y" $ \x y -> 283 vertexCount (connect x y) <= vertexCount x + vertexCount y 284 test "edgeCount (connect x y) >= edgeCount x" $ \x y -> 285 edgeCount (connect x y) >= edgeCount x 286 test "edgeCount (connect x y) >= leftVertexCount x * rightVertexCount y" $ \x y -> 287 edgeCount (connect x y) >= leftVertexCount x * rightVertexCount y 288 test "edgeCount (connect x y) <= leftVertexCount x * rightVertexCount y + rightVertexCount x * leftVertexCount y + edgeCount x + edgeCount y" $ \x y -> 289 edgeCount (connect x y) <= leftVertexCount x * rightVertexCount y + rightVertexCount x * leftVertexCount y + edgeCount x + edgeCount y 290 291 putStrLn "\n============ Bipartite.Undirected.AdjacencyMap.vertices ============" 292 test "vertices [] [] == empty" $ 293 vertices [] [] == empty 294 test "vertices [x] [] == leftVertex x" $ \x -> 295 vertices [x] [] == leftVertex x 296 test "vertices [] [x] == rightVertex x" $ \x -> 297 vertices [] [x] == rightVertex x 298 test "hasLeftVertex x (vertices xs ys) == elem x xs" $ \x xs ys -> 299 hasLeftVertex x (vertices xs ys) == elem x xs 300 test "hasRightVertex y (vertices xs ys) == elem y ys" $ \y xs ys -> 301 hasRightVertex y (vertices xs ys) == elem y ys 302 303 putStrLn "\n============ Bipartite.Undirected.AdjacencyMap.edges ============" 304 test "edges [] == empty" $ 305 edges [] == empty 306 test "edges [(x,y)] == edge x y" $ \x y -> 307 edges [(x,y)] == edge x y 308 test "edges == overlays . map (uncurry edge)" $ \xs -> 309 edges xs == (overlays . map (uncurry edge)) xs 310 test "hasEdge x y . edges == elem (x,y)" $ \x y es -> 311 (hasEdge x y . edges) es == elem (x,y) es 312 test "edgeCount . edges == length . nub" $ \es -> 313 (edgeCount . edges) es == (length . nubOrd) es 314 315 putStrLn "\n============ Bipartite.Undirected.AdjacencyMap.overlays ============" 316 test "overlays [] == empty" $ 317 overlays [] == empty 318 test "overlays [x] == x" $ \x -> 319 overlays [x] == x 320 test "overlays [x,y] == overlay x y" $ \x y -> 321 overlays [x,y] == overlay x y 322 test "overlays == foldr overlay empty" $ size10 $ \xs -> 323 overlays xs == foldr overlay empty xs 324 test "isEmpty . overlays == all isEmpty" $ size10 $ \xs -> 325 (isEmpty . overlays) xs == all isEmpty xs 326 327 putStrLn "\n============ Bipartite.Undirected.AdjacencyMap.connects ============" 328 test "connects [] == empty" $ 329 connects [] == empty 330 test "connects [x] == x" $ \x -> 331 connects [x] == x 332 test "connects [x,y] == connect x y" $ \x y -> 333 connects [x,y] == connect x y 334 test "connects == foldr connect empty" $ size10 $ \xs -> 335 connects xs == foldr connect empty xs 336 test "isEmpty . connects == all isEmpty" $ size10 $ \ xs -> 337 (isEmpty . connects) xs == all isEmpty xs 338 339 putStrLn "\n============ Bipartite.Undirected.AdjacencyMap.swap ============" 340 test "swap empty == empty" $ 341 swap empty == empty 342 test "swap . leftVertex == rightVertex" $ \x -> 343 (swap . leftVertex) x == rightVertex x 344 test "swap (vertices xs ys) == vertices ys xs" $ \xs ys -> 345 swap (vertices xs ys) == vertices ys xs 346 test "swap (edge x y) == edge y x" $ \x y -> 347 swap (edge x y) == edge y x 348 test "swap . edges == edges . map Data.Tuple.swap" $ \es -> 349 (swap . edges) es == (edges . map Data.Tuple.swap) es 350 test "swap . swap == id" $ \x -> 351 (swap . swap) x == x 352 353 putStrLn "\n============ Bipartite.Undirected.AdjacencyMap.toBipartite ============" 354 test "toBipartite empty == empty" $ 355 toBipartite AM.empty == empty 356 test "toBipartite (vertex (Left x)) == leftVertex x" $ \x -> 357 toBipartite (AM.vertex (Left x)) == leftVertex x 358 test "toBipartite (vertex (Right x)) == rightVertex x" $ \x -> 359 toBipartite (AM.vertex (Right x)) == rightVertex x 360 test "toBipartite (edge (Left x) (Left y)) == vertices [x,y] []" $ \x y -> 361 toBipartite (AM.edge (Left x) (Left y)) == vertices [x,y] [] 362 test "toBipartite (edge (Left x) (Right y)) == edge x y" $ \x y -> 363 toBipartite (AM.edge (Left x) (Right y)) == edge x y 364 test "toBipartite (edge (Right x) (Left y)) == edge y x" $ \x y -> 365 toBipartite (AM.edge (Right x) (Left y)) == edge y x 366 test "toBipartite (edge (Right x) (Right y)) == vertices [] [x,y]" $ \x y -> 367 toBipartite (AM.edge (Right x) (Right y)) == vertices [] [x,y] 368 test "toBipartite (clique xs) == uncurry biclique (partitionEithers xs)" $ \xs -> 369 toBipartite (AM.clique xs) == uncurry biclique (partitionEithers xs) 370 371 putStrLn "\n============ Bipartite.Undirected.AdjacencyMap.toBipartiteWith ============" 372 test "toBipartiteWith f empty == empty" $ \(apply -> f) -> 373 toBipartiteWith f (AM.empty :: AII) == empty 374 test "toBipartiteWith Left x == vertices (vertexList x) []" $ \x -> 375 toBipartiteWith Left x == vertices (AM.vertexList x) [] 376 test "toBipartiteWith Right x == vertices [] (vertexList x)" $ \x -> 377 toBipartiteWith Right x == vertices [] (AM.vertexList x) 378 test "toBipartiteWith f == toBipartite . gmap f" $ \(apply -> f) x -> 379 toBipartiteWith f x == (toBipartite . AM.gmap f) (x :: AII) 380 test "toBipartiteWith id == toBipartite" $ \x -> 381 toBipartiteWith id x == toBipartite x 382 383 putStrLn "\n============ Bipartite.Undirected.AdjacencyMap.fromBipartite ============" 384 test "fromBipartite empty == empty" $ 385 fromBipartite empty == AM.empty 386 test "fromBipartite (leftVertex x) == vertex (Left x)" $ \x -> 387 fromBipartite (leftVertex x) == AM.vertex (Left x) 388 test "fromBipartite (edge x y) == edges [(Left x, Right y), (Right y, Left x)]" $ \x y -> 389 fromBipartite (edge x y) == AM.edges [(Left x, Right y), (Right y, Left x)] 390 test "toBipartite . fromBipartite == id" $ \x -> 391 (toBipartite . fromBipartite) x == x 392 393 putStrLn "\n============ Bipartite.Undirected.AdjacencyMap.fromBipartiteWith ============" 394 test "fromBipartiteWith Left Right == fromBipartite" $ \x -> 395 fromBipartiteWith Left Right x == fromBipartite x 396 test "fromBipartiteWith id id (vertices xs ys) == vertices (xs ++ ys)" $ \xs ys -> 397 fromBipartiteWith id id (vertices xs ys) == AM.vertices (xs ++ ys) 398 test "fromBipartiteWith id id . edges == edges" $ \xs -> 399 (fromBipartiteWith id id . edges) xs == (AM.symmetricClosure . AM.edges) xs 400 401 putStrLn "\n============ Bipartite.Undirected.AdjacencyMap.isEmpty ============" 402 test "isEmpty empty == True" $ 403 isEmpty empty == True 404 test "isEmpty (overlay empty empty) == True" $ 405 isEmpty (overlay empty empty) == True 406 test "isEmpty (vertex x) == False" $ \x -> 407 isEmpty (vertex x) == False 408 test "isEmpty == (==) empty" $ \x -> 409 isEmpty x == (==) empty x 410 411 putStrLn "\n============ Bipartite.Undirected.AdjacencyMap.hasLeftVertex ============" 412 test "hasLeftVertex x empty == False" $ \x -> 413 hasLeftVertex x empty == False 414 test "hasLeftVertex x (leftVertex y) == (x == y)" $ \x y -> 415 hasLeftVertex x (leftVertex y) == (x == y) 416 test "hasLeftVertex x (rightVertex y) == False" $ \x y -> 417 hasLeftVertex x (rightVertex y) == False 418 419 putStrLn "\n============ Bipartite.Undirected.AdjacencyMap.hasRightVertex ============" 420 test "hasRightVertex x empty == False" $ \x -> 421 hasRightVertex x empty == False 422 test "hasRightVertex x (leftVertex y) == False" $ \x y -> 423 hasRightVertex x (leftVertex y) == False 424 test "hasRightVertex x (rightVertex y) == (x == y)" $ \x y -> 425 hasRightVertex x (rightVertex y) == (x == y) 426 427 putStrLn "\n============ Bipartite.Undirected.AdjacencyMap.hasVertex ============" 428 test "hasVertex . Left == hasLeftVertex" $ \x y -> 429 (hasVertex . Left) x y == hasLeftVertex x y 430 test "hasVertex . Right == hasRightVertex" $ \x y -> 431 (hasVertex . Right) x y == hasRightVertex x y 432 433 putStrLn "\n============ Bipartite.Undirected.AdjacencyMap.hasEdge ============" 434 test "hasEdge x y empty == False" $ \x y -> 435 hasEdge x y empty == False 436 test "hasEdge x y (vertex z) == False" $ \x y z -> 437 hasEdge x y (vertex z) == False 438 test "hasEdge x y (edge x y) == True" $ \x y -> 439 hasEdge x y (edge x y) == True 440 test "hasEdge x y == elem (x,y) . edgeList" $ \x y z -> do 441 let es = edgeList z 442 (x, y) <- elements ((x, y) : es) 443 return $ hasEdge x y z == elem (x, y) es 444 445 putStrLn "\n============ Bipartite.Undirected.AdjacencyMap.leftVertexCount ============" 446 test "leftVertexCount empty == 0" $ 447 leftVertexCount empty == 0 448 test "leftVertexCount (leftVertex x) == 1" $ \x -> 449 leftVertexCount (leftVertex x) == 1 450 test "leftVertexCount (rightVertex x) == 0" $ \x -> 451 leftVertexCount (rightVertex x) == 0 452 test "leftVertexCount (edge x y) == 1" $ \x y -> 453 leftVertexCount (edge x y) == 1 454 test "leftVertexCount . edges == length . nub . map fst" $ \xs -> 455 (leftVertexCount . edges) xs == (length . nub . map fst) xs 456 457 putStrLn "\n============ Bipartite.Undirected.AdjacencyMap.rightVertexCount ============" 458 test "rightVertexCount empty == 0" $ 459 rightVertexCount empty == 0 460 test "rightVertexCount (leftVertex x) == 0" $ \x -> 461 rightVertexCount (leftVertex x) == 0 462 test "rightVertexCount (rightVertex x) == 1" $ \x -> 463 rightVertexCount (rightVertex x) == 1 464 test "rightVertexCount (edge x y) == 1" $ \x y -> 465 rightVertexCount (edge x y) == 1 466 test "rightVertexCount . edges == length . nub . map snd" $ \xs -> 467 (rightVertexCount . edges) xs == (length . nub . map snd) xs 468 469 putStrLn "\n============ Bipartite.Undirected.AdjacencyMap.vertexCount ============" 470 test "vertexCount empty == 0" $ 471 vertexCount empty == 0 472 test "vertexCount (vertex x) == 1" $ \x -> 473 vertexCount (vertex x) == 1 474 test "vertexCount (edge x y) == 2" $ \x y -> 475 vertexCount (edge x y) == 2 476 test "vertexCount x == leftVertexCount x + rightVertexCount x" $ \x -> 477 vertexCount x == leftVertexCount x + rightVertexCount x 478 479 putStrLn "\n============ Bipartite.Undirected.AdjacencyMap.edgeCount ============" 480 test "edgeCount empty == 0" $ 481 edgeCount empty == 0 482 test "edgeCount (vertex x) == 0" $ \x -> 483 edgeCount (vertex x) == 0 484 test "edgeCount (edge x y) == 1" $ \x y -> 485 edgeCount (edge x y) == 1 486 test "edgeCount . edges == length . nub" $ \xs -> 487 (edgeCount . edges) xs == (length . nubOrd) xs 488 489 putStrLn "\n============ Bipartite.Undirected.AdjacencyMap.leftVertexList ============" 490 test "leftVertexList empty == []" $ 491 leftVertexList empty == [] 492 test "leftVertexList (leftVertex x) == [x]" $ \x -> 493 leftVertexList (leftVertex x) == [x] 494 test "leftVertexList (rightVertex x) == []" $ \x -> 495 leftVertexList (rightVertex x) == [] 496 test "leftVertexList . flip vertices [] == nub . sort" $ \xs -> 497 (leftVertexList . flip vertices []) xs == (nubOrd . sort) xs 498 499 putStrLn "\n============ Bipartite.Undirected.AdjacencyMap.rightVertexList ============" 500 test "rightVertexList empty == []" $ 501 rightVertexList empty == [] 502 test "rightVertexList (leftVertex x) == []" $ \x -> 503 rightVertexList (leftVertex x) == [] 504 test "rightVertexList (rightVertex x) == [x]" $ \x -> 505 rightVertexList (rightVertex x) == [x] 506 test "rightVertexList . vertices [] == nub . sort" $ \xs -> 507 (rightVertexList . vertices []) xs == (nubOrd . sort) xs 508 509 putStrLn "\n============ Bipartite.Undirected.AdjacencyMap.vertexList ============" 510 test "vertexList empty == []" $ 511 vertexList empty == [] 512 test "vertexList (vertex x) == [x]" $ \x -> 513 vertexList (vertex x) == [x] 514 test "vertexList (edge x y) == [Left x, Right y]" $ \x y -> 515 vertexList (edge x y) == [Left x, Right y] 516 test "vertexList (vertices (lefts xs) (rights xs)) == nub (sort xs)" $ \xs -> 517 vertexList (vertices (lefts xs) (rights xs)) == nubOrd (sort xs) 518 519 putStrLn "\n============ Bipartite.Undirected.AdjacencyMap.edgeList ============" 520 test "edgeList empty == []" $ 521 edgeList empty == [] 522 test "edgeList (vertex x) == []" $ \x -> 523 edgeList (vertex x) == [] 524 test "edgeList (edge x y) == [(x,y)]" $ \x y -> 525 edgeList (edge x y) == [(x,y)] 526 test "edgeList . edges == nub . sort" $ \xs -> 527 (edgeList . edges) xs == (nubOrd . sort) xs 528 529 putStrLn "\n============ Bipartite.Undirected.AdjacencyMap.leftVertexSet ============" 530 test "leftVertexSet empty == Set.empty" $ 531 leftVertexSet empty == Set.empty 532 test "leftVertexSet . leftVertex == Set.singleton" $ \x -> 533 (leftVertexSet . leftVertex) x == Set.singleton x 534 test "leftVertexSet . rightVertex == const Set.empty" $ \x -> 535 (leftVertexSet . rightVertex) x == const Set.empty x 536 test "leftVertexSet . flip vertices [] == Set.fromList" $ \xs -> 537 (leftVertexSet . flip vertices []) xs == Set.fromList xs 538 539 putStrLn "\n============ Bipartite.Undirected.AdjacencyMap.rightVertexSet ============" 540 test "rightVertexSet empty == Set.empty" $ 541 rightVertexSet empty == Set.empty 542 test "rightVertexSet . leftVertex == const Set.empty" $ \x -> 543 (rightVertexSet . leftVertex) x == const Set.empty x 544 test "rightVertexSet . rightVertex == Set.singleton" $ \x -> 545 (rightVertexSet . rightVertex) x == Set.singleton x 546 test "rightVertexSet . vertices [] == Set.fromList" $ \xs -> 547 (rightVertexSet . vertices []) xs == Set.fromList xs 548 549 putStrLn "\n============ Bipartite.Undirected.AdjacencyMap.vertexSet ============" 550 test "vertexSet empty == Set.empty" $ 551 vertexSet empty == Set.empty 552 test "vertexSet . vertex == Set.singleton" $ \x -> 553 (vertexSet . vertex) x == Set.singleton x 554 test "vertexSet (edge x y) == Set.fromList [Left x, Right y]" $ \x y -> 555 vertexSet (edge x y) == Set.fromList [Left x, Right y] 556 test "vertexSet (vertices (lefts xs) (rights xs)) == Set.fromList xs" $ \xs -> 557 vertexSet (vertices (lefts xs) (rights xs)) == Set.fromList xs 558 559 putStrLn "\n============ Bipartite.Undirected.AdjacencyMap.edgeSet ============" 560 test "edgeSet empty == Set.empty" $ 561 edgeSet empty == Set.empty 562 test "edgeSet (vertex x) == Set.empty" $ \x -> 563 edgeSet (vertex x) == Set.empty 564 test "edgeSet (edge x y) == Set.singleton (x,y)" $ \x y -> 565 edgeSet (edge x y) == Set.singleton (x,y) 566 test "edgeSet . edges == Set.fromList" $ \xs -> 567 (edgeSet . edges) xs == Set.fromList xs 568 569 putStrLn "\n============ Bipartite.Undirected.AdjacencyMap.circuit ============" 570 test "circuit [] == empty" $ 571 circuit [] == empty 572 test "circuit [(x,y)] == edge x y" $ \x y -> 573 circuit [(x,y)] == edge x y 574 test "circuit [(1,2), (3,4)] == biclique [1,3] [2,4]" $ 575 circuit [(1,2), (3,4)] == biclique [1,3 :: Int] [2,4 :: Int] 576 test "circuit [(1,2), (3,4), (5,6)] == edges [(1,2), (3,2), (3,4), (5,4), (5,6), (1,6)]" $ 577 circuit [(1,2), (3,4), (5,6)] == edges [(1,2), (3,2), (3,4), (5,4), (5,6), (1,6)] 578 test "circuit . reverse == swap . circuit . map Data.Tuple.swap" $ \xs -> 579 (circuit . reverse) xs == (swap . circuit . map Data.Tuple.swap) xs 580 581 putStrLn "\n============ Bipartite.Undirected.AdjacencyMap.biclique ============" 582 test "biclique [] [] == empty" $ 583 biclique [] [] == empty 584 test "biclique xs [] == vertices xs []" $ \xs -> 585 biclique xs [] == vertices xs [] 586 test "biclique [] ys == vertices [] ys" $ \ys -> 587 biclique [] ys == vertices [] ys 588 test "biclique xs ys == connect (vertices xs []) (vertices [] ys)" $ \xs ys -> 589 biclique xs ys == connect (vertices xs []) (vertices [] ys) 590 591 putStrLn "\n============ Bipartite.Undirected.AdjacencyMap.detectParts ============" 592 test "detectParts empty == Right empty" $ 593 detectParts AM.empty == Right empty 594 test "detectParts (vertex x) == Right (leftVertex x)" $ \x -> 595 detectParts (AM.vertex x) == Right (leftVertex x) 596 test "detectParts (edge x x) == Left [x]" $ \x -> 597 detectParts (AM.edge x x :: AI) == Left [x] 598 test "detectParts (edge 1 2) == Right (edge 1 2)" $ 599 detectParts (AM.edge 1 2) == Right (edge 1 2) 600 test "detectParts (1 * (2 + 3)) == Right (edges [(1,2), (1,3)])" $ 601 detectParts (1 * (2 + 3)) == Right (edges [(1,2), (1,3)]) 602 test "detectParts (1 * 2 * 3) == Left [1, 2, 3]" $ 603 detectParts (1 * 2 * 3 :: AI) == Left [1, 2, 3] 604 test "detectParts ((1 + 3) * (2 + 4) + 6 * 5) == Right (swap (1 + 3) * (2 + 4) + swap 5 * 6)" $ 605 detectParts ((1 + 3) * (2 + 4) + 6 * 5) == Right (swap (1 + 3) * (2 + 4) + swap 5 * 6) 606 test "detectParts ((1 * 3 * 4) + 2 * (1 + 2)) == Left [2]" $ 607 detectParts ((1 * 3 * 4) + 2 * (1 + 2) :: AI) == Left [2] 608 test "detectParts (clique [1..10]) == Left [1, 2, 3]" $ 609 detectParts (AM.clique [1..10] :: AI) == Left [1, 2, 3] 610 test "detectParts (circuit [1..11]) == Left [1..11]" $ 611 detectParts (AM.circuit [1..11] :: AI) == Left [1..11] 612 test "detectParts (circuit [1..10]) == Right (circuit [(x, x + 1) | x <- [1,3,5,7,9]])" $ 613 detectParts (AM.circuit [1..10] :: AI) == Right (circuit [(x, x + 1) | x <- [1,3,5,7,9]]) 614 test "detectParts (biclique [] xs) == Right (vertices xs [])" $ \xs -> 615 detectParts (AM.biclique [] xs) == Right (vertices xs []) 616 test "detectParts (biclique (map Left (x:xs)) (map Right ys)) == Right (biclique (map Left (x:xs)) (map Right ys))" $ \(x :: Int) xs (ys :: [Int]) -> 617 detectParts (AM.biclique (map Left (x:xs)) (map Right ys)) == Right (B.biclique (map Left (x:xs)) (map Right ys)) 618 test "isRight (detectParts (star x ys)) == notElem x ys" $ \(x :: Int) ys -> 619 isRight (detectParts (AM.star x ys)) == notElem x ys 620 test "isRight (detectParts (fromBipartite x)) == True" $ \x -> 621 isRight (detectParts (fromBipartite x)) == True 622 623 putStrLn "" 624 test "Correctness of detectParts" $ \input -> 625 let undirected = AM.symmetricClosure input in 626 case detectParts input of 627 Left cycle -> mod (length cycle) 2 == 1 && AM.isSubgraphOf (AM.circuit cycle) undirected 628 Right bipartite -> AM.gmap fromEither (fromBipartite bipartite) == undirected 629