1{-# LANGUAGE RecordWildCards, GADTs, ViewPatterns #-} 2----------------------------------------------------------------------------- 3-- | 4-- Module : Algebra.Graph.Test.Generic 5-- Copyright : (c) Andrey Mokhov 2016-2019 6-- License : MIT (see the file LICENSE) 7-- Maintainer : andrey.mokhov@gmail.com 8-- Stability : experimental 9-- 10-- Generic graph API testing. 11----------------------------------------------------------------------------- 12module Algebra.Graph.Test.Generic where 13 14import Control.Monad (when) 15import Data.Either 16import Data.List as List 17import Data.List.NonEmpty (NonEmpty (..)) 18import Data.Tree 19import Data.Tuple 20 21import Algebra.Graph.Test 22import Algebra.Graph.Test.API 23 24import qualified Algebra.Graph as G 25import qualified Algebra.Graph.AdjacencyMap as AM 26import qualified Algebra.Graph.AdjacencyMap.Algorithm as AM 27import qualified Algebra.Graph.AdjacencyIntMap as AIM 28import qualified Data.Set as Set 29import qualified Data.IntSet as IntSet 30 31type ModulePrefix = String 32type Testsuite g c = (ModulePrefix, API g c) 33type TestsuiteInt g = (ModulePrefix, API g ((~) Int)) 34 35testBasicPrimitives :: TestsuiteInt g -> IO () 36testBasicPrimitives = mconcat [ testOrd 37 , testEmpty 38 , testVertex 39 , testEdge 40 , testOverlay 41 , testConnect 42 , testVertices 43 , testEdges 44 , testOverlays 45 , testConnects ] 46 47testSymmetricBasicPrimitives :: TestsuiteInt g -> IO () 48testSymmetricBasicPrimitives = mconcat [ testSymmetricOrd 49 , testEmpty 50 , testVertex 51 , testSymmetricEdge 52 , testOverlay 53 , testSymmetricConnect 54 , testVertices 55 , testSymmetricEdges 56 , testOverlays 57 , testSymmetricConnects ] 58 59testToGraph :: TestsuiteInt g -> IO () 60testToGraph = mconcat [ testToGraphDefault 61 , testFoldg 62 , testIsEmpty 63 , testHasVertex 64 , testHasEdge 65 , testVertexCount 66 , testEdgeCount 67 , testVertexList 68 , testVertexSet 69 , testVertexIntSet 70 , testEdgeList 71 , testEdgeSet 72 , testAdjacencyList 73 , testPreSet 74 , testPreIntSet 75 , testPostSet 76 , testPostIntSet ] 77 78testSymmetricToGraph :: TestsuiteInt g -> IO () 79testSymmetricToGraph = mconcat [ testSymmetricToGraphDefault 80 , testIsEmpty 81 , testHasVertex 82 , testSymmetricHasEdge 83 , testVertexCount 84 , testEdgeCount 85 , testVertexList 86 , testVertexSet 87 , testVertexIntSet 88 , testSymmetricEdgeList 89 , testSymmetricEdgeSet 90 , testSymmetricAdjacencyList 91 , testNeighbours ] 92 93testRelational :: TestsuiteInt g -> IO () 94testRelational = mconcat [ testCompose 95 , testClosure 96 , testReflexiveClosure 97 , testSymmetricClosure 98 , testTransitiveClosure ] 99 100testGraphFamilies :: TestsuiteInt g -> IO () 101testGraphFamilies = mconcat [ testPath 102 , testCircuit 103 , testClique 104 , testBiclique 105 , testStar 106 , testStars 107 , testTree 108 , testForest ] 109 110testSymmetricGraphFamilies :: TestsuiteInt g -> IO () 111testSymmetricGraphFamilies = mconcat [ testSymmetricPath 112 , testSymmetricCircuit 113 , testSymmetricClique 114 , testBiclique 115 , testStar 116 , testStars 117 , testTree 118 , testForest ] 119 120testTransformations :: TestsuiteInt g -> IO () 121testTransformations = mconcat [ testRemoveVertex 122 , testRemoveEdge 123 , testReplaceVertex 124 , testMergeVertices 125 , testTranspose 126 , testGmap 127 , testInduce ] 128 129testSymmetricTransformations :: TestsuiteInt g -> IO () 130testSymmetricTransformations = mconcat [ testRemoveVertex 131 , testSymmetricRemoveEdge 132 , testReplaceVertex 133 , testMergeVertices 134 , testGmap 135 , testInduce ] 136 137testConsistent :: TestsuiteInt g -> IO () 138testConsistent (prefix, API{..}) = do 139 putStrLn $ "\n============ " ++ prefix ++ "consistent ============" 140 test "Consistency of the Arbitrary instance" $ \x -> consistent x 141 142 putStrLn "" 143 test "consistent empty == True" $ 144 consistent empty == True 145 146 test "consistent (vertex x) == True" $ \x -> 147 consistent (vertex x) == True 148 149 test "consistent (overlay x y) == True" $ \x y -> 150 consistent (overlay x y) == True 151 152 test "consistent (connect x y) == True" $ \x y -> 153 consistent (connect x y) == True 154 155 test "consistent (edge x y) == True" $ \x y -> 156 consistent (edge x y) == True 157 158 test "consistent (edges xs) == True" $ \xs -> 159 consistent (edges xs) == True 160 161 test "consistent (stars xs) == True" $ \xs -> 162 consistent (stars xs) == True 163 164testShow :: TestsuiteInt g -> IO () 165testShow (prefix, API{..}) = do 166 putStrLn $ "\n============ " ++ prefix ++ "Show ============" 167 test "show (empty ) == \"empty\"" $ 168 show (empty ) == "empty" 169 170 test "show (1 ) == \"vertex 1\"" $ 171 show (1 `asTypeOf` empty) == "vertex 1" 172 173 test "show (1 + 2 ) == \"vertices [1,2]\"" $ 174 show (1 + 2 `asTypeOf` empty) == "vertices [1,2]" 175 176 test "show (1 * 2 ) == \"edge 1 2\"" $ 177 show (1 * 2 `asTypeOf` empty) == "edge 1 2" 178 179 test "show (1 * 2 * 3) == \"edges [(1,2),(1,3),(2,3)]\"" $ 180 show (1 * 2 * 3 `asTypeOf` empty) == "edges [(1,2),(1,3),(2,3)]" 181 182 test "show (1 * 2 + 3) == \"overlay (vertex 3) (edge 1 2)\"" $ 183 show (1 * 2 + 3 `asTypeOf` empty) == "overlay (vertex 3) (edge 1 2)" 184 185 putStrLn "" 186 test "show (vertex (-1) ) == \"vertex (-1)\"" $ 187 show (vertex (-1) ) == "vertex (-1)" 188 189 test "show (vertex (-1) + vertex (-2) ) == \"vertices [-2,-1]\"" $ 190 show (vertex (-1) + vertex (-2) ) == "vertices [-2,-1]" 191 192 test "show (vertex (-2) * vertex (-1) ) == \"edge (-2) (-1)\"" $ 193 show (vertex (-2) * vertex (-1) ) == "edge (-2) (-1)" 194 195 test "show (vertex (-3) * vertex (-2) * vertex (-1)) == \"edges [(-3,-2),(-3,-1),(-2,-1)]\"" $ 196 show (vertex (-3) * vertex (-2) * vertex (-1)) == "edges [(-3,-2),(-3,-1),(-2,-1)]" 197 198 test "show (vertex (-3) * vertex (-2) + vertex (-1)) == \"overlay (vertex (-1)) (edge (-3) (-2))\"" $ 199 show (vertex (-3) * vertex (-2) + vertex (-1)) == "overlay (vertex (-1)) (edge (-3) (-2))" 200 201testSymmetricShow :: TestsuiteInt g -> IO () 202testSymmetricShow t@(_, API{..}) = do 203 testShow t 204 putStrLn "" 205 test "show (2 * 1 ) == \"edge 1 2\"" $ 206 show (2 * 1 `asTypeOf` empty) == "edge 1 2" 207 208 test "show (1 * 2 * 1) == \"edges [(1,1),(1,2)]\"" $ 209 show (1 * 2 * 1 `asTypeOf` empty) == "edges [(1,1),(1,2)]" 210 211 test "show (3 * 2 * 1) == \"edges [(1,2),(1,3),(2,3)]\"" $ 212 show (3 * 2 * 1 `asTypeOf` empty) == "edges [(1,2),(1,3),(2,3)]" 213 214testOrd :: TestsuiteInt g -> IO () 215testOrd (prefix, API{..}) = do 216 putStrLn $ "\n============ " ++ prefix ++ "Ord ============" 217 test "vertex 1 < vertex 2" $ 218 vertex 1 < vertex 2 219 220 test "vertex 3 < edge 1 2" $ 221 vertex 3 < edge 1 2 222 223 test "vertex 1 < edge 1 1" $ 224 vertex 1 < edge 1 1 225 226 test "edge 1 1 < edge 1 2" $ 227 edge 1 1 < edge 1 2 228 229 test "edge 1 2 < edge 1 1 + edge 2 2" $ 230 edge 1 2 < edge 1 1 + edge 2 2 231 232 test "edge 1 2 < edge 1 3" $ 233 edge 1 2 < edge 1 3 234 235 test "x <= x + y" $ \x y -> 236 x <= x + (y `asTypeOf` empty) 237 238 test "x + y <= x * y" $ \x y -> 239 x + y <= x * (y `asTypeOf` empty) 240 241testSymmetricOrd :: TestsuiteInt g -> IO () 242testSymmetricOrd (prefix, API{..}) = do 243 putStrLn $ "\n============ " ++ prefix ++ "Ord ============" 244 test "vertex 1 < vertex 2" $ 245 vertex 1 < vertex 2 246 247 test "vertex 3 < edge 1 2" $ 248 vertex 3 < edge 1 2 249 250 test "vertex 1 < edge 1 1" $ 251 vertex 1 < edge 1 1 252 253 test "edge 1 1 < edge 1 2" $ 254 edge 1 1 < edge 1 2 255 256 test "edge 1 2 < edge 1 1 + edge 2 2" $ 257 edge 1 2 < edge 1 1 + edge 2 2 258 259 test "edge 2 1 < edge 1 3" $ 260 edge 2 1 < edge 1 3 261 262 test "edge 1 2 == edge 2 1" $ 263 edge 1 2 == edge 2 1 264 265 test "x <= x + y" $ \x y -> 266 x <= x + (y `asTypeOf` empty) 267 268 test "x + y <= x * y" $ \x y -> 269 x + y <= x * (y `asTypeOf` empty) 270 271testEmpty :: TestsuiteInt g -> IO () 272testEmpty (prefix, API{..}) = do 273 putStrLn $ "\n============ " ++ prefix ++ "empty ============" 274 test "isEmpty empty == True" $ 275 isEmpty empty == True 276 277 test "hasVertex x empty == False" $ \x -> 278 hasVertex x empty == False 279 280 test "vertexCount empty == 0" $ 281 vertexCount empty == 0 282 283 test "edgeCount empty == 0" $ 284 edgeCount empty == 0 285 286testVertex :: TestsuiteInt g -> IO () 287testVertex (prefix, API{..}) = do 288 putStrLn $ "\n============ " ++ prefix ++ "vertex ============" 289 test "isEmpty (vertex x) == False" $ \x -> 290 isEmpty (vertex x) == False 291 292 test "hasVertex x (vertex y) == (x == y)" $ \x y -> 293 hasVertex x (vertex y) == (x == y) 294 295 test "vertexCount (vertex x) == 1" $ \x -> 296 vertexCount (vertex x) == 1 297 298 test "edgeCount (vertex x) == 0" $ \x -> 299 edgeCount (vertex x) == 0 300 301testEdge :: TestsuiteInt g -> IO () 302testEdge (prefix, API{..}) = do 303 putStrLn $ "\n============ " ++ prefix ++ "edge ============" 304 test "edge x y == connect (vertex x) (vertex y)" $ \x y -> 305 edge x y == connect (vertex x) (vertex y) 306 307 test "hasEdge x y (edge x y) == True" $ \x y -> 308 hasEdge x y (edge x y) == True 309 310 test "edgeCount (edge x y) == 1" $ \x y -> 311 edgeCount (edge x y) == 1 312 313 test "vertexCount (edge 1 1) == 1" $ 314 vertexCount (edge 1 1) == 1 315 316 test "vertexCount (edge 1 2) == 2" $ 317 vertexCount (edge 1 2) == 2 318 319testSymmetricEdge :: TestsuiteInt g -> IO () 320testSymmetricEdge (prefix, API{..}) = do 321 putStrLn $ "\n============ " ++ prefix ++ "edge ============" 322 test "edge x y == connect (vertex x) (vertex y)" $ \x y -> 323 edge x y == connect (vertex x) (vertex y) 324 325 test "edge x y == edge y x" $ \x y -> 326 edge x y == edge y x 327 328 test "edge x y == edges [(x,y), (y,x)]" $ \x y -> 329 edge x y == edges [(x,y), (y,x)] 330 331 test "hasEdge x y (edge x y) == True" $ \x y -> 332 hasEdge x y (edge x y) == True 333 334 test "edgeCount (edge x y) == 1" $ \x y -> 335 edgeCount (edge x y) == 1 336 337 test "vertexCount (edge 1 1) == 1" $ 338 vertexCount (edge 1 1) == 1 339 340 test "vertexCount (edge 1 2) == 2" $ 341 vertexCount (edge 1 2) == 2 342 343testOverlay :: TestsuiteInt g -> IO () 344testOverlay (prefix, API{..}) = do 345 putStrLn $ "\n============ " ++ prefix ++ "overlay ============" 346 test "isEmpty (overlay x y) == isEmpty x && isEmpty y" $ \x y -> 347 isEmpty (overlay x y) ==(isEmpty x && isEmpty y) 348 349 test "hasVertex z (overlay x y) == hasVertex z x || hasVertex z y" $ \x y z -> 350 hasVertex z (overlay x y) ==(hasVertex z x || hasVertex z y) 351 352 test "vertexCount (overlay x y) >= vertexCount x" $ \x y -> 353 vertexCount (overlay x y) >= vertexCount x 354 355 test "vertexCount (overlay x y) <= vertexCount x + vertexCount y" $ \x y -> 356 vertexCount (overlay x y) <= vertexCount x + vertexCount y 357 358 test "edgeCount (overlay x y) >= edgeCount x" $ \x y -> 359 edgeCount (overlay x y) >= edgeCount x 360 361 test "edgeCount (overlay x y) <= edgeCount x + edgeCount y" $ \x y -> 362 edgeCount (overlay x y) <= edgeCount x + edgeCount y 363 364 test "vertexCount (overlay 1 2) == 2" $ 365 vertexCount (overlay 1 2) == 2 366 367 test "edgeCount (overlay 1 2) == 0" $ 368 edgeCount (overlay 1 2) == 0 369 370testConnect :: TestsuiteInt g -> IO () 371testConnect (prefix, API{..}) = do 372 putStrLn $ "\n============ " ++ prefix ++ "connect ============" 373 test "isEmpty (connect x y) == isEmpty x && isEmpty y" $ \x y -> 374 isEmpty (connect x y) ==(isEmpty x && isEmpty y) 375 376 test "hasVertex z (connect x y) == hasVertex z x || hasVertex z y" $ \x y z -> 377 hasVertex z (connect x y) ==(hasVertex z x || hasVertex z y) 378 379 test "vertexCount (connect x y) >= vertexCount x" $ \x y -> 380 vertexCount (connect x y) >= vertexCount x 381 382 test "vertexCount (connect x y) <= vertexCount x + vertexCount y" $ \x y -> 383 vertexCount (connect x y) <= vertexCount x + vertexCount y 384 385 test "edgeCount (connect x y) >= edgeCount x" $ \x y -> 386 edgeCount (connect x y) >= edgeCount x 387 388 test "edgeCount (connect x y) >= edgeCount y" $ \x y -> 389 edgeCount (connect x y) >= edgeCount y 390 391 test "edgeCount (connect x y) >= vertexCount x * vertexCount y" $ \x y -> 392 edgeCount (connect x y) >= vertexCount x * vertexCount y 393 394 test "edgeCount (connect x y) <= vertexCount x * vertexCount y + edgeCount x + edgeCount y" $ \x y -> 395 edgeCount (connect x y) <= vertexCount x * vertexCount y + edgeCount x + edgeCount y 396 397 test "vertexCount (connect 1 2) == 2" $ 398 vertexCount (connect 1 2) == 2 399 400 test "edgeCount (connect 1 2) == 1" $ 401 edgeCount (connect 1 2) == 1 402 403testSymmetricConnect :: TestsuiteInt g -> IO () 404testSymmetricConnect (prefix, API{..}) = do 405 putStrLn $ "\n============ " ++ prefix ++ "connect ============" 406 test "connect x y == connect y x" $ \x y -> 407 connect x y == connect y x 408 409 test "isEmpty (connect x y) == isEmpty x && isEmpty y" $ \x y -> 410 isEmpty (connect x y) ==(isEmpty x && isEmpty y) 411 412 test "hasVertex z (connect x y) == hasVertex z x || hasVertex z y" $ \x y z -> 413 hasVertex z (connect x y) ==(hasVertex z x || hasVertex z y) 414 415 test "vertexCount (connect x y) >= vertexCount x" $ \x y -> 416 vertexCount (connect x y) >= vertexCount x 417 418 test "vertexCount (connect x y) <= vertexCount x + vertexCount y" $ \x y -> 419 vertexCount (connect x y) <= vertexCount x + vertexCount y 420 421 test "edgeCount (connect x y) >= edgeCount x" $ \x y -> 422 edgeCount (connect x y) >= edgeCount x 423 424 test "edgeCount (connect x y) >= edgeCount y" $ \x y -> 425 edgeCount (connect x y) >= edgeCount y 426 427 test "edgeCount (connect x y) >= vertexCount x * vertexCount y `div` 2" $ \x y -> 428 edgeCount (connect x y) >= vertexCount x * vertexCount y `div` 2 429 430 test "edgeCount (connect x y) <= vertexCount x * vertexCount y + edgeCount x + edgeCount y" $ \x y -> 431 edgeCount (connect x y) <= vertexCount x * vertexCount y + edgeCount x + edgeCount y 432 433 test "vertexCount (connect 1 2) == 2" $ 434 vertexCount (connect 1 2) == 2 435 436 test "edgeCount (connect 1 2) == 1" $ 437 edgeCount (connect 1 2) == 1 438 439testVertices :: TestsuiteInt g -> IO () 440testVertices (prefix, API{..}) = do 441 putStrLn $ "\n============ " ++ prefix ++ "vertices ============" 442 test "vertices [] == empty" $ 443 vertices [] == empty 444 445 test "vertices [x] == vertex x" $ \x -> 446 vertices [x] == vertex x 447 448 test "hasVertex x . vertices == elem x" $ \x xs -> 449 (hasVertex x . vertices) xs == elem x xs 450 451 test "vertexCount . vertices == length . nub" $ \xs -> 452 (vertexCount . vertices) xs == (length . nubOrd) xs 453 454 test "vertexSet . vertices == Set.fromList" $ \xs -> 455 (vertexSet . vertices) xs == Set.fromList xs 456 457testEdges :: TestsuiteInt g -> IO () 458testEdges (prefix, API{..}) = do 459 putStrLn $ "\n============ " ++ prefix ++ "edges ============" 460 test "edges [] == empty" $ 461 edges [] == empty 462 463 test "edges [(x,y)] == edge x y" $ \x y -> 464 edges [(x,y)] == edge x y 465 466 test "edges == overlays . map (uncurry edge)" $ \xs -> 467 edges xs == (overlays . map (uncurry edge)) xs 468 469 test "edgeCount . edges == length . nub" $ \xs -> 470 (edgeCount . edges) xs == (length . nubOrd) xs 471 472testSymmetricEdges :: TestsuiteInt g -> IO () 473testSymmetricEdges (prefix, API{..}) = do 474 putStrLn $ "\n============ " ++ prefix ++ "edges ============" 475 test "edges [] == empty" $ 476 edges [] == empty 477 478 test "edges [(x,y)] == edge x y" $ \x y -> 479 edges [(x,y)] == edge x y 480 481 test "edges [(x,y), (y,x)] == edge x y" $ \x y -> 482 edges [(x,y), (y,x)] == edge x y 483 484testOverlays :: TestsuiteInt g -> IO () 485testOverlays (prefix, API{..}) = do 486 putStrLn $ "\n============ " ++ prefix ++ "overlays ============" 487 test "overlays [] == empty" $ 488 overlays [] == empty 489 490 test "overlays [x] == x" $ \x -> 491 overlays [x] == x 492 493 test "overlays [x,y] == overlay x y" $ \x y -> 494 overlays [x,y] == overlay x y 495 496 test "overlays == foldr overlay empty" $ size10 $ \xs -> 497 overlays xs == foldr overlay empty xs 498 499 test "isEmpty . overlays == all isEmpty" $ size10 $ \xs -> 500 (isEmpty . overlays) xs == all isEmpty xs 501 502testConnects :: TestsuiteInt g -> IO () 503testConnects (prefix, API{..}) = do 504 putStrLn $ "\n============ " ++ prefix ++ "connects ============" 505 test "connects [] == empty" $ 506 connects [] == empty 507 508 test "connects [x] == x" $ \x -> 509 connects [x] == x 510 511 test "connects [x,y] == connect x y" $ \x y -> 512 connects [x,y] == connect x y 513 514 test "connects == foldr connect empty" $ size10 $ \xs -> 515 connects xs == foldr connect empty xs 516 517 test "isEmpty . connects == all isEmpty" $ size10 $ \xs -> 518 (isEmpty . connects) xs == all isEmpty xs 519 520testSymmetricConnects :: TestsuiteInt g -> IO () 521testSymmetricConnects t@(_, API{..}) = do 522 testConnects t 523 test "connects == connects . reverse" $ size10 $ \xs -> 524 connects xs == connects (reverse xs) 525 526testStars :: TestsuiteInt g -> IO () 527testStars (prefix, API{..}) = do 528 putStrLn $ "\n============ " ++ prefix ++ "stars ============" 529 test "stars [] == empty" $ 530 stars [] == empty 531 532 test "stars [(x, [])] == vertex x" $ \x -> 533 stars [(x, [])] == vertex x 534 535 test "stars [(x, [y])] == edge x y" $ \x y -> 536 stars [(x, [y])] == edge x y 537 538 test "stars [(x, ys)] == star x ys" $ \x ys -> 539 stars [(x, ys)] == star x ys 540 541 test "stars == overlays . map (uncurry star)" $ \xs -> 542 stars xs == overlays (map (uncurry star) xs) 543 544 test "stars . adjacencyList == id" $ \x -> 545 (stars . adjacencyList) x == id x 546 547 test "overlay (stars xs) (stars ys) == stars (xs ++ ys)" $ \xs ys -> 548 overlay (stars xs) (stars ys) == stars (xs ++ ys) 549 550testFromAdjacencySets :: TestsuiteInt g -> IO () 551testFromAdjacencySets (prefix, API{..}) = do 552 putStrLn $ "\n============ " ++ prefix ++ "fromAdjacencySets ============" 553 test "fromAdjacencySets [] == empty" $ 554 fromAdjacencySets [] == empty 555 556 test "fromAdjacencySets [(x, Set.empty)] == vertex x" $ \x -> 557 fromAdjacencySets [(x, Set.empty)] == vertex x 558 559 test "fromAdjacencySets [(x, Set.singleton y)] == edge x y" $ \x y -> 560 fromAdjacencySets [(x, Set.singleton y)] == edge x y 561 562 test "fromAdjacencySets . map (fmap Set.fromList) == stars" $ \x -> 563 (fromAdjacencySets . map (fmap Set.fromList)) x == stars x 564 565 test "overlay (fromAdjacencySets xs) (fromAdjacencySets ys) == fromAdjacencySets (xs ++ ys)" $ \xs ys -> 566 overlay (fromAdjacencySets xs) (fromAdjacencySets ys) == fromAdjacencySets (xs ++ ys) 567 568testFromAdjacencyIntSets :: TestsuiteInt g -> IO () 569testFromAdjacencyIntSets (prefix, API{..}) = do 570 putStrLn $ "\n============ " ++ prefix ++ "fromAdjacencyIntSets ============" 571 test "fromAdjacencyIntSets [] == empty" $ 572 fromAdjacencyIntSets [] == empty 573 574 test "fromAdjacencyIntSets [(x, IntSet.empty)] == vertex x" $ \x -> 575 fromAdjacencyIntSets [(x, IntSet.empty)] == vertex x 576 577 test "fromAdjacencyIntSets [(x, IntSet.singleton y)] == edge x y" $ \x y -> 578 fromAdjacencyIntSets [(x, IntSet.singleton y)] == edge x y 579 580 test "fromAdjacencyIntSets . map (fmap IntSet.fromList) == stars" $ \x -> 581 (fromAdjacencyIntSets . map (fmap IntSet.fromList)) x == stars x 582 583 test "overlay (fromAdjacencyIntSets xs) (fromAdjacencyIntSets ys) == fromAdjacencyIntSets (xs ++ ys)" $ \xs ys -> 584 overlay (fromAdjacencyIntSets xs) (fromAdjacencyIntSets ys) == fromAdjacencyIntSets (xs ++ ys) 585 586testIsSubgraphOf :: TestsuiteInt g -> IO () 587testIsSubgraphOf (prefix, API{..}) = do 588 putStrLn $ "\n============ " ++ prefix ++ "isSubgraphOf ============" 589 test "isSubgraphOf empty x == True" $ \x -> 590 isSubgraphOf empty x == True 591 592 test "isSubgraphOf (vertex x) empty == False" $ \x -> 593 isSubgraphOf (vertex x) empty == False 594 595 test "isSubgraphOf x (overlay x y) == True" $ \x y -> 596 isSubgraphOf x (overlay x y) == True 597 598 test "isSubgraphOf (overlay x y) (connect x y) == True" $ \x y -> 599 isSubgraphOf (overlay x y) (connect x y) == True 600 601 test "isSubgraphOf (path xs) (circuit xs) == True" $ \xs -> 602 isSubgraphOf (path xs) (circuit xs) == True 603 604 test "isSubgraphOf x y ==> x <= y" $ \x z -> 605 let y = x + z -- Make sure we hit the precondition 606 in isSubgraphOf x y ==> x <= y 607 608testSymmetricIsSubgraphOf :: TestsuiteInt g -> IO () 609testSymmetricIsSubgraphOf t@(_, API{..}) = do 610 testIsSubgraphOf t 611 test "isSubgraphOf (edge x y) (edge y x) == True" $ \x y -> 612 isSubgraphOf (edge x y) (edge y x) == True 613 614testToGraphDefault :: TestsuiteInt g -> IO () 615testToGraphDefault (prefix, API{..}) = do 616 putStrLn $ "\n============ " ++ prefix ++ "toGraph et al. ============" 617 test "toGraph == foldg Empty Vertex Overlay Connect" $ \x -> 618 toGraph x == foldg G.Empty G.Vertex G.Overlay G.Connect x 619 620 test "foldg == Algebra.Graph.foldg . toGraph" $ \e (apply -> v) (applyFun2 -> o) (applyFun2 -> c) x -> 621 foldg e v o c x == (G.foldg (e :: Int) v o c . toGraph) x 622 623 test "isEmpty == foldg True (const False) (&&) (&&)" $ \x -> 624 isEmpty x == foldg True (const False) (&&) (&&) x 625 626 test "size == foldg 1 (const 1) (+) (+)" $ \x -> 627 size x == foldg 1 (const 1) (+) (+) x 628 629 test "hasVertex x == foldg False (==x) (||) (||)" $ \x y -> 630 hasVertex x y == foldg False (==x) (||) (||) y 631 632 test "hasEdge x y == Algebra.Graph.hasEdge x y . toGraph" $ \x y z -> 633 hasEdge x y z == (G.hasEdge x y . toGraph) z 634 635 test "vertexCount == Set.size . vertexSet" $ \x -> 636 vertexCount x == (Set.size . vertexSet) x 637 638 test "edgeCount == Set.size . edgeSet" $ \x -> 639 edgeCount x == (Set.size . edgeSet) x 640 641 test "vertexList == Set.toAscList . vertexSet" $ \x -> 642 vertexList x == (Set.toAscList . vertexSet) x 643 644 test "edgeList == Set.toAscList . edgeSet" $ \x -> 645 edgeList x == (Set.toAscList . edgeSet) x 646 647 test "vertexSet == foldg Set.empty Set.singleton Set.union Set.union" $ \x -> 648 vertexSet x == foldg Set.empty Set.singleton Set.union Set.union x 649 650 test "vertexIntSet == foldg IntSet.empty IntSet.singleton IntSet.union IntSet.union" $ \x -> 651 vertexIntSet x == foldg IntSet.empty IntSet.singleton IntSet.union IntSet.union x 652 653 test "edgeSet == Algebra.Graph.AdjacencyMap.edgeSet . foldg empty vertex overlay connect" $ \x -> 654 edgeSet x == (AM.edgeSet . foldg AM.empty AM.vertex AM.overlay AM.connect) x 655 656 test "preSet x == Algebra.Graph.AdjacencyMap.preSet x . toAdjacencyMap" $ \x y -> 657 preSet x y == (AM.preSet x . toAdjacencyMap) y 658 659 test "preIntSet x == Algebra.Graph.AdjacencyIntMap.preIntSet x . toAdjacencyIntMap" $ \x y -> 660 preIntSet x y == (AIM.preIntSet x . toAdjacencyIntMap) y 661 662 test "postSet x == Algebra.Graph.AdjacencyMap.postSet x . toAdjacencyMap" $ \x y -> 663 postSet x y == (AM.postSet x . toAdjacencyMap) y 664 665 test "postIntSet x == Algebra.Graph.AdjacencyIntMap.postIntSet x . toAdjacencyIntMap" $ \x y -> 666 postIntSet x y == (AIM.postIntSet x . toAdjacencyIntMap) y 667 668 test "adjacencyList == Algebra.Graph.AdjacencyMap.adjacencyList . toAdjacencyMap" $ \x -> 669 adjacencyList x == (AM.adjacencyList . toAdjacencyMap) x 670 671 test "adjacencyMap == Algebra.Graph.AdjacencyMap.adjacencyMap . toAdjacencyMap" $ \x -> 672 adjacencyMap x == (AM.adjacencyMap . toAdjacencyMap) x 673 674 test "adjacencyIntMap == Algebra.Graph.AdjacencyIntMap.adjacencyIntMap . toAdjacencyIntMap" $ \x -> 675 adjacencyIntMap x == (AIM.adjacencyIntMap . toAdjacencyIntMap) x 676 677 test "adjacencyMapTranspose == Algebra.Graph.AdjacencyMap.adjacencyMap . toAdjacencyMapTranspose" $ \x -> 678 adjacencyMapTranspose x == (AM.adjacencyMap . toAdjacencyMapTranspose) x 679 680 test "adjacencyIntMapTranspose == Algebra.Graph.AdjacencyIntMap.adjacencyIntMap . toAdjacencyIntMapTranspose" $ \x -> 681 adjacencyIntMapTranspose x == (AIM.adjacencyIntMap . toAdjacencyIntMapTranspose) x 682 683 test "dfsForest == Algebra.Graph.AdjacencyMap.dfsForest . toAdjacencyMap" $ \x -> 684 dfsForest x == (AM.dfsForest . toAdjacencyMap) x 685 686 test "dfsForestFrom vs == Algebra.Graph.AdjacencyMap.dfsForestFrom vs . toAdjacencyMap" $ \vs x -> 687 dfsForestFrom vs x == (AM.dfsForestFrom vs . toAdjacencyMap) x 688 689 test "dfs vs == Algebra.Graph.AdjacencyMap.dfs vs . toAdjacencyMap" $ \vs x -> 690 dfs vs x == (AM.dfs vs . toAdjacencyMap) x 691 692 test "reachable x == Algebra.Graph.AdjacencyMap.reachable x . toAdjacencyMap" $ \x y -> 693 reachable x y == (AM.reachable x . toAdjacencyMap) y 694 695 test "topSort == Algebra.Graph.AdjacencyMap.topSort . toAdjacencyMap" $ \x -> 696 topSort x == (AM.topSort . toAdjacencyMap) x 697 698 test "isAcyclic == Algebra.Graph.AdjacencyMap.isAcyclic . toAdjacencyMap" $ \x -> 699 isAcyclic x == (AM.isAcyclic . toAdjacencyMap) x 700 701 test "isTopSortOf vs == Algebra.Graph.AdjacencyMap.isTopSortOf vs . toAdjacencyMap" $ \vs x -> 702 isTopSortOf vs x == (AM.isTopSortOf vs . toAdjacencyMap) x 703 704 test "toAdjacencyMap == foldg empty vertex overlay connect" $ \x -> 705 toAdjacencyMap x == foldg AM.empty AM.vertex AM.overlay AM.connect x 706 707 test "toAdjacencyMapTranspose == foldg empty vertex overlay (flip connect)" $ \x -> 708 toAdjacencyMapTranspose x == foldg AM.empty AM.vertex AM.overlay (flip AM.connect) x 709 710 test "toAdjacencyIntMap == foldg empty vertex overlay connect" $ \x -> 711 toAdjacencyIntMap x == foldg AIM.empty AIM.vertex AIM.overlay AIM.connect x 712 713 test "toAdjacencyIntMapTranspose == foldg empty vertex overlay (flip connect)" $ \x -> 714 toAdjacencyIntMapTranspose x == foldg AIM.empty AIM.vertex AIM.overlay (flip AIM.connect) x 715 716 test "isDfsForestOf f == Algebra.Graph.AdjacencyMap.isDfsForestOf f . toAdjacencyMap" $ \f x -> 717 isDfsForestOf f x == (AM.isDfsForestOf f . toAdjacencyMap) x 718 719 test "isTopSortOf vs == Algebra.Graph.AdjacencyMap.isTopSortOf vs . toAdjacencyMap" $ \vs x -> 720 isTopSortOf vs x == (AM.isTopSortOf vs . toAdjacencyMap) x 721 722-- TODO: We currently do not test 'edgeSet'. 723testSymmetricToGraphDefault :: TestsuiteInt g -> IO () 724testSymmetricToGraphDefault (prefix, API{..}) = do 725 putStrLn $ "\n============ " ++ prefix ++ "toGraph et al. ============" 726 test "toGraph == foldg Empty Vertex Overlay Connect" $ \x -> 727 toGraph x == foldg G.Empty G.Vertex G.Overlay G.Connect x 728 729 test "foldg == Algebra.Graph.foldg . toGraph" $ \e (apply -> v) (applyFun2 -> o) (applyFun2 -> c) x -> 730 foldg e v o c x == (G.foldg (e :: Int) v o c . toGraph) x 731 732 test "isEmpty == foldg True (const False) (&&) (&&)" $ \x -> 733 isEmpty x == foldg True (const False) (&&) (&&) x 734 735 test "size == foldg 1 (const 1) (+) (+)" $ \x -> 736 size x == foldg 1 (const 1) (+) (+) x 737 738 test "hasVertex x == foldg False (==x) (||) (||)" $ \x y -> 739 hasVertex x y == foldg False (==x) (||) (||) y 740 741 test "hasEdge x y == Algebra.Graph.hasEdge x y . toGraph" $ \x y z -> 742 hasEdge x y z == (G.hasEdge x y . toGraph) z 743 744 test "vertexCount == Set.size . vertexSet" $ \x -> 745 vertexCount x == (Set.size . vertexSet) x 746 747 test "edgeCount == Set.size . edgeSet" $ \x -> 748 edgeCount x == (Set.size . edgeSet) x 749 750 test "vertexList == Set.toAscList . vertexSet" $ \x -> 751 vertexList x == (Set.toAscList . vertexSet) x 752 753 test "edgeList == Set.toAscList . edgeSet" $ \x -> 754 edgeList x == (Set.toAscList . edgeSet) x 755 756 test "vertexSet == foldg Set.empty Set.singleton Set.union Set.union" $ \x -> 757 vertexSet x == foldg Set.empty Set.singleton Set.union Set.union x 758 759 test "vertexIntSet == foldg IntSet.empty IntSet.singleton IntSet.union IntSet.union" $ \x -> 760 vertexIntSet x == foldg IntSet.empty IntSet.singleton IntSet.union IntSet.union x 761 762 test "adjacencyList == Algebra.Graph.AdjacencyMap.adjacencyList . toAdjacencyMap" $ \x -> 763 adjacencyList x == (AM.adjacencyList . toAdjacencyMap) x 764 765 test "adjacencyMap == Algebra.Graph.AdjacencyMap.adjacencyMap . toAdjacencyMap" $ \x -> 766 adjacencyMap x == (AM.adjacencyMap . toAdjacencyMap) x 767 768 test "adjacencyIntMap == Algebra.Graph.AdjacencyIntMap.adjacencyIntMap . toAdjacencyIntMap" $ \x -> 769 adjacencyIntMap x == (AIM.adjacencyIntMap . toAdjacencyIntMap) x 770 771 test "adjacencyMapTranspose == Algebra.Graph.AdjacencyMap.adjacencyMap . toAdjacencyMapTranspose" $ \x -> 772 adjacencyMapTranspose x == (AM.adjacencyMap . toAdjacencyMapTranspose) x 773 774 test "adjacencyIntMapTranspose == Algebra.Graph.AdjacencyIntMap.adjacencyIntMap . toAdjacencyIntMapTranspose" $ \x -> 775 adjacencyIntMapTranspose x == (AIM.adjacencyIntMap . toAdjacencyIntMapTranspose) x 776 777 test "dfsForest == Algebra.Graph.AdjacencyMap.dfsForest . toAdjacencyMap" $ \x -> 778 dfsForest x == (AM.dfsForest . toAdjacencyMap) x 779 780 test "dfsForestFrom vs == Algebra.Graph.AdjacencyMap.dfsForestFrom vs . toAdjacencyMap" $ \vs x -> 781 dfsForestFrom vs x == (AM.dfsForestFrom vs . toAdjacencyMap) x 782 783 test "dfs vs == Algebra.Graph.AdjacencyMap.dfs vs . toAdjacencyMap" $ \vs x -> 784 dfs vs x == (AM.dfs vs . toAdjacencyMap) x 785 786 test "reachable x == Algebra.Graph.AdjacencyMap.reachable x . toAdjacencyMap" $ \x y -> 787 reachable x y == (AM.reachable x . toAdjacencyMap) y 788 789 test "topSort == Algebra.Graph.AdjacencyMap.topSort . toAdjacencyMap" $ \x -> 790 topSort x == (AM.topSort . toAdjacencyMap) x 791 792 test "isAcyclic == Algebra.Graph.AdjacencyMap.isAcyclic . toAdjacencyMap" $ \x -> 793 isAcyclic x == (AM.isAcyclic . toAdjacencyMap) x 794 795 test "isTopSortOf vs == Algebra.Graph.AdjacencyMap.isTopSortOf vs . toAdjacencyMap" $ \vs x -> 796 isTopSortOf vs x == (AM.isTopSortOf vs . toAdjacencyMap) x 797 798 test "toAdjacencyMap == foldg empty vertex overlay connect" $ \x -> 799 toAdjacencyMap x == foldg AM.empty AM.vertex AM.overlay AM.connect x 800 801 test "toAdjacencyMapTranspose == foldg empty vertex overlay (flip connect)" $ \x -> 802 toAdjacencyMapTranspose x == foldg AM.empty AM.vertex AM.overlay (flip AM.connect) x 803 804 test "toAdjacencyIntMap == foldg empty vertex overlay connect" $ \x -> 805 toAdjacencyIntMap x == foldg AIM.empty AIM.vertex AIM.overlay AIM.connect x 806 807 test "toAdjacencyIntMapTranspose == foldg empty vertex overlay (flip connect)" $ \x -> 808 toAdjacencyIntMapTranspose x == foldg AIM.empty AIM.vertex AIM.overlay (flip AIM.connect) x 809 810 test "isDfsForestOf f == Algebra.Graph.AdjacencyMap.isDfsForestOf f . toAdjacencyMap" $ \f x -> 811 isDfsForestOf f x == (AM.isDfsForestOf f . toAdjacencyMap) x 812 813 test "isTopSortOf vs == Algebra.Graph.AdjacencyMap.isTopSortOf vs . toAdjacencyMap" $ \vs x -> 814 isTopSortOf vs x == (AM.isTopSortOf vs . toAdjacencyMap) x 815 816testFoldg :: TestsuiteInt g -> IO () 817testFoldg (prefix, API{..}) = do 818 putStrLn $ "\n============ " ++ prefix ++ "foldg ============" 819 test "foldg empty vertex overlay connect == id" $ \x -> 820 foldg empty vertex overlay connect x == id x 821 822 test "foldg empty vertex overlay (flip connect) == transpose" $ \x -> 823 foldg empty vertex overlay (flip connect) x == transpose x 824 825 test "foldg 1 (const 1) (+) (+) == size" $ \x -> 826 foldg 1 (const 1) (+) (+) x == size x 827 828 test "foldg True (const False) (&&) (&&) == isEmpty" $ \x -> 829 foldg True (const False) (&&) (&&) x == isEmpty x 830 831testIsEmpty :: TestsuiteInt g -> IO () 832testIsEmpty (prefix, API{..}) = do 833 putStrLn $ "\n============ " ++ prefix ++ "isEmpty ============" 834 test "isEmpty empty == True" $ 835 isEmpty empty == True 836 837 test "isEmpty (overlay empty empty) == True" $ 838 isEmpty (overlay empty empty) == True 839 840 test "isEmpty (vertex x) == False" $ \x -> 841 isEmpty (vertex x) == False 842 843 test "isEmpty (removeVertex x $ vertex x) == True" $ \x -> 844 isEmpty (removeVertex x $ vertex x) == True 845 846 test "isEmpty (removeEdge x y $ edge x y) == False" $ \x y -> 847 isEmpty (removeEdge x y $ edge x y) == False 848 849testSize :: TestsuiteInt g -> IO () 850testSize (prefix, API{..}) = do 851 putStrLn $ "\n============ " ++ prefix ++ "size ============" 852 test "size empty == 1" $ 853 size empty == 1 854 855 test "size (vertex x) == 1" $ \x -> 856 size (vertex x) == 1 857 858 test "size (overlay x y) == size x + size y" $ \x y -> 859 size (overlay x y) == size x + size y 860 861 test "size (connect x y) == size x + size y" $ \x y -> 862 size (connect x y) == size x + size y 863 864 test "size x >= 1" $ \x -> 865 size x >= 1 866 867 test "size x >= vertexCount x" $ \x -> 868 size x >= vertexCount x 869 870testHasVertex :: TestsuiteInt g -> IO () 871testHasVertex (prefix, API{..}) = do 872 putStrLn $ "\n============ " ++ prefix ++ "hasVertex ============" 873 test "hasVertex x empty == False" $ \x -> 874 hasVertex x empty == False 875 876 test "hasVertex x (vertex y) == (x == y)" $ \x y -> 877 hasVertex x (vertex y) == (x == y) 878 879 test "hasVertex x . removeVertex x == const False" $ \x y -> 880 (hasVertex x . removeVertex x) y == const False y 881 882testHasEdge :: TestsuiteInt g -> IO () 883testHasEdge (prefix, API{..}) = do 884 putStrLn $ "\n============ " ++ prefix ++ "hasEdge ============" 885 test "hasEdge x y empty == False" $ \x y -> 886 hasEdge x y empty == False 887 888 test "hasEdge x y (vertex z) == False" $ \x y z -> 889 hasEdge x y (vertex z) == False 890 891 test "hasEdge x y (edge x y) == True" $ \x y -> 892 hasEdge x y (edge x y) == True 893 894 test "hasEdge x y . removeEdge x y == const False" $ \x y z -> 895 (hasEdge x y . removeEdge x y) z == const False z 896 897 test "hasEdge x y == elem (x,y) . edgeList" $ \x y z -> do 898 let es = edgeList z 899 (x, y) <- elements ((x, y) : es) 900 return $ hasEdge x y z == elem (x, y) es 901 902testSymmetricHasEdge :: TestsuiteInt g -> IO () 903testSymmetricHasEdge (prefix, API{..}) = do 904 putStrLn $ "\n============ " ++ prefix ++ "hasEdge ============" 905 test "hasEdge x y empty == False" $ \x y -> 906 hasEdge x y empty == False 907 908 test "hasEdge x y (vertex z) == False" $ \x y z -> 909 hasEdge x y (vertex z) == False 910 911 test "hasEdge x y (edge x y) == True" $ \x y -> 912 hasEdge x y (edge x y) == True 913 914 test "hasEdge x y (edge y x) == True" $ \x y -> 915 hasEdge x y (edge y x) == True 916 917 test "hasEdge x y . removeEdge x y == const False" $ \x y z -> 918 (hasEdge x y . removeEdge x y) z == const False z 919 920 test "hasEdge x y == elem (min x y, max x y) . edgeList" $ \x y z -> do 921 (u, v) <- elements ((x, y) : edgeList z) 922 return $ hasEdge u v z == elem (min u v, max u v) (edgeList z) 923 924testVertexCount :: TestsuiteInt g -> IO () 925testVertexCount (prefix, API{..}) = do 926 putStrLn $ "\n============ " ++ prefix ++ "vertexCount ============" 927 test "vertexCount empty == 0" $ 928 vertexCount empty == 0 929 930 test "vertexCount (vertex x) == 1" $ \x -> 931 vertexCount (vertex x) == 1 932 933 test "vertexCount == length . vertexList" $ \x -> 934 vertexCount x == (length . vertexList) x 935 936 test "vertexCount x < vertexCount y ==> x < y" $ \x y -> 937 if vertexCount x < vertexCount y 938 then property (x < y) 939 else (vertexCount x > vertexCount y ==> x > y) 940 941testEdgeCount :: TestsuiteInt g -> IO () 942testEdgeCount (prefix, API{..}) = do 943 putStrLn $ "\n============ " ++ prefix ++ "edgeCount ============" 944 test "edgeCount empty == 0" $ 945 edgeCount empty == 0 946 947 test "edgeCount (vertex x) == 0" $ \x -> 948 edgeCount (vertex x) == 0 949 950 test "edgeCount (edge x y) == 1" $ \x y -> 951 edgeCount (edge x y) == 1 952 953 test "edgeCount == length . edgeList" $ \x -> 954 edgeCount x == (length . edgeList) x 955 956testVertexList :: TestsuiteInt g -> IO () 957testVertexList (prefix, API{..}) = do 958 putStrLn $ "\n============ " ++ prefix ++ "vertexList ============" 959 test "vertexList empty == []" $ 960 vertexList empty == [] 961 962 test "vertexList (vertex x) == [x]" $ \x -> 963 vertexList (vertex x) == [x] 964 965 test "vertexList . vertices == nub . sort" $ \xs -> 966 (vertexList . vertices) xs == (nubOrd . sort) xs 967 968testEdgeList :: TestsuiteInt g -> IO () 969testEdgeList (prefix, API{..}) = do 970 putStrLn $ "\n============ " ++ prefix ++ "edgeList ============" 971 test "edgeList empty == []" $ 972 edgeList empty == [] 973 974 test "edgeList (vertex x) == []" $ \x -> 975 edgeList (vertex x) == [] 976 977 test "edgeList (edge x y) == [(x,y)]" $ \x y -> 978 edgeList (edge x y) == [(x,y)] 979 980 test "edgeList (star 2 [3,1]) == [(2,1), (2,3)]" $ 981 edgeList (star 2 [3,1]) == [(2,1), (2,3)] 982 983 test "edgeList . edges == nub . sort" $ \xs -> 984 (edgeList . edges) xs == (nubOrd . sort) xs 985 986testSymmetricEdgeList :: TestsuiteInt g -> IO () 987testSymmetricEdgeList (prefix, API{..}) = do 988 putStrLn $ "\n============ " ++ prefix ++ "edgeList ============" 989 test "edgeList empty == []" $ 990 edgeList empty == [] 991 992 test "edgeList (vertex x) == []" $ \x -> 993 edgeList (vertex x) == [] 994 995 test "edgeList (edge x y) == [(min x y, max y x)]" $ \x y -> 996 edgeList (edge x y) == [(min x y, max y x)] 997 998 test "edgeList (star 2 [3,1]) == [(1,2), (2,3)]" $ 999 edgeList (star 2 [3,1]) == [(1,2), (2,3)] 1000 1001testAdjacencyList :: TestsuiteInt g -> IO () 1002testAdjacencyList (prefix, API{..}) = do 1003 putStrLn $ "\n============ " ++ prefix ++ "adjacencyList ============" 1004 test "adjacencyList empty == []" $ 1005 adjacencyList empty == [] 1006 1007 test "adjacencyList (vertex x) == [(x, [])]" $ \x -> 1008 adjacencyList (vertex x) == [(x, [])] 1009 1010 test "adjacencyList (edge 1 2) == [(1, [2]), (2, [])]" $ 1011 adjacencyList (edge 1 2) == [(1, [2]), (2, [])] 1012 1013 test "adjacencyList (star 2 [3,1]) == [(1, []), (2, [1,3]), (3, [])]" $ 1014 adjacencyList (star 2 [3,1]) == [(1, []), (2, [1,3]), (3, [])] 1015 1016testSymmetricAdjacencyList :: TestsuiteInt g -> IO () 1017testSymmetricAdjacencyList (prefix, API{..}) = do 1018 putStrLn $ "\n============ " ++ prefix ++ "adjacencyList ============" 1019 test "adjacencyList empty == []" $ 1020 adjacencyList empty == [] 1021 1022 test "adjacencyList (vertex x) == [(x, [])]" $ \x -> 1023 adjacencyList (vertex x) == [(x, [])] 1024 1025 test "adjacencyList (edge 1 2) == [(1, [2]), (2, [1])]" $ 1026 adjacencyList (edge 1 2) == [(1, [2]), (2, [1])] 1027 1028 test "adjacencyList (star 2 [3,1]) == [(1, [2]), (2, [1,3]), (3, [2])]" $ 1029 adjacencyList (star 2 [3,1]) == [(1, [2]), (2, [1,3]), (3, [2])] 1030 1031testVertexSet :: TestsuiteInt g -> IO () 1032testVertexSet (prefix, API{..}) = do 1033 putStrLn $ "\n============ " ++ prefix ++ "vertexSet ============" 1034 test "vertexSet empty == Set.empty" $ 1035 vertexSet empty == Set.empty 1036 1037 test "vertexSet . vertex == Set.singleton" $ \x -> 1038 (vertexSet . vertex) x == Set.singleton x 1039 1040 test "vertexSet . vertices == Set.fromList" $ \xs -> 1041 (vertexSet . vertices) xs == Set.fromList xs 1042 1043testVertexIntSet :: TestsuiteInt g -> IO () 1044testVertexIntSet (prefix, API{..}) = do 1045 putStrLn $ "\n============ " ++ prefix ++ "vertexIntSet ============" 1046 test "vertexIntSet empty == IntSet.empty" $ 1047 vertexIntSet empty == IntSet.empty 1048 1049 test "vertexIntSet . vertex == IntSet.singleton" $ \x -> 1050 (vertexIntSet . vertex) x == IntSet.singleton x 1051 1052 test "vertexIntSet . vertices == IntSet.fromList" $ \xs -> 1053 (vertexIntSet . vertices) xs == IntSet.fromList xs 1054 1055 test "vertexIntSet . clique == IntSet.fromList" $ \xs -> 1056 (vertexIntSet . clique) xs == IntSet.fromList xs 1057 1058testEdgeSet :: TestsuiteInt g -> IO () 1059testEdgeSet (prefix, API{..}) = do 1060 putStrLn $ "\n============ " ++ prefix ++ "edgeSet ============" 1061 test "edgeSet empty == Set.empty" $ 1062 edgeSet empty == Set.empty 1063 1064 test "edgeSet (vertex x) == Set.empty" $ \x -> 1065 edgeSet (vertex x) == Set.empty 1066 1067 test "edgeSet (edge x y) == Set.singleton (x,y)" $ \x y -> 1068 edgeSet (edge x y) == Set.singleton (x,y) 1069 1070 test "edgeSet . edges == Set.fromList" $ \xs -> 1071 (edgeSet . edges) xs == Set.fromList xs 1072 1073testSymmetricEdgeSet :: TestsuiteInt g -> IO () 1074testSymmetricEdgeSet (prefix, API{..}) = do 1075 putStrLn $ "\n============ " ++ prefix ++ "edgeSet ============" 1076 test "edgeSet empty == Set.empty" $ 1077 edgeSet empty == Set.empty 1078 1079 test "edgeSet (vertex x) == Set.empty" $ \x -> 1080 edgeSet (vertex x) == Set.empty 1081 1082 test "edgeSet (edge x y) == Set.singleton (min x y, max x y)" $ \x y -> 1083 edgeSet (edge x y) == Set.singleton (min x y, max x y) 1084 1085testPreSet :: TestsuiteInt g -> IO () 1086testPreSet (prefix, API{..}) = do 1087 putStrLn $ "\n============ " ++ prefix ++ "preSet ============" 1088 test "preSet x empty == Set.empty" $ \x -> 1089 preSet x empty == Set.empty 1090 1091 test "preSet x (vertex x) == Set.empty" $ \x -> 1092 preSet x (vertex x) == Set.empty 1093 1094 test "preSet 1 (edge 1 2) == Set.empty" $ 1095 preSet 1 (edge 1 2) == Set.empty 1096 1097 test "preSet y (edge x y) == Set.fromList [x]" $ \x y -> 1098 preSet y (edge x y) == Set.fromList [x] 1099 1100testPostSet :: TestsuiteInt g -> IO () 1101testPostSet (prefix, API{..}) = do 1102 putStrLn $ "\n============ " ++ prefix ++ "postSet ============" 1103 test "postSet x empty == Set.empty" $ \x -> 1104 postSet x empty == Set.empty 1105 1106 test "postSet x (vertex x) == Set.empty" $ \x -> 1107 postSet x (vertex x) == Set.empty 1108 1109 test "postSet x (edge x y) == Set.fromList [y]" $ \x y -> 1110 postSet x (edge x y) == Set.fromList [y] 1111 1112 test "postSet 2 (edge 1 2) == Set.empty" $ 1113 postSet 2 (edge 1 2) == Set.empty 1114 1115testPreIntSet :: TestsuiteInt g -> IO () 1116testPreIntSet (prefix, API{..}) = do 1117 putStrLn $ "\n============ " ++ prefix ++ "preIntSet ============" 1118 test "preIntSet x empty == IntSet.empty" $ \x -> 1119 preIntSet x empty == IntSet.empty 1120 1121 test "preIntSet x (vertex x) == IntSet.empty" $ \x -> 1122 preIntSet x (vertex x) == IntSet.empty 1123 1124 test "preIntSet 1 (edge 1 2) == IntSet.empty" $ 1125 preIntSet 1 (edge 1 2) == IntSet.empty 1126 1127 test "preIntSet y (edge x y) == IntSet.fromList [x]" $ \x y -> 1128 preIntSet y (edge x y) == IntSet.fromList [x] 1129 1130testPostIntSet :: TestsuiteInt g -> IO () 1131testPostIntSet (prefix, API{..}) = do 1132 putStrLn $ "\n============ " ++ prefix ++ "postIntSet ============" 1133 test "postIntSet x empty == IntSet.empty" $ \x -> 1134 postIntSet x empty == IntSet.empty 1135 1136 test "postIntSet x (vertex x) == IntSet.empty" $ \x -> 1137 postIntSet x (vertex x) == IntSet.empty 1138 1139 test "postIntSet 2 (edge 1 2) == IntSet.empty" $ 1140 postIntSet 2 (edge 1 2) == IntSet.empty 1141 1142 test "postIntSet x (edge x y) == IntSet.fromList [y]" $ \x y -> 1143 postIntSet x (edge x y) == IntSet.fromList [y] 1144 1145testNeighbours :: TestsuiteInt g -> IO () 1146testNeighbours (prefix, API{..}) = do 1147 putStrLn $ "\n============ " ++ prefix ++ "neighbours ============" 1148 test "neighbours x empty == Set.empty" $ \x -> 1149 neighbours x empty == Set.empty 1150 1151 test "neighbours x (vertex x) == Set.empty" $ \x -> 1152 neighbours x (vertex x) == Set.empty 1153 1154 test "neighbours x (edge x y) == Set.fromList [y]" $ \x y -> 1155 neighbours x (edge x y) == Set.fromList [y] 1156 1157 test "neighbours y (edge x y) == Set.fromList [x]" $ \x y -> 1158 neighbours y (edge x y) == Set.fromList [x] 1159 1160testPath :: TestsuiteInt g -> IO () 1161testPath (prefix, API{..}) = do 1162 putStrLn $ "\n============ " ++ prefix ++ "path ============" 1163 test "path [] == empty" $ 1164 path [] == empty 1165 1166 test "path [x] == vertex x" $ \x -> 1167 path [x] == vertex x 1168 1169 test "path [x,y] == edge x y" $ \x y -> 1170 path [x,y] == edge x y 1171 1172testSymmetricPath :: TestsuiteInt g -> IO () 1173testSymmetricPath t@(_, API{..}) = do 1174 testPath t 1175 test "path == path . reverse" $ \xs -> 1176 path xs ==(path . reverse) xs 1177 1178testCircuit :: TestsuiteInt g -> IO () 1179testCircuit (prefix, API{..}) = do 1180 putStrLn $ "\n============ " ++ prefix ++ "circuit ============" 1181 test "circuit [] == empty" $ 1182 circuit [] == empty 1183 1184 test "circuit [x] == edge x x" $ \x -> 1185 circuit [x] == edge x x 1186 1187 test "circuit [x,y] == edges [(x,y), (y,x)]" $ \x y -> 1188 circuit [x,y] == edges [(x,y), (y,x)] 1189 1190testSymmetricCircuit :: TestsuiteInt g -> IO () 1191testSymmetricCircuit t@(_, API{..}) = do 1192 testCircuit t 1193 test "circuit == circuit . reverse" $ \xs -> 1194 circuit xs ==(circuit . reverse) xs 1195 1196testClique :: TestsuiteInt g -> IO () 1197testClique (prefix, API{..}) = do 1198 putStrLn $ "\n============ " ++ prefix ++ "clique ============" 1199 test "clique [] == empty" $ 1200 clique [] == empty 1201 1202 test "clique [x] == vertex x" $ \x -> 1203 clique [x] == vertex x 1204 1205 test "clique [x,y] == edge x y" $ \x y -> 1206 clique [x,y] == edge x y 1207 1208 test "clique [x,y,z] == edges [(x,y), (x,z), (y,z)]" $ \x y z -> 1209 clique [x,y,z] == edges [(x,y), (x,z), (y,z)] 1210 1211 test "clique (xs ++ ys) == connect (clique xs) (clique ys)" $ \xs ys -> 1212 clique (xs ++ ys) == connect (clique xs) (clique ys) 1213 1214testSymmetricClique :: TestsuiteInt g -> IO () 1215testSymmetricClique t@(_, API{..}) = do 1216 testClique t 1217 test "clique == clique . reverse" $ \xs-> 1218 clique xs ==(clique . reverse) xs 1219 1220testBiclique :: TestsuiteInt g -> IO () 1221testBiclique (prefix, API{..}) = do 1222 putStrLn $ "\n============ " ++ prefix ++ "biclique ============" 1223 test "biclique [] [] == empty" $ 1224 biclique [] [] == empty 1225 1226 test "biclique [x] [] == vertex x" $ \x -> 1227 biclique [x] [] == vertex x 1228 1229 test "biclique [] [y] == vertex y" $ \y -> 1230 biclique [] [y] == vertex y 1231 1232 test "biclique [x1,x2] [y1,y2] == edges [(x1,y1), (x1,y2), (x2,y1), (x2,y2)]" $ \x1 x2 y1 y2 -> 1233 biclique [x1,x2] [y1,y2] == edges [(x1,y1), (x1,y2), (x2,y1), (x2,y2)] 1234 1235 test "biclique xs ys == connect (vertices xs) (vertices ys)" $ \xs ys -> 1236 biclique xs ys == connect (vertices xs) (vertices ys) 1237 1238testStar :: TestsuiteInt g -> IO () 1239testStar (prefix, API{..}) = do 1240 putStrLn $ "\n============ " ++ prefix ++ "star ============" 1241 test "star x [] == vertex x" $ \x -> 1242 star x [] == vertex x 1243 1244 test "star x [y] == edge x y" $ \x y -> 1245 star x [y] == edge x y 1246 1247 test "star x [y,z] == edges [(x,y), (x,z)]" $ \x y z -> 1248 star x [y,z] == edges [(x,y), (x,z)] 1249 1250 test "star x ys == connect (vertex x) (vertices ys)" $ \x ys -> 1251 star x ys == connect (vertex x) (vertices ys) 1252 1253testTree :: TestsuiteInt g -> IO () 1254testTree (prefix, API{..}) = do 1255 putStrLn $ "\n============ " ++ prefix ++ "tree ============" 1256 test "tree (Node x []) == vertex x" $ \x -> 1257 tree (Node x []) == vertex x 1258 1259 test "tree (Node x [Node y [Node z []]]) == path [x,y,z]" $ \x y z -> 1260 tree (Node x [Node y [Node z []]]) == path [x,y,z] 1261 1262 test "tree (Node x [Node y [], Node z []]) == star x [y,z]" $ \x y z -> 1263 tree (Node x [Node y [], Node z []]) == star x [y,z] 1264 1265 test "tree (Node 1 [Node 2 [], Node 3 [Node 4 [], Node 5 []]]) == edges [(1,2), (1,3), (3,4), (3,5)]" $ 1266 tree (Node 1 [Node 2 [], Node 3 [Node 4 [], Node 5 []]]) == edges [(1,2), (1,3), (3,4), (3,5)] 1267 1268testForest :: TestsuiteInt g -> IO () 1269testForest (prefix, API{..}) = do 1270 putStrLn $ "\n============ " ++ prefix ++ "forest ============" 1271 test "forest [] == empty" $ 1272 forest [] == empty 1273 1274 test "forest [x] == tree x" $ \x -> 1275 forest [x] == tree x 1276 1277 test "forest [Node 1 [Node 2 [], Node 3 []], Node 4 [Node 5 []]] == edges [(1,2), (1,3), (4,5)]" $ 1278 forest [Node 1 [Node 2 [], Node 3 []], Node 4 [Node 5 []]] == edges [(1,2), (1,3), (4,5)] 1279 1280 test "forest == overlays . map tree" $ \x -> 1281 forest x ==(overlays . map tree) x 1282 1283testMesh :: Testsuite g Ord -> IO () 1284testMesh (prefix, API{..}) = do 1285 putStrLn $ "\n============ " ++ prefix ++ "mesh ============" 1286 test "mesh xs [] == empty" $ \(xs :: [Int]) -> 1287 mesh xs ([] :: [Int]) == empty 1288 1289 test "mesh [] ys == empty" $ \(ys :: [Int]) -> 1290 mesh ([] :: [Int]) ys == empty 1291 1292 test "mesh [x] [y] == vertex (x, y)" $ \(x :: Int) (y :: Int) -> 1293 mesh [x] [y] == vertex (x, y) 1294 1295 test "mesh xs ys == box (path xs) (path ys)" $ \(xs :: [Int]) (ys :: [Int]) -> 1296 mesh xs ys == box (path xs) (path ys) 1297 1298 test "mesh [1..3] \"ab\" == <correct result>" $ 1299 mesh [1..3] "ab" == edges [ ((1,'a'),(1,'b')), ((1,'a'),(2,'a')), ((1,'b'),(2,'b')), ((2,'a'),(2,'b')) 1300 , ((2,'a'),(3,'a')), ((2,'b'),(3,'b')), ((3,'a'),(3 :: Int,'b')) ] 1301 1302 test "size (mesh xs ys) == max 1 (3 * length xs * length ys - length xs - length ys -1)" $ \(xs :: [Int]) (ys :: [Int]) -> 1303 size (mesh xs ys) == max 1 (3 * length xs * length ys - length xs - length ys -1) 1304 1305testTorus :: Testsuite g Ord -> IO () 1306testTorus (prefix, API{..}) = do 1307 putStrLn $ "\n============ " ++ prefix ++ "torus ============" 1308 test "torus xs [] == empty" $ \(xs :: [Int]) -> 1309 torus xs ([] :: [Int]) == empty 1310 1311 test "torus [] ys == empty" $ \(ys :: [Int]) -> 1312 torus ([] :: [Int]) ys == empty 1313 1314 test "torus [x] [y] == edge (x,y) (x,y)" $ \(x :: Int) (y :: Int) -> 1315 torus [x] [y] == edge (x,y) (x,y) 1316 1317 test "torus xs ys == box (circuit xs) (circuit ys)" $ \(xs :: [Int]) (ys :: [Int]) -> 1318 torus xs ys == box (circuit xs) (circuit ys) 1319 1320 test "torus [1,2] \"ab\" == <correct result>" $ 1321 torus [1,2] "ab" == edges [ ((1,'a'),(1,'b')), ((1,'a'),(2,'a')), ((1,'b'),(1,'a')), ((1,'b'),(2,'b')) 1322 , ((2,'a'),(1,'a')), ((2,'a'),(2,'b')), ((2,'b'),(1,'b')), ((2,'b'),(2 :: Int,'a')) ] 1323 1324 test "size (torus xs ys) == max 1 (3 * length xs * length ys)" $ \(xs :: [Int]) (ys :: [Int]) -> 1325 size (torus xs ys) == max 1 (3 * length xs * length ys) 1326 1327testDeBruijn :: Testsuite g Ord -> IO () 1328testDeBruijn (prefix, API{..}) = do 1329 putStrLn $ "\n============ " ++ prefix ++ "deBruijn ============" 1330 test " deBruijn 0 xs == edge [] []" $ \(xs :: [Int]) -> 1331 deBruijn 0 xs == edge [] [] 1332 1333 test "n > 0 ==> deBruijn n [] == empty" $ \n -> 1334 n > 0 ==> deBruijn n ([] :: [Int]) == empty 1335 1336 test " deBruijn 1 [0,1] == edges [ ([0],[0]), ([0],[1]), ([1],[0]), ([1],[1]) ]" $ 1337 deBruijn 1 [0,1::Int] == edges [ ([0],[0]), ([0],[1]), ([1],[0]), ([1],[1]) ] 1338 1339 test " deBruijn 2 \"0\" == edge \"00\" \"00\"" $ 1340 deBruijn 2 "0" == edge "00" "00" 1341 1342 test " deBruijn 2 \"01\" == <correct result>" $ 1343 deBruijn 2 "01" == edges [ ("00","00"), ("00","01"), ("01","10"), ("01","11") 1344 , ("10","00"), ("10","01"), ("11","10"), ("11","11") ] 1345 1346 test " transpose (deBruijn n xs) == gmap reverse $ deBruijn n xs" $ mapSize (min 5) $ \(NonNegative n) (xs :: [Int]) -> 1347 transpose (deBruijn n xs) == gmap reverse (deBruijn n xs) 1348 1349 test " vertexCount (deBruijn n xs) == (length $ nub xs)^n" $ mapSize (min 5) $ \(NonNegative n) (xs :: [Int]) -> 1350 vertexCount (deBruijn n xs) == (length $ nubOrd xs)^n 1351 1352 test "n > 0 ==> edgeCount (deBruijn n xs) == (length $ nub xs)^(n + 1)" $ mapSize (min 5) $ \(NonNegative n) (xs :: [Int]) -> 1353 n > 0 ==> edgeCount (deBruijn n xs) == (length $ nubOrd xs)^(n + 1) 1354 1355testBox :: Testsuite g Ord -> IO () 1356testBox (prefix, API{..}) = do 1357 putStrLn $ "\n============ " ++ prefix ++ "box ============" 1358 let unit = gmap $ \(a :: Int, () ) -> a 1359 comm = gmap $ \(a :: Int, b :: Int) -> (b, a) 1360 test "box x y ~~ box y x" $ mapSize (min 10) $ \x y -> 1361 comm (box x y) == box y x 1362 1363 test "box x (overlay y z) == overlay (box x y) (box x z)" $ mapSize (min 10) $ \x y z -> 1364 let _ = x + y + z + vertex (0 :: Int) in 1365 box x (overlay y z) == overlay (box x y) (box x z) 1366 1367 test "box x (vertex ()) ~~ x" $ mapSize (min 10) $ \x -> 1368 unit(box x (vertex ())) == (x `asTypeOf` empty) 1369 1370 test "box x empty ~~ empty" $ mapSize (min 10) $ \x -> 1371 unit(box x empty) == empty 1372 1373 let assoc = gmap $ \(a :: Int, (b :: Int, c :: Int)) -> ((a, b), c) 1374 test "box x (box y z) ~~ box (box x y) z" $ mapSize (min 10) $ \x y z -> 1375 assoc (box x (box y z)) == box (box x y) z 1376 1377 test "transpose (box x y) == box (transpose x) (transpose y)" $ mapSize (min 10) $ \x y -> 1378 let _ = x + y + vertex (0 :: Int) in 1379 transpose (box x y) == box (transpose x) (transpose y) 1380 1381 test "vertexCount (box x y) == vertexCount x * vertexCount y" $ mapSize (min 10) $ \x y -> 1382 let _ = x + y + vertex (0 :: Int) in 1383 vertexCount (box x y) == vertexCount x * vertexCount y 1384 1385 test "edgeCount (box x y) <= vertexCount x * edgeCount y + edgeCount x * vertexCount y" $ mapSize (min 10) $ \x y -> 1386 let _ = x + y + vertex (0 :: Int) in 1387 edgeCount (box x y) <= vertexCount x * edgeCount y + edgeCount x * vertexCount y 1388 1389testRemoveVertex :: TestsuiteInt g -> IO () 1390testRemoveVertex (prefix, API{..}) = do 1391 putStrLn $ "\n============ " ++ prefix ++ "removeVertex ============" 1392 test "removeVertex x (vertex x) == empty" $ \x -> 1393 removeVertex x (vertex x) == empty 1394 1395 test "removeVertex 1 (vertex 2) == vertex 2" $ 1396 removeVertex 1 (vertex 2) == vertex 2 1397 1398 test "removeVertex x (edge x x) == empty" $ \x -> 1399 removeVertex x (edge x x) == empty 1400 1401 test "removeVertex 1 (edge 1 2) == vertex 2" $ 1402 removeVertex 1 (edge 1 2) == vertex 2 1403 1404 test "removeVertex x . removeVertex x == removeVertex x" $ \x y -> 1405 (removeVertex x . removeVertex x) y == removeVertex x y 1406 1407testRemoveEdge :: TestsuiteInt g -> IO () 1408testRemoveEdge (prefix, API{..}) = do 1409 putStrLn $ "\n============ " ++ prefix ++ "removeEdge ============" 1410 test "removeEdge x y (edge x y) == vertices [x,y]" $ \x y -> 1411 removeEdge x y (edge x y) == vertices [x,y] 1412 1413 test "removeEdge x y . removeEdge x y == removeEdge x y" $ \x y z -> 1414 (removeEdge x y . removeEdge x y) z == removeEdge x y z 1415 1416 test "removeEdge x y . removeVertex x == removeVertex x" $ \x y z -> 1417 (removeEdge x y . removeVertex x) z == removeVertex x z 1418 1419 test "removeEdge 1 1 (1 * 1 * 2 * 2) == 1 * 2 * 2" $ 1420 removeEdge 1 1 (1 * 1 * 2 * 2) == 1 * 2 * 2 1421 1422 test "removeEdge 1 2 (1 * 1 * 2 * 2) == 1 * 1 + 2 * 2" $ 1423 removeEdge 1 2 (1 * 1 * 2 * 2) == 1 * 1 + 2 * 2 1424 1425 -- TODO: Ouch. Generic tests are becoming awkward. We need a better way. 1426 when (prefix == "Fold." || prefix == "Graph.") $ do 1427 test "size (removeEdge x y z) <= 3 * size z" $ \x y z -> 1428 size (removeEdge x y z) <= 3 * size z 1429 1430testSymmetricRemoveEdge :: TestsuiteInt g -> IO () 1431testSymmetricRemoveEdge t@(_, API{..}) = do 1432 testRemoveEdge t 1433 test "removeEdge x y == removeEdge y x" $ \x y z -> 1434 removeEdge x y z == removeEdge y x z 1435 1436testReplaceVertex :: TestsuiteInt g -> IO () 1437testReplaceVertex (prefix, API{..}) = do 1438 putStrLn $ "\n============ " ++ prefix ++ "replaceVertex ============" 1439 test "replaceVertex x x == id" $ \x y -> 1440 replaceVertex x x y == id y 1441 1442 test "replaceVertex x y (vertex x) == vertex y" $ \x y -> 1443 replaceVertex x y (vertex x) == vertex y 1444 1445 test "replaceVertex x y == mergeVertices (== x) y" $ \x y z -> 1446 replaceVertex x y z == mergeVertices (== x) y z 1447 1448testMergeVertices :: TestsuiteInt g -> IO () 1449testMergeVertices (prefix, API{..}) = do 1450 putStrLn $ "\n============ " ++ prefix ++ "mergeVertices ============" 1451 test "mergeVertices (const False) x == id" $ \x y -> 1452 mergeVertices (const False) x y == id y 1453 1454 test "mergeVertices (== x) y == replaceVertex x y" $ \x y z -> 1455 mergeVertices (== x) y z == replaceVertex x y z 1456 1457 test "mergeVertices even 1 (0 * 2) == 1 * 1" $ 1458 mergeVertices even 1 (0 * 2) == 1 * 1 1459 1460 test "mergeVertices odd 1 (3 + 4 * 5) == 4 * 1" $ 1461 mergeVertices odd 1 (3 + 4 * 5) == 4 * 1 1462 1463testTranspose :: TestsuiteInt g -> IO () 1464testTranspose (prefix, API{..}) = do 1465 putStrLn $ "\n============ " ++ prefix ++ "transpose ============" 1466 test "transpose empty == empty" $ 1467 transpose empty == empty 1468 1469 test "transpose (vertex x) == vertex x" $ \x -> 1470 transpose (vertex x) == vertex x 1471 1472 test "transpose (edge x y) == edge y x" $ \x y -> 1473 transpose (edge x y) == edge y x 1474 1475 test "transpose . transpose == id" $ size10 $ \x -> 1476 (transpose . transpose) x == id x 1477 1478 test "edgeList . transpose == sort . map swap . edgeList" $ \x -> 1479 (edgeList . transpose) x == (sort . map swap . edgeList) x 1480 1481testGmap :: TestsuiteInt g -> IO () 1482testGmap (prefix, API{..}) = do 1483 putStrLn $ "\n============ " ++ prefix ++ "gmap ============" 1484 test "gmap f empty == empty" $ \(apply -> f) -> 1485 gmap f empty == empty 1486 1487 test "gmap f (vertex x) == vertex (f x)" $ \(apply -> f) x -> 1488 gmap f (vertex x) == vertex (f x) 1489 1490 test "gmap f (edge x y) == edge (f x) (f y)" $ \(apply -> f) x y -> 1491 gmap f (edge x y) == edge (f x) (f y) 1492 1493 test "gmap id == id" $ \x -> 1494 gmap id x == id x 1495 1496 test "gmap f . gmap g == gmap (f . g)" $ \(apply -> f :: Int -> Int) (apply -> g :: Int -> Int) x -> 1497 (gmap f . gmap g) x == gmap (f . g) x 1498 1499testInduce :: TestsuiteInt g -> IO () 1500testInduce (prefix, API{..}) = do 1501 putStrLn $ "\n============ " ++ prefix ++ "induce ============" 1502 test "induce (const True ) x == x" $ \x -> 1503 induce (const True ) x == x 1504 1505 test "induce (const False) x == empty" $ \x -> 1506 induce (const False) x == empty 1507 1508 test "induce (/= x) == removeVertex x" $ \x y -> 1509 induce (/= x) y == removeVertex x y 1510 1511 test "induce p . induce q == induce (\\x -> p x && q x)" $ \(apply -> p) (apply -> q) y -> 1512 (induce p . induce q) y == induce (\x -> p x && q x) y 1513 1514 test "isSubgraphOf (induce p x) x == True" $ \(apply -> p) x -> 1515 isSubgraphOf (induce p x) x == True 1516 1517testInduceJust :: Testsuite g Ord -> IO () 1518testInduceJust (prefix, API{..}) = do 1519 putStrLn $ "\n============ " ++ prefix ++ "induceJust ============" 1520 test "induceJust (vertex Nothing) == empty" $ 1521 induceJust (vertex (Nothing :: Maybe Int)) == empty 1522 1523 test "induceJust (edge (Just x) Nothing) == vertex x" $ \x -> 1524 induceJust (edge (Just x) (Nothing :: Maybe Int)) == vertex x 1525 1526 test "induceJust . gmap Just == id" $ \(x :: g Int) -> 1527 (induceJust . gmap Just) x == id x 1528 1529 test "induceJust . gmap (\\x -> if p x then Just x else Nothing) == induce p" $ \(x :: g Int) (apply -> p) -> 1530 (induceJust . gmap (\x -> if p x then Just x else Nothing)) x == induce p x 1531 1532testCompose :: TestsuiteInt g -> IO () 1533testCompose (prefix, API{..}) = do 1534 putStrLn $ "\n============ " ++ prefix ++ "compose ============" 1535 test "compose empty x == empty" $ \x -> 1536 compose empty x == empty 1537 1538 test "compose x empty == empty" $ \x -> 1539 compose x empty == empty 1540 1541 test "compose (vertex x) y == empty" $ \x y -> 1542 compose (vertex x) y == empty 1543 1544 test "compose x (vertex y) == empty" $ \x y -> 1545 compose x (vertex y) == empty 1546 1547 test "compose x (compose y z) == compose (compose x y) z" $ size10 $ \x y z -> 1548 compose x (compose y z) == compose (compose x y) z 1549 1550 test "compose x (overlay y z) == overlay (compose x y) (compose x z)" $ size10 $ \x y z -> 1551 compose x (overlay y z) == overlay (compose x y) (compose x z) 1552 1553 test "compose (overlay x y) z == overlay (compose x z) (compose y z)" $ size10 $ \x y z -> 1554 compose (overlay x y) z == overlay (compose x z) (compose y z) 1555 1556 test "compose (edge x y) (edge y z) == edge x z" $ \x y z -> 1557 compose (edge x y) (edge y z) == edge x z 1558 1559 test "compose (path [1..5]) (path [1..5]) == edges [(1,3),(2,4),(3,5)]" $ 1560 compose (path [1..5]) (path [1..5]) == edges [(1,3),(2,4),(3,5)] 1561 1562 test "compose (circuit [1..5]) (circuit [1..5]) == circuit [1,3,5,2,4]" $ 1563 compose (circuit [1..5]) (circuit [1..5]) == circuit [1,3,5,2,4] 1564 1565testClosure :: TestsuiteInt g -> IO () 1566testClosure (prefix, API{..}) = do 1567 putStrLn $ "\n============ " ++ prefix ++ "closure ============" 1568 test "closure empty == empty" $ 1569 closure empty == empty 1570 1571 test "closure (vertex x) == edge x x" $ \x -> 1572 closure (vertex x) == edge x x 1573 1574 test "closure (edge x x) == edge x x" $ \x -> 1575 closure (edge x x) == edge x x 1576 1577 test "closure (edge x y) == edges [(x,x), (x,y), (y,y)]" $ \x y -> 1578 closure (edge x y) == edges [(x,x), (x,y), (y,y)] 1579 1580 test "closure (path $ nub xs) == reflexiveClosure (clique $ nub xs)" $ \xs -> 1581 closure (path $ nubOrd xs) == reflexiveClosure (clique $ nubOrd xs) 1582 1583 test "closure == reflexiveClosure . transitiveClosure" $ size10 $ \x -> 1584 closure x == (reflexiveClosure . transitiveClosure) x 1585 1586 test "closure == transitiveClosure . reflexiveClosure" $ size10 $ \x -> 1587 closure x == (transitiveClosure . reflexiveClosure) x 1588 1589 test "closure . closure == closure" $ size10 $ \x -> 1590 (closure . closure) x == closure x 1591 1592 test "postSet x (closure y) == Set.fromList (reachable x y)" $ size10 $ \x y -> 1593 postSet x (closure y) == Set.fromList (reachable x y) 1594 1595testReflexiveClosure :: TestsuiteInt g -> IO () 1596testReflexiveClosure (prefix, API{..}) = do 1597 putStrLn $ "\n============ " ++ prefix ++ "reflexiveClosure ============" 1598 test "reflexiveClosure empty == empty" $ 1599 reflexiveClosure empty == empty 1600 1601 test "reflexiveClosure (vertex x) == edge x x" $ \x -> 1602 reflexiveClosure (vertex x) == edge x x 1603 1604 test "reflexiveClosure (edge x x) == edge x x" $ \x -> 1605 reflexiveClosure (edge x x) == edge x x 1606 1607 test "reflexiveClosure (edge x y) == edges [(x,x), (x,y), (y,y)]" $ \x y -> 1608 reflexiveClosure (edge x y) == edges [(x,x), (x,y), (y,y)] 1609 1610 test "reflexiveClosure . reflexiveClosure == reflexiveClosure" $ \x -> 1611 (reflexiveClosure . reflexiveClosure) x == reflexiveClosure x 1612 1613testSymmetricClosure :: TestsuiteInt g -> IO () 1614testSymmetricClosure (prefix, API{..}) = do 1615 putStrLn $ "\n============ " ++ prefix ++ "symmetricClosure ============" 1616 test "symmetricClosure empty == empty" $ 1617 symmetricClosure empty == empty 1618 1619 test "symmetricClosure (vertex x) == vertex x" $ \x -> 1620 symmetricClosure (vertex x) == vertex x 1621 1622 test "symmetricClosure (edge x y) == edges [(x,y), (y,x)]" $ \x y -> 1623 symmetricClosure (edge x y) == edges [(x,y), (y,x)] 1624 1625 test "symmetricClosure x == overlay x (transpose x)" $ \x -> 1626 symmetricClosure x == overlay x (transpose x) 1627 1628 test "symmetricClosure . symmetricClosure == symmetricClosure" $ \x -> 1629 (symmetricClosure . symmetricClosure) x == symmetricClosure x 1630 1631testTransitiveClosure :: TestsuiteInt g -> IO () 1632testTransitiveClosure (prefix, API{..}) = do 1633 putStrLn $ "\n============ " ++ prefix ++ "transitiveClosure ============" 1634 test "transitiveClosure empty == empty" $ 1635 transitiveClosure empty == empty 1636 1637 test "transitiveClosure (vertex x) == vertex x" $ \x -> 1638 transitiveClosure (vertex x) == vertex x 1639 1640 test "transitiveClosure (edge x y) == edge x y" $ \x y -> 1641 transitiveClosure (edge x y) == edge x y 1642 1643 test "transitiveClosure (path $ nub xs) == clique (nub $ xs)" $ \xs -> 1644 transitiveClosure (path $ nubOrd xs) == clique (nubOrd xs) 1645 1646 test "transitiveClosure . transitiveClosure == transitiveClosure" $ size10 $ \x -> 1647 (transitiveClosure . transitiveClosure) x == transitiveClosure x 1648 1649testSplitVertex :: TestsuiteInt g -> IO () 1650testSplitVertex (prefix, API{..}) = do 1651 putStrLn $ "\n============ " ++ prefix ++ "splitVertex ============" 1652 test "splitVertex x [] == removeVertex x" $ \x y -> 1653 splitVertex x [] y == removeVertex x y 1654 1655 test "splitVertex x [x] == id" $ \x y -> 1656 splitVertex x [x] y == id y 1657 1658 test "splitVertex x [y] == replaceVertex x y" $ \x y z -> 1659 splitVertex x [y] z == replaceVertex x y z 1660 1661 test "splitVertex 1 [0, 1] $ 1 * (2 + 3) == (0 + 1) * (2 + 3)" $ 1662 splitVertex 1 [0, 1] (1 * (2 + 3)) == (0 + 1) * (2 + 3) 1663 1664testBind :: TestsuiteInt g -> IO () 1665testBind (prefix, API{..}) = do 1666 putStrLn $ "\n============ " ++ prefix ++ "bind ============" 1667 test "bind empty f == empty" $ \(apply -> f) -> 1668 bind empty f == empty 1669 1670 test "bind (vertex x) f == f x" $ \(apply -> f) x -> 1671 bind (vertex x) f == f x 1672 1673 test "bind (edge x y) f == connect (f x) (f y)" $ \(apply -> f) x y -> 1674 bind (edge x y) f == connect (f x) (f y) 1675 1676 test "bind (vertices xs) f == overlays (map f xs)" $ size10 $ \xs (apply -> f) -> 1677 bind (vertices xs) f == overlays (map f xs) 1678 1679 test "bind x (const empty) == empty" $ \x -> 1680 bind x (const empty) == empty 1681 1682 test "bind x vertex == x" $ \x -> 1683 bind x vertex == x 1684 1685 test "bind (bind x f) g == bind x (\\y -> bind (f y) g)" $ size10 $ \x (apply -> f) (apply -> g) -> 1686 bind (bind x f) g == bind x (\y -> bind (f y) g) 1687 1688testSimplify :: TestsuiteInt g -> IO () 1689testSimplify (prefix, API{..}) = do 1690 putStrLn $ "\n============ " ++ prefix ++ "simplify ============" 1691 test "simplify == id" $ \x -> 1692 simplify x == id x 1693 1694 test "size (simplify x) <= size x" $ \x -> 1695 size (simplify x) <= size x 1696 1697testBfsForest :: TestsuiteInt g -> IO () 1698testBfsForest (prefix, API{..}) = do 1699 putStrLn $ "\n============ " ++ prefix ++ "bfsForest ============" 1700 test "bfsForest vs empty == []" $ \vs -> 1701 bfsForest vs empty == [] 1702 1703 test "forest (bfsForest [1] $ edge 1 1) == vertex 1" $ 1704 forest (bfsForest [1] $ edge 1 1) == vertex 1 1705 1706 test "forest (bfsForest [1] $ edge 1 2) == edge 1 2" $ 1707 forest (bfsForest [1] $ edge 1 2) == edge 1 2 1708 1709 test "forest (bfsForest [2] $ edge 1 2) == vertex 2" $ 1710 forest (bfsForest [2] $ edge 1 2) == vertex 2 1711 1712 test "forest (bfsForest [3] $ edge 1 2) == empty" $ 1713 forest (bfsForest [3] $ edge 1 2) == empty 1714 1715 test "forest (bfsForest [2,1] $ edge 1 2) == vertices [1,2]" $ 1716 forest (bfsForest [2,1] $ edge 1 2) == vertices [1,2] 1717 1718 test "isSubgraphOf (forest $ bfsForest vs x) x == True" $ \vs x -> 1719 isSubgraphOf (forest $ bfsForest vs x) x == True 1720 1721 test "bfsForest (vertexList g) g == <correct result>" $ \g -> 1722 bfsForest (vertexList g) g == 1723 map (\v -> Node v []) (nub $ vertexList g) 1724 1725 test "bfsForest [] x == []" $ \x -> 1726 bfsForest [] x == [] 1727 1728 test "bfsForest [1,4] $ 3 * (1 + 4) * (1 + 5) == <correct result>" $ 1729 bfsForest [1,4] (3 * (1 + 4) * (1 + 5)) == [ Node { rootLabel = 1 1730 , subForest = [ Node { rootLabel = 5 1731 , subForest = [] }]} 1732 , Node { rootLabel = 4 1733 , subForest = [] }] 1734 1735 test "bfsForest [3] (circuit [1..5] + (circuit [5,4..1])) == <correct result>" $ 1736 bfsForest [3] (circuit [1..5] + (circuit [5,4..1])) == 1737 [ Node { rootLabel = 3 1738 , subForest = [ Node { rootLabel = 2 1739 , subForest = [ Node { rootLabel = 1 1740 , subForest = []}]} 1741 , Node { rootLabel = 4 1742 , subForest = [ Node { rootLabel = 5 1743 , subForest = []}]}]}] 1744 1745testBfs :: TestsuiteInt g -> IO () 1746testBfs (prefix, API{..}) = do 1747 putStrLn $ "\n============ " ++ prefix ++ "bfs ============" 1748 1749 test "bfs vs $ empty == []" $ \vs -> 1750 bfs vs empty == [] 1751 1752 test "bfs [] g == []" $ \g -> 1753 bfs [] g == [] 1754 1755 test "bfs [1] (edge 1 1) == [[1]]" $ 1756 bfs [1] (edge 1 1) == [[1]] 1757 1758 test "bfs [1] (edge 1 2) == [[1],[2]]" $ 1759 bfs [1] (edge 1 2) == [[1],[2]] 1760 1761 test "bfs [2] (edge 1 2) == [[2]]" $ 1762 bfs [2] (edge 1 2) == [[2]] 1763 1764 test "bfs [1,2] (edge 1 2) == [[1,2]]" $ 1765 bfs [1,2] (edge 1 2) == [[1,2]] 1766 1767 test "bfs [2,1] (edge 1 2) == [[2,1]]" $ 1768 bfs [2,1] (edge 1 2) == [[2,1]] 1769 1770 test "bfs [3] (edge 1 2) == []" $ 1771 bfs [3] (edge 1 2) == [] 1772 1773 test "bfs [1,2] ((1*2) + (3*4) + (5*6)) == [[1,2]]" $ 1774 bfs [1,2] ((1*2) + (3*4) + (5*6)) == [[1,2]] 1775 1776 test "bfs [1,3] ((1*2) + (3*4) + (5*6)) == [[1,3],[2,4]]" $ 1777 bfs [1,3] ((1*2) + (3*4) + (5*6)) == [[1,3],[2,4]] 1778 1779 test "bfs [3] (3 * (1 + 4) * (1 + 5)) == [[3],[1,4,5]]" $ 1780 bfs [3] (3 * (1 + 4) * (1 + 5)) == [[3],[1,4,5]] 1781 1782 test "bfs [2] (circuit [1..5] + (circuit [5,4..1])) == [[2],[1,3],[5,4]]" $ 1783 bfs [2] (circuit [1..5] + (circuit [5,4..1])) == [[2],[1,3],[5,4]] 1784 1785 test "concat (bfs [3] $ circuit [1..5] + circuit [5,4..1]) == [3,2,4,1,5]" $ 1786 concat (bfs [3] $ circuit [1..5] + circuit [5,4..1]) == [3,2,4,1,5] 1787 1788 test "isSubgraphOf (vertices $ concat $ bfs vs x) x == True" $ \vs x -> 1789 isSubgraphOf (vertices $ concat $ bfs vs x) x == True 1790 1791 test "bfs vs == map concat . List.transpose . map levels . bfsForest vs" $ \vs g -> 1792 (bfs vs) g == (map concat . List.transpose . map levels . bfsForest vs) g 1793 1794testDfsForest :: TestsuiteInt g -> IO () 1795testDfsForest (prefix, API{..}) = do 1796 putStrLn $ "\n============ " ++ prefix ++ "dfsForest ============" 1797 test "dfsForest empty == []" $ 1798 dfsForest empty == [] 1799 1800 test "forest (dfsForest $ edge 1 1) == vertex 1" $ 1801 forest (dfsForest $ edge 1 1) == vertex 1 1802 1803 test "forest (dfsForest $ edge 1 2) == edge 1 2" $ 1804 forest (dfsForest $ edge 1 2) == edge 1 2 1805 1806 test "forest (dfsForest $ edge 2 1) == vertices [1,2]" $ 1807 forest (dfsForest $ edge 2 1) == vertices [1,2] 1808 1809 test "isSubgraphOf (forest $ dfsForest x) x == True" $ \x -> 1810 isSubgraphOf (forest $ dfsForest x) x == True 1811 1812 test "isDfsForestOf (dfsForest x) x == True" $ \x -> 1813 isDfsForestOf (dfsForest x) x == True 1814 1815 test "dfsForest . forest . dfsForest == dfsForest" $ \x -> 1816 (dfsForest . forest . dfsForest) x == dfsForest x 1817 1818 test "dfsForest (vertices vs) == map (\\v -> Node v []) (nub $ sort vs)" $ \vs -> 1819 dfsForest (vertices vs) == map (\v -> Node v []) (nub $ sort vs) 1820 1821 test "dfsForest $ 3 * (1 + 4) * (1 + 5) == <correct result>" $ 1822 dfsForest (3 * (1 + 4) * (1 + 5)) == [ Node { rootLabel = 1 1823 , subForest = [ Node { rootLabel = 5 1824 , subForest = [] }]} 1825 , Node { rootLabel = 3 1826 , subForest = [ Node { rootLabel = 4 1827 , subForest = [] }]}] 1828 test "forest (dfsForest $ circuit [1..5] + circuit [5,4..1]) == path [1,2,3,4,5]" $ 1829 forest (dfsForest $ circuit [1..5] + circuit [5,4..1]) == path [1,2,3,4,5] 1830 1831testDfsForestFrom :: TestsuiteInt g -> IO () 1832testDfsForestFrom (prefix, API{..}) = do 1833 putStrLn $ "\n============ " ++ prefix ++ "dfsForestFrom ============" 1834 test "dfsForestFrom vs empty == []" $ \vs -> 1835 dfsForestFrom vs empty == [] 1836 1837 test "forest (dfsForestFrom [1] $ edge 1 1) == vertex 1" $ 1838 forest (dfsForestFrom [1] $ edge 1 1) == vertex 1 1839 1840 test "forest (dfsForestFrom [1] $ edge 1 2) == edge 1 2" $ 1841 forest (dfsForestFrom [1] $ edge 1 2) == edge 1 2 1842 1843 test "forest (dfsForestFrom [2] $ edge 1 2) == vertex 2" $ 1844 forest (dfsForestFrom [2] $ edge 1 2) == vertex 2 1845 1846 test "forest (dfsForestFrom [3] $ edge 1 2) == empty" $ 1847 forest (dfsForestFrom [3] $ edge 1 2) == empty 1848 1849 test "forest (dfsForestFrom [2,1] $ edge 1 2) == vertices [1,2]" $ 1850 forest (dfsForestFrom [2,1] $ edge 1 2) == vertices [1,2] 1851 1852 test "isSubgraphOf (forest $ dfsForestFrom vs x) x == True" $ \vs x -> 1853 isSubgraphOf (forest $ dfsForestFrom vs x) x == True 1854 1855 test "isDfsForestOf (dfsForestFrom (vertexList x) x) x == True" $ \x -> 1856 isDfsForestOf (dfsForestFrom (vertexList x) x) x == True 1857 1858 test "dfsForestFrom (vertexList x) x == dfsForest x" $ \x -> 1859 dfsForestFrom (vertexList x) x == dfsForest x 1860 1861 test "dfsForestFrom vs (vertices vs) == map (\\v -> Node v []) (nub vs)" $ \vs -> 1862 dfsForestFrom vs (vertices vs) == map (\v -> Node v []) (nub vs) 1863 1864 test "dfsForestFrom [] x == []" $ \x -> 1865 dfsForestFrom [] x == [] 1866 1867 test "dfsForestFrom [1,4] $ 3 * (1 + 4) * (1 + 5) == <correct result>" $ 1868 dfsForestFrom [1,4] (3 * (1 + 4) * (1 + 5)) == [ Node { rootLabel = 1 1869 , subForest = [ Node { rootLabel = 5 1870 , subForest = [] }]} 1871 , Node { rootLabel = 4 1872 , subForest = [] }] 1873 test "forest (dfsForestFrom [3] $ circuit [1..5] + circuit [5,4..1]) == path [3,2,1,5,4]" $ 1874 forest (dfsForestFrom [3] $ circuit [1..5] + circuit [5,4..1]) == path [3,2,1,5,4] 1875 1876 1877testDfs :: TestsuiteInt g -> IO () 1878testDfs (prefix, API{..}) = do 1879 putStrLn $ "\n============ " ++ prefix ++ "dfs ============" 1880 test "dfs vs $ empty == []" $ \vs -> 1881 dfs vs empty == [] 1882 1883 test "dfs [1] $ edge 1 1 == [1]" $ 1884 dfs [1] (edge 1 1) == [1] 1885 1886 test "dfs [1] $ edge 1 2 == [1,2]" $ 1887 dfs [1] (edge 1 2) == [1,2] 1888 1889 test "dfs [2] $ edge 1 2 == [2]" $ 1890 dfs [2] (edge 1 2) == [2] 1891 1892 test "dfs [3] $ edge 1 2 == []" $ 1893 dfs [3] (edge 1 2) == [] 1894 1895 test "dfs [1,2] $ edge 1 2 == [1,2]" $ 1896 dfs [1,2] (edge 1 2) == [1,2] 1897 1898 test "dfs [2,1] $ edge 1 2 == [2,1]" $ 1899 dfs [2,1] (edge 1 2) == [2,1] 1900 1901 test "dfs [] $ x == []" $ \x -> 1902 dfs [] x == [] 1903 1904 test "dfs [1,4] $ 3 * (1 + 4) * (1 + 5) == [1,5,4]" $ 1905 dfs [1,4] (3 * (1 + 4) * (1 + 5)) == [1,5,4] 1906 1907 test "isSubgraphOf (vertices $ dfs vs x) x == True" $ \vs x -> 1908 isSubgraphOf (vertices $ dfs vs x) x == True 1909 1910 test "dfs [3] (circuit [1..5] + circuit [5,4..1]) == [3,2,1,5,4]" $ 1911 dfs [3] (circuit [1..5] + circuit [5,4..1]) == [3,2,1,5,4] 1912 1913testReachable :: TestsuiteInt g -> IO () 1914testReachable (prefix, API{..}) = do 1915 putStrLn $ "\n============ " ++ prefix ++ "dfs ============" 1916 test "reachable x $ empty == []" $ \x -> 1917 reachable x empty == [] 1918 1919 test "reachable 1 $ vertex 1 == [1]" $ 1920 reachable 1 (vertex 1) == [1] 1921 1922 test "reachable 1 $ vertex 2 == []" $ 1923 reachable 1 (vertex 2) == [] 1924 1925 test "reachable 1 $ edge 1 1 == [1]" $ 1926 reachable 1 (edge 1 1) == [1] 1927 1928 test "reachable 1 $ edge 1 2 == [1,2]" $ 1929 reachable 1 (edge 1 2) == [1,2] 1930 1931 test "reachable 4 $ path [1..8] == [4..8]" $ 1932 reachable 4 (path [1..8]) == [4..8] 1933 1934 test "reachable 4 $ circuit [1..8] == [4..8] ++ [1..3]" $ 1935 reachable 4 (circuit [1..8]) == [4..8] ++ [1..3] 1936 1937 test "reachable 8 $ clique [8,7..1] == [8] ++ [1..7]" $ 1938 reachable 8 (clique [8,7..1]) == [8] ++ [1..7] 1939 1940 test "isSubgraphOf (vertices $ reachable x y) y == True" $ \x y -> 1941 isSubgraphOf (vertices $ reachable x y) y == True 1942 1943testTopSort :: TestsuiteInt g -> IO () 1944testTopSort (prefix, API{..}) = do 1945 putStrLn $ "\n============ " ++ prefix ++ "topSort ============" 1946 test "topSort (1 * 2 + 3 * 1) == Right [3,1,2]" $ 1947 topSort (1 * 2 + 3 * 1) == Right [3,1,2] 1948 1949 test "topSort (path [1..5]) == Right [1..5]" $ 1950 topSort (path [1..5]) == Right [1..5] 1951 1952 test "topSort (3 * (1 * 4 + 2 * 5)) == Right [3,1,2,4,5]" $ 1953 topSort (3 * (1 * 4 + 2 * 5)) == Right [3,1,2,4,5] 1954 1955 test "topSort (1 * 2 + 2 * 1) == Left (2 :| [1])" $ 1956 topSort (1 * 2 + 2 * 1) == Left (2 :| [1]) 1957 1958 test "topSort (path [5,4..1] + edge 2 4) == Left (4 :| [3,2])" $ 1959 topSort (path [5,4..1] + edge 2 4) == Left (4 :| [3,2]) 1960 1961 test "topSort (circuit [1..5]) == Left (3 :| [1,2])" $ 1962 topSort (circuit [1..3]) == Left (3 :| [1,2]) 1963 1964 test "topSort (circuit [1..3] + circuit [3,2,1]) == Left (3 :| [2])" $ 1965 topSort (circuit [1..3] + circuit [3,2,1]) == Left (3 :| [2]) 1966 1967 test "topSort (1*2 + 2*1 + 3*4 + 4*3 + 5*1) == Left (1 :| [2])" $ 1968 topSort (1*2 + 2*1 + 3*4 + 4*3 + 5*1) == Left (1 :| [2]) 1969 1970 test "fmap (flip isTopSortOf x) (topSort x) /= Right False" $ \x -> 1971 fmap (flip isTopSortOf x) (topSort x) /= Right False 1972 1973 test "topSort . vertices == Right . nub . sort" $ \vs -> 1974 (topSort . vertices) vs == (Right . nubOrd . sort) vs 1975 1976 1977 1978testIsAcyclic :: TestsuiteInt g -> IO () 1979testIsAcyclic (prefix, API{..}) = do 1980 putStrLn $ "\n============ " ++ prefix ++ "testIsAcyclic ============" 1981 test "isAcyclic (1 * 2 + 3 * 1) == True" $ 1982 isAcyclic (1 * 2 + 3 * 1) == True 1983 1984 test "isAcyclic (1 * 2 + 2 * 1) == False" $ 1985 isAcyclic (1 * 2 + 2 * 1) == False 1986 1987 test "isAcyclic . circuit == null" $ \xs -> 1988 (isAcyclic . circuit) xs == null xs 1989 1990 test "isAcyclic == isRight . topSort" $ \x -> 1991 isAcyclic x == isRight (topSort x) 1992 1993testIsDfsForestOf :: TestsuiteInt g -> IO () 1994testIsDfsForestOf (prefix, API{..}) = do 1995 putStrLn $ "\n============ " ++ prefix ++ "isDfsForestOf ============" 1996 test "isDfsForestOf [] empty == True" $ 1997 isDfsForestOf [] empty == True 1998 1999 test "isDfsForestOf [] (vertex 1) == False" $ 2000 isDfsForestOf [] (vertex 1) == False 2001 2002 test "isDfsForestOf [Node 1 []] (vertex 1) == True" $ 2003 isDfsForestOf [Node 1 []] (vertex 1) == True 2004 2005 test "isDfsForestOf [Node 1 []] (vertex 2) == False" $ 2006 isDfsForestOf [Node 1 []] (vertex 2) == False 2007 2008 test "isDfsForestOf [Node 1 [], Node 1 []] (vertex 1) == False" $ 2009 isDfsForestOf [Node 1 [], Node 1 []] (vertex 1) == False 2010 2011 test "isDfsForestOf [Node 1 []] (edge 1 1) == True" $ 2012 isDfsForestOf [Node 1 []] (edge 1 1) == True 2013 2014 test "isDfsForestOf [Node 1 []] (edge 1 2) == False" $ 2015 isDfsForestOf [Node 1 []] (edge 1 2) == False 2016 2017 test "isDfsForestOf [Node 1 [], Node 2 []] (edge 1 2) == False" $ 2018 isDfsForestOf [Node 1 [], Node 2 []] (edge 1 2) == False 2019 2020 test "isDfsForestOf [Node 2 [], Node 1 []] (edge 1 2) == True" $ 2021 isDfsForestOf [Node 2 [], Node 1 []] (edge 1 2) == True 2022 2023 test "isDfsForestOf [Node 1 [Node 2 []]] (edge 1 2) == True" $ 2024 isDfsForestOf [Node 1 [Node 2 []]] (edge 1 2) == True 2025 2026 test "isDfsForestOf [Node 1 [], Node 2 []] (vertices [1,2]) == True" $ 2027 isDfsForestOf [Node 1 [], Node 2 []] (vertices [1,2]) == True 2028 2029 test "isDfsForestOf [Node 2 [], Node 1 []] (vertices [1,2]) == True" $ 2030 isDfsForestOf [Node 2 [], Node 1 []] (vertices [1,2]) == True 2031 2032 test "isDfsForestOf [Node 1 [Node 2 []]] (vertices [1,2]) == False" $ 2033 isDfsForestOf [Node 1 [Node 2 []]] (vertices [1,2]) == False 2034 2035 test "isDfsForestOf [Node 1 [Node 2 [Node 3 []]]] (path [1,2,3]) == True" $ 2036 isDfsForestOf [Node 1 [Node 2 [Node 3 []]]] (path [1,2,3]) == True 2037 2038 test "isDfsForestOf [Node 1 [Node 3 [Node 2 []]]] (path [1,2,3]) == False" $ 2039 isDfsForestOf [Node 1 [Node 3 [Node 2 []]]] (path [1,2,3]) == False 2040 2041 test "isDfsForestOf [Node 3 [], Node 1 [Node 2 []]] (path [1,2,3]) == True" $ 2042 isDfsForestOf [Node 3 [], Node 1 [Node 2 []]] (path [1,2,3]) == True 2043 2044 test "isDfsForestOf [Node 2 [Node 3 []], Node 1 []] (path [1,2,3]) == True" $ 2045 isDfsForestOf [Node 2 [Node 3 []], Node 1 []] (path [1,2,3]) == True 2046 2047 test "isDfsForestOf [Node 1 [], Node 2 [Node 3 []]] (path [1,2,3]) == False" $ 2048 isDfsForestOf [Node 1 [], Node 2 [Node 3 []]] (path [1,2,3]) == False 2049 2050testIsTopSortOf :: TestsuiteInt g -> IO () 2051testIsTopSortOf (prefix, API{..}) = do 2052 putStrLn $ "\n============ " ++ prefix ++ "isTopSortOf ============" 2053 test "isTopSortOf [3,1,2] (1 * 2 + 3 * 1) == True" $ 2054 isTopSortOf [3,1,2] (1 * 2 + 3 * 1) == True 2055 2056 test "isTopSortOf [1,2,3] (1 * 2 + 3 * 1) == False" $ 2057 isTopSortOf [1,2,3] (1 * 2 + 3 * 1) == False 2058 2059 test "isTopSortOf [] (1 * 2 + 3 * 1) == False" $ 2060 isTopSortOf [] (1 * 2 + 3 * 1) == False 2061 2062 test "isTopSortOf [] empty == True" $ 2063 isTopSortOf [] empty == True 2064 2065 test "isTopSortOf [x] (vertex x) == True" $ \x -> 2066 isTopSortOf [x] (vertex x) == True 2067 2068 test "isTopSortOf [x] (edge x x) == False" $ \x -> 2069 isTopSortOf [x] (edge x x) == False 2070