toysolver-0.9.0: test/Test/GraphShortestPath.hs
{-# OPTIONS_GHC -Wall -fno-warn-orphans #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
module Test.GraphShortestPath (graphShortestPathTestGroup) where
import Control.Monad
import Data.Monoid
import Test.Tasty
import Test.Tasty.HUnit
import Test.Tasty.QuickCheck hiding ((.&&.), (.||.))
import Test.Tasty.TH
import ToySolver.Graph.ShortestPath
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import qualified Data.IntSet as IntSet
-- ------------------------------------------------------------------------
type Vertex = Int
type Cost = Rational
type Label = Char
genGraph :: Gen Cost -> Gen (IntMap [OutEdge Cost Label])
genGraph genCost = do
n <- choose (1, 20) -- inclusive
liftM IntMap.fromList $ forM [1..n] $ \i -> do
m <- choose (0, min (n+1) 20)
ys <- replicateM m $ do
j <- choose (1, n)
c <- genCost
l <- elements ['A'..'Z']
return (j,c,l)
return (i, ys)
genGraphNonNegative :: Gen (IntMap [OutEdge Cost Label])
genGraphNonNegative = genGraph (liftM getNonNegative arbitrary)
isValidEdge
:: (Eq cost, Eq label)
=> IntMap [OutEdge cost label]
-> Edge cost label
-> Bool
isValidEdge g (v,u,c,l) =
case IntMap.lookup v g of
Nothing -> False
Just outs -> (u,c,l) `elem` outs
isValidPath
:: (Eq cost, Num cost, Eq label)
=> IntMap [OutEdge cost label]
-> Path cost label
-> Bool
isValidPath g = f
where
f (Empty v) = v `IntMap.member` g
f (Singleton e) = isValidEdge g e
f (Append p1 p2 c) = f p1 && f p2 && pathTo p1 == pathFrom p2 && pathCost p1 + pathCost p2 == c
isValidNegativeCostCycle
:: (Num cost, Ord cost, Eq label)
=> IntMap [OutEdge cost label]
-> Path cost label
-> Bool
isValidNegativeCostCycle g cyclePath =
isValidPath g cyclePath &&
pathFrom cyclePath == pathTo cyclePath &&
pathCost cyclePath < 0
isValidResult
:: (Eq cost, Num cost, Eq label)
=> IntMap [OutEdge cost label]
-> [Vertex]
-> IntMap (cost, Last (InEdge cost label))
-> Bool
isValidResult g ss p =
and
[ case m of
Nothing -> tc == 0 && u `IntSet.member` ss'
Just (v,c,l) -> isValidEdge g (v,u,c,l) && tc == fst (p IntMap.! v) + c
| (u, (tc,Last m)) <- IntMap.toList p
]
where
ss' = IntSet.fromList ss
-- ------------------------------------------------------------------------
prop_bellmanFord_valid_path :: Property
prop_bellmanFord_valid_path =
forAll (genGraph arbitrary) $ \g ->
forAll (sublistOf (IntMap.keys g)) $ \ss ->
and
[ isValidPath g p &&
pathTo p == u &&
pathFrom p `elem` ss
| (u, (_,p)) <- IntMap.toList $ bellmanFord path g ss
]
prop_dijkstra_valid_path :: Property
prop_dijkstra_valid_path =
forAll (genGraphNonNegative) $ \g ->
forAll (sublistOf (IntMap.keys g)) $ \ss ->
and
[ isValidPath g p &&
pathTo p == u &&
pathFrom p `elem` ss
| (u, (_,p)) <- IntMap.toList $ dijkstra path g ss
]
prop_floydWarshall_valid_path :: Property
prop_floydWarshall_valid_path =
forAll (genGraphNonNegative) $ \g ->
and
[ isValidPath g p &&
pathFrom p == u &&
pathTo p == v
| (u,m) <- IntMap.toList (floydWarshall path g)
, (v,(_,p)) <- IntMap.toList m
]
prop_dijkstra_equals_bellmanFord :: Property
prop_dijkstra_equals_bellmanFord =
forAll (genGraphNonNegative) $ \g ->
let vs = IntMap.keys g
in forAll (elements vs) $ \v ->
forAll (elements vs) $ \u ->
(fmap (pathCost . snd) . IntMap.lookup u $ dijkstra path g [v])
==
(fmap (pathCost . snd) . IntMap.lookup u $ bellmanFord path g [v])
prop_floydWarshall_equals_dijkstra :: Property
prop_floydWarshall_equals_dijkstra =
forAll (genGraphNonNegative) $ \g ->
let vs = IntMap.keys g
m = floydWarshall path g
in forAll (elements vs) $ \v ->
forAll (elements vs) $ \u ->
fmap (pathCost . snd) (IntMap.lookup u =<< IntMap.lookup v m)
==
fmap (pathCost . snd) (IntMap.lookup u $ dijkstra path g [v])
prop_floydWarshall_equals_bellmanFord :: Property
prop_floydWarshall_equals_bellmanFord =
forAll (genGraph arbitrary) $ \g ->
let vs = IntMap.keys g
ret1 = floydWarshall lastInEdge g
in counterexample (show ret1) $ conjoin $
[ counterexample (show v) $ counterexample (show ret2) $
case bellmanFordDetectNegativeCycle path g ret2 of
Just cyclePath ->
conjoin
[ counterexample (show u) (fst (ret1 IntMap.! u IntMap.! u) < 0)
| u <- pathVertexes cyclePath
]
Nothing ->
fmap fst (IntMap.findWithDefault IntMap.empty v ret1)
===
fmap fst ret2
| v <- vs
, let ret2 = bellmanFord lastInEdge g [v]
]
-- progassgn5.py example from “Linear and Discrete Optimization”
-- <https://www.coursera.org/course/linearopt>
case_bellmanFord_test1 :: Assertion
case_bellmanFord_test1 = do
let ret = bellmanFord lastInEdge g [vA]
ret @?= expected
bellmanFordDetectNegativeCycle path g ret @?= Nothing
where
g :: IntMap [(Vertex, Int, ())]
g = IntMap.fromList
[ (vA, [(vB,-7,()), (vC,-9,())])
, (vB, [(vC,-8,()), (vD,-10,())])
, (vC, [(vD,4,())])
, (vD, [(vE,-3,())])
, (vE, [(vF,5,())])
, (vF, [(vC,-3,())])
]
[vA, vB, vC, vD, vE, vF] = [0..5]
expected = IntMap.fromList
[ (vA, (0, Last Nothing))
, (vB, (-7, Last (Just (vA,-7,()))))
, (vC, (-18, Last (Just (vF,-3,()))))
, (vD, (-17, Last (Just (vB,-10,()))))
, (vE, (-20, Last (Just (vD,-3,()))))
, (vF, (-15, Last (Just (vE,5,()))))
]
case_bellmanFord_normal :: Assertion
case_bellmanFord_normal = do
let g = IntMap.fromListWith (++) $
[(v,[(u,c,())]) | ((v,u),c) <- bellmanford_example_normal]
m = bellmanFord lastInEdge g [24]
assertBool (show m ++ " is not a valid result") $ isValidResult g [24] m
case bellmanFordDetectNegativeCycle path g m of
Nothing -> return ()
Just cyclePath -> assertFailure ("negative cost cycle should not be found (" ++ show cyclePath ++ ")")
bellmanford_example_normal :: [((Vertex, Vertex), Cost)]
bellmanford_example_normal =
[ ((7, 3), 236)
, ((20, 25), 218)
, ((6, 28), 765)
, ((21, 28), 447)
, ((17, 20), 454)
, ((23, 26), 234)
, ((21, 6), 19)
, ((8, 5), 759)
, ((9, 0), 814)
, ((10, 7), 406)
, ((0, 17), 456)
, ((12, 17), 878)
, ((25, 15), 633)
, ((15, 4), 445)
, ((26, 12), 758)
, ((29, 17), 865)
, ((29, 11), 143)
, ((6, 23), 640)
, ((20, 14), 235)
, ((21, 15), 802)
, ((23, 9), 548)
, ((10, 14), 805)
, ((11, 15), 563)
, ((9, 19), 435)
, ((24, 21), 841)
, ((26, 23), 944)
, ((4, 12), 831)
, ((28, 1), 461)
, ((6, 14), 858)
, ((19, 18), 453)
, ((18, 5), 72)
, ((10, 9), 257)
, ((8, 25), 328)
, ((24, 28), 120)
, ((12, 29), 901)
, ((25, 3), 64)
, ((6, 1), 597)
, ((7, 4), 920)
, ((5, 20), 812)
, ((6, 27), 493)
, ((9, 29), 178)
, ((12, 20), 611)
, ((25, 4), 662)
, ((29, 22), 183)
, ((28, 13), 319)
, ((5, 29), 248)
, ((20, 27), 255)
, ((16, 11), 522)
, ((21, 26), 537)
, ((19, 6), 913)
, ((18, 17), 743)
, ((22, 11), -30)
, ((9, 6), 819)
, ((10, 5), 83)
, ((11, 8), 361)
, ((24, 16), 102)
, ((12, 19), 371)
, ((1, 18), 516)
, ((15, 6), 353)
, ((2, 25), 259)
, ((26, 10), 23)
, ((3, 4), 191)
, ((5, 6), 609)
, ((6, 21), 244)
, ((19, 15), 359)
, ((20, 8), 336)
, ((16, 24), 282)
, ((21, 13), -18)
, ((23, 11), -33)
, ((10, 12), 35)
, ((8, 20), 132)
, ((9, 17), 168)
, ((25, 22), 367)
, ((2, 16), 628)
, ((27, 24), 350)
, ((5, 15), 691)
, ((29, 2), 677)
, ((6, 12), 146)
, ((4, 20), 253)
, ((17, 4), 38)
, ((23, 0), 937)
, ((11, 6), 870)
, ((10, 17), 200)
, ((13, 4), 976)
, ((0, 7), 371)
, ((28, 26), 603)
, ((2, 5), 867)
, ((3, 24), 661)
, ((7, 6), -10)
, ((16, 22), 73)
, ((6, 25), 188)
, ((19, 3), 746)
, ((22, 28), 330)
, ((20, 4), 451)
, ((24, 11), 213)
, ((27, 22), 969)
, ((13, 23), 970)
, ((29, 20), 522)
, ((27, 12), 13)
, ((4, 26), 741)
, ((28, 15), 956)
, ((5, 27), 463)
, ((29, 14), 779)
, ((17, 8), 119)
, ((7, 21), 797)
, ((22, 23), 97)
, ((23, 22), 840)
, ((22, 9), 175)
, ((23, 12), 633)
, ((11, 10), 893)
, ((14, 5), 734)
, ((12, 13), 411)
, ((26, 8), 33)
, ((1, 10), 104)
, ((4, 1), -7)
, ((16, 4), 115)
, ((6, 11), 318)
, ((16, 26), 161)
, ((17, 27), 564)
, ((9, 13), 377)
, ((11, 25), 407)
, ((3, 15), 755)
, ((1, 3), 745)
, ((6, 2), 626)
, ((19, 22), 94)
, ((7, 11), 188)
, ((16, 17), 283)
, ((21, 20), 611)
, ((9, 24), 179)
, ((25, 29), 25)
, ((13, 2), 391)
, ((0, 25), 710)
, ((28, 20), 800)
, ((2, 3), 382)
, ((27, 9), 415)
, ((5, 16), 628)
, ((20, 24), 540)
, ((21, 29), 176)
, ((19, 5), 530)
, ((17, 21), 806)
, ((8, 4), 385)
, ((11, 23), 541)
, ((1, 29), 177)
, ((25, 8), 636)
, ((26, 15), 347)
, ((27, 14), 746)
, ((29, 12), 147)
, ((16, 15), 309)
, ((6, 22), 624)
, ((19, 10), 661)
, ((17, 14), 188)
, ((23, 14), 845)
, ((8, 17), 228)
, ((11, 12), 252)
, ((24, 20), 358)
, ((12, 15), 475)
, ((13, 14), 963)
, ((0, 13), 255)
, ((3, 8), 753)
, ((4, 3), 124)
, ((28, 0), 205)
, ((6, 9), 678)
, ((17, 7), 167)
, ((7, 12), 612)
, ((17, 25), 38)
, ((11, 5), 466)
, ((24, 27), 651)
, ((10, 18), 51)
, ((25, 26), 544)
, ((15, 11), 178)
, ((0, 4), 17)
, ((24, 1), 60)
, ((12, 28), 161)
, ((4, 10), 357)
, ((5, 11), 66)
, ((6, 0), 710)
, ((4, 16), 633)
, ((19, 24), 864)
, ((5, 21), 449)
, ((21, 18), 899)
, ((17, 18), 759)
, ((22, 25), -25)
, ((18, 25), 896)
, ((23, 28), 733)
, ((14, 21), 578)
, ((26, 24), 552)
, ((0, 27), 644)
, ((24, 8), 492)
, ((28, 22), 325)
, ((2, 1), 357)
, ((29, 23), 421)
, ((3, 28), 748)
, ((6, 29), 809)
, ((7, 24), 840)
, ((18, 16), 634)
, ((21, 5), 392)
, ((8, 6), -18)
, ((14, 28), 69)
, ((10, 4), -42)
, ((15, 25), 755)
, ((12, 18), 721)
, ((1, 19), 228)
, ((25, 14), 789)
, ((13, 19), 540)
, ((2, 24), -44)
, ((26, 13), 22)
, ((0, 8), 485)
, ((29, 16), 298)
, ((3, 5), 725)
, ((4, 6), 210)
, ((28, 11), -38)
, ((5, 7), 976)
, ((29, 10), 185)
, ((16, 1), 799)
, ((17, 12), 478)
, ((7, 17), 546)
, ((20, 15), 872)
, ((21, 14), 960)
, ((8, 13), 145)
, ((22, 13), 994)
, ((23, 8), 556)
, ((10, 15), 337)
, ((8, 19), 423)
, ((14, 9), 157)
, ((12, 9), 567)
, ((1, 20), 229)
, ((15, 12), -46)
, ((13, 12), 541)
, ((28, 2), 738)
, ((17, 5), 960)
, ((7, 14), -38)
, ((18, 28), 827)
, ((23, 1), 665)
, ((11, 7), 72)
, ((9, 27), 490)
, ((24, 29), 665)
, ((12, 0), 126)
, ((13, 5), 73)
, ((2, 4), 217)
, ((5, 9), 14)
, ((21, 16), 843)
, ((19, 0), 456)
, ((17, 16), 682)
, ((7, 29), 506)
, ((8, 1), 146)
, ((14, 27), 518)
, ((15, 18), 92)
, ((0, 29), 579)
, ((24, 10), 722)
, ((1, 24), 70)
, ((25, 11), 848)
, ((13, 24), 739)
, ((28, 16), 301)
, ((4, 25), 457)
, ((29, 15), 429)
, ((16, 12), 485)
, ((6, 19), 502)
, ((21, 25), 548)
, ((19, 9), 772)
, ((18, 14), 12)
, ((9, 5), 378)
, ((0, 20), 219)
, ((24, 17), 563)
, ((1, 17), 371)
, ((25, 12), 846)
, ((15, 1), 581)
, ((2, 22), 986)
, ((26, 11), 79)
, ((0, 10), 696)
, ((3, 7), 286)
, ((27, 2), 280)
, ((1, 11), -24)
, ((4, 0), 583)
, ((16, 3), 798)
, ((6, 10), 518)
, ((19, 14), 437)
, ((17, 2), -20)
, ((16, 25), 157)
, ((10, 13), 587)
, ((14, 15), 307)
, ((15, 14), 690)
, ((3, 12), 124)
, ((4, 15), 755)
, ((5, 14), -17)
, ((29, 1), 550)
, ((7, 8), 57)
, ((17, 29), 593)
, ((18, 26), 606)
, ((23, 3), 515)
, ((8, 28), 446)
, ((13, 3), 899)
, ((26, 29), 474)
, ((12, 24), 300)
, ((1, 5), 278)
, ((28, 27), 194)
, ((3, 27), 620)
, ((4, 28), -33)
, ((19, 28), 295)
, ((7, 1), 482)
, ((5, 17), 82)
, ((19, 2), 151)
, ((18, 21), 389)
, ((9, 2), 942)
, ((14, 25), 678)
, ((10, 25), 669)
, ((15, 28), 719)
, ((11, 20), 719)
, ((24, 12), 540)
, ((2, 29), 582)
, ((29, 19), 540)
, ((3, 0), 264)
, ((28, 8), 253)
, ((5, 26), 974)
, ((29, 13), 327)
, ((19, 11), 143)
, ((20, 12), 696)
, ((18, 12), 493)
, ((21, 1), 976)
, ((22, 14), 285)
, ((23, 15), 418)
, ((10, 0), 306)
, ((24, 19), 244)
, ((12, 14), 281)
, ((25, 18), 799)
, ((15, 3), 224)
, ((13, 15), 480)
, ((26, 9), 162)
, ((5, 3), 813)
, ((29, 6), 492)
, ((7, 13), 616)
, ((18, 7), 312)
, ((21, 10), 666)
, ((10, 11), 106)
, ((8, 23), 9)
, ((11, 2), 39)
, ((0, 3), 612)
, ((24, 0), 982)
, ((3, 14), 718)
, ((1, 2), 981)
, ((5, 12), 399)
, ((3, 20), 451)
, ((6, 3), 450)
, ((4, 23), 554)
, ((19, 25), 387)
, ((20, 18), -6)
, ((23, 29), 611)
, ((14, 20), 449)
, ((10, 28), 983)
, ((15, 17), 383)
, ((26, 27), 157)
, ((24, 7), 505)
, ((25, 6), 610)
, ((13, 27), 746)
, ((2, 0), 722)
, ((26, 5), 346)
, ((27, 8), 284)
]
case_bellmanFord_negativecost_cycle :: Assertion
case_bellmanFord_negativecost_cycle = do
let g = IntMap.fromListWith (++) $
[(v, [(u,c,())]) | ((v,u),c) <- bellmanford_example_negativecost_cycle]
m = bellmanFord lastInEdge g [25]
case bellmanFordDetectNegativeCycle path g m of
Nothing -> assertFailure ("negative cost cycle should be found (" ++ show m ++ ")")
Just cyclePath -> assertBool (show cyclePath ++ " should be valid negative cost cycle") $ isValidNegativeCostCycle g cyclePath
bellmanford_example_negativecost_cycle :: [((Vertex, Vertex), Cost)]
bellmanford_example_negativecost_cycle =
[ ((7, 3), 558)
, ((16, 9), 913)
, ((21, 28), 902)
, ((19, 4), 144)
, ((7, 25), 706)
, ((20, 7), 175)
, ((18, 19), 767)
, ((10, 7), 637)
, ((11, 22), 55)
, ((2, 27), 106)
, ((29, 17), 736)
, ((3, 2), 648)
, ((4, 5), 783)
, ((28, 10), 225)
, ((5, 24), 69)
, ((29, 11), 78)
, ((21, 15), 91)
, ((23, 9), 398)
, ((10, 14), 388)
, ((8, 18), 386)
, ((14, 8), 80)
, ((15, 13), 248)
, ((2, 18), 373)
, ((26, 23), 781)
, ((1, 15), 79)
, ((4, 12), 66)
, ((5, 1), 382)
, ((29, 4), 795)
, ((3, 17), 61)
, ((20, 21), 734)
, ((17, 24), 796)
, ((23, 6), 707)
, ((9, 20), 29)
, ((24, 28), 236)
, ((12, 7), 779)
, ((0, 5), 388)
, ((2, 7), 32)
, ((5, 10), 853)
, ((19, 27), 133)
, ((7, 4), 586)
, ((5, 20), 543)
, ((20, 28), 543)
, ((6, 27), 423)
, ((19, 1), 118)
, ((18, 22), 853)
, ((9, 29), 421)
, ((10, 26), -41)
, ((29, 22), 547)
, ((27, 10), 729)
, ((4, 24), 350)
, ((28, 13), 668)
, ((5, 29), 417)
, ((20, 27), 275)
, ((21, 26), 383)
, ((17, 10), 596)
, ((7, 27), 384)
, ((8, 7), 889)
, ((22, 11), 248)
, ((11, 8), 946)
, ((24, 16), 693)
, ((14, 7), 908)
, ((12, 19), 658)
, ((1, 18), 469)
, ((2, 25), 791)
, ((26, 10), 201)
, ((0, 9), 861)
, ((4, 7), 38)
, ((6, 21), 317)
, ((18, 8), -30)
, ((16, 24), 843)
, ((22, 2), 573)
, ((23, 11), 353)
, ((11, 1), 734)
, ((24, 23), 229)
, ((12, 10), 697)
, ((2, 16), 697)
, ((3, 13), 177)
, ((4, 14), 958)
, ((29, 2), 651)
, ((7, 9), 554)
, ((20, 23), 229)
, ((21, 22), 306)
, ((22, 5), 84)
, ((23, 0), 600)
, ((8, 27), 74)
, ((14, 17), 2)
, ((12, 1), 227)
, ((10, 17), -14)
, ((15, 20), 53)
, ((13, 4), 458)
, ((26, 28), 75)
, ((0, 7), 35)
, ((1, 6), -7)
, ((28, 26), 323)
, ((29, 27), 441)
, ((3, 24), -5)
, ((6, 7), 731)
, ((19, 29), 753)
, ((7, 6), 932)
, ((16, 22), 873)
, ((19, 3), 863)
, ((18, 20), 208)
, ((23, 25), 237)
, ((12, 22), 201)
, ((27, 22), 783)
, ((25, 10), 108)
, ((13, 23), -29)
, ((26, 1), 491)
, ((3, 1), 524)
, ((28, 15), 680)
, ((16, 13), 54)
, ((7, 21), 685)
, ((23, 22), 288)
, ((22, 9), 37)
, ((23, 12), 160)
, ((15, 26), 869)
, ((11, 10), 950)
, ((0, 21), 444)
, ((14, 5), 875)
, ((1, 16), 929)
, ((25, 19), 426)
, ((0, 11), 465)
, ((27, 5), 883)
, ((1, 10), 14)
, ((28, 6), 909)
, ((29, 7), 801)
, ((6, 11), 144)
, ((17, 1), 488)
, ((7, 18), 670)
, ((20, 10), 438)
, ((16, 26), 760)
, ((17, 27), 478)
, ((23, 5), 997)
, ((8, 22), 589)
, ((11, 3), 582)
, ((12, 4), 391)
, ((25, 20), 212)
, ((13, 9), 158)
, ((27, 26), 723)
, ((1, 3), 683)
, ((4, 8), 726)
, ((28, 29), 749)
, ((2, 8), 18)
, ((29, 0), 676)
, ((20, 17), 599)
, ((16, 17), 500)
, ((21, 20), 343)
, ((22, 27), 871)
, ((18, 27), 363)
, ((8, 29), 89)
, ((14, 23), 79)
, ((25, 29), 513)
, ((15, 22), 323)
, ((13, 2), 300)
, ((27, 19), 503)
, ((1, 4), 440)
, ((13, 28), 993)
, ((29, 25), 650)
, ((3, 26), 920)
, ((6, 5), 241)
, ((5, 16), 297)
, ((20, 24), 739)
, ((21, 29), 194)
, ((17, 21), 455)
, ((8, 4), 787)
, ((9, 1), 666)
, ((11, 23), 77)
, ((0, 16), 927)
, ((24, 13), 334)
, ((14, 0), 317)
, ((12, 16), 955)
, ((15, 5), 334)
, ((2, 26), 748)
, ((26, 15), 643)
, ((28, 9), 333)
, ((17, 14), 863)
, ((22, 21), 359)
, ((20, 13), 918)
, ((18, 13), 1000)
, ((0, 23), 688)
, ((14, 11), 345)
, ((0, 13), 401)
, ((3, 8), 167)
, ((27, 7), 323)
, ((4, 3), 208)
, ((28, 0), 470)
, ((2, 15), 710)
, ((16, 6), 393)
, ((6, 9), 997)
, ((17, 7), 223)
, ((18, 4), 101)
, ((17, 25), 854)
, ((22, 6), 619)
, ((23, 7), 488)
, ((10, 8), 391)
, ((11, 5), 380)
, ((24, 27), 706)
, ((12, 6), 86)
, ((10, 18), 959)
, ((25, 26), 168)
, ((15, 11), 189)
, ((11, 27), 946)
, ((0, 4), 997)
, ((12, 28), 120)
, ((27, 28), 341)
, ((4, 10), 177)
, ((2, 6), 166)
, ((5, 11), 118)
, ((19, 24), 941)
, ((16, 19), 695)
, ((6, 26), 500)
, ((17, 18), 572)
, ((22, 25), 100)
, ((23, 28), 175)
, ((13, 0), 658)
, ((26, 24), 144)
, ((0, 27), 22)
, ((24, 8), 445)
, ((12, 27), 710)
, ((27, 21), -7)
, ((13, 26), 697)
, ((28, 22), 82)
, ((2, 1), 291)
, ((26, 2), 997)
, ((29, 23), 571)
, ((28, 12), 60)
, ((7, 2), 362)
, ((20, 26), 105)
, ((16, 10), 673)
, ((21, 27), 463)
, ((19, 7), 585)
, ((22, 16), 158)
, ((20, 0), 777)
, ((23, 21), 495)
, ((21, 5), 957)
, ((8, 6), 566)
, ((22, 10), 879)
, ((14, 28), 48)
, ((10, 4), 518)
, ((11, 9), 516)
, ((0, 18), 787)
, ((14, 6), 879)
, ((12, 18), 138)
, ((2, 24), 585)
, ((3, 5), 383)
, ((5, 7), 661)
, ((6, 20), 831)
, ((23, 18), 784)
, ((9, 8), 655)
, ((10, 15), 254)
, ((8, 19), 391)
, ((14, 9), 862)
, ((12, 9), 764)
, ((25, 23), 685)
, ((13, 12), 988)
, ((27, 25), 435)
, ((5, 0), 145)
, ((6, 15), 843)
, ((19, 21), -7)
, ((21, 23), 583)
, ((22, 4), 203)
, ((11, 7), 457)
, ((10, 16), 119)
, ((11, 29), 520)
, ((0, 6), 769)
, ((24, 3), 430)
, ((1, 7), 11)
, ((25, 2), 68)
, ((28, 25), 168)
, ((2, 4), 183)
, ((5, 9), 246)
, ((29, 28), 737)
, ((3, 25), 476)
, ((5, 19), 455)
, ((20, 29), 209)
, ((18, 23), 168)
, ((14, 27), 396)
, ((24, 10), 480)
, ((28, 16), 898)
, ((27, 13), 816)
, ((5, 28), 640)
, ((6, 19), 287)
, ((21, 25), -17)
, ((19, 9), 451)
, ((17, 9), 742)
, ((18, 14), 223)
, ((15, 27), 100)
, ((25, 12), 579)
, ((26, 11), 123)
, ((1, 11), 314)
, ((4, 0), 204)
, ((6, 10), -36)
, ((19, 14), 854)
, ((18, 9), 641)
, ((16, 25), 41)
, ((21, 12), 870)
, ((23, 10), 324)
, ((8, 21), 123)
, ((9, 16), 250)
, ((12, 11), 28)
, ((10, 23), 916)
, ((26, 18), 53)
, ((3, 12), 15)
, ((4, 15), 459)
, ((2, 11), 33)
, ((5, 14), 859)
, ((29, 1), -39)
, ((3, 18), -16)
, ((6, 13), 587)
, ((17, 29), 369)
, ((22, 26), 797)
, ((18, 26), 173)
, ((8, 28), 360)
, ((9, 25), 859)
, ((15, 23), 280)
, ((13, 3), 12)
, ((0, 24), 898)
, ((25, 0), 942)
, ((29, 26), 882)
, ((6, 4), 307)
, ((7, 1), 435)
, ((16, 23), 667)
, ((20, 5), 320)
, ((23, 24), 287)
, ((8, 3), 643)
, ((24, 12), 679)
, ((12, 23), 358)
, ((25, 9), 437)
, ((26, 14), 918)
, ((4, 27), 74)
, ((29, 13), 808)
, ((6, 17), 647)
, ((17, 15), 620)
, ((20, 12), 735)
, ((18, 12), 683)
, ((23, 17), 342)
, ((21, 1), 104)
, ((8, 10), 297)
, ((11, 13), 352)
, ((0, 22), -17)
, ((14, 10), 910)
, ((12, 14), 458)
, ((1, 23), -18)
, ((25, 18), -13)
, ((1, 9), 44)
, ((28, 7), 20)
, ((2, 14), -46)
, ((5, 3), 25)
, ((16, 5), 733)
, ((17, 0), 854)
, ((7, 13), 226)
, ((18, 7), 770)
, ((21, 10), 775)
, ((23, 4), 29)
, ((11, 2), 399)
, ((24, 26), 762)
, ((12, 5), 922)
, ((15, 8), 709)
, ((26, 16), 159)
, ((24, 0), 953)
, ((27, 29), 689)
, ((2, 9), 539)
, ((7, 10), 156)
, ((16, 18), -7)
, ((21, 19), 883)
, ((23, 29), 960)
, ((10, 28), 518)
, ((25, 28), 744)
, ((13, 1), 908)
, ((0, 26), 810)
, ((27, 18), 123)
, ((1, 27), 453)
, ((28, 21), 461)
, ((2, 0), 449)
, ((29, 24), 441)
]
case_floydWarshall_normal :: Assertion
case_floydWarshall_normal = do
fmap (fmap fst) m @?= expected
forM_ (IntMap.toList m) $ \(u,m1) -> do
forM_ (IntMap.toList m1) $ \(v,(_,p)) -> do
pathFrom p @?= u
pathTo p @?= v
assertBool (show p ++ " is not a valid path") (isValidPath floydWarshall_example p)
where
m = floydWarshall path floydWarshall_example
expected = IntMap.fromListWith IntMap.union [(u, IntMap.singleton v c) | ((u,v),c) <- xs]
xs =
[ ((1,1),0), ((1,2),-1), ((1,3),-2), ((1,4),0)
, ((2,1),4), ((2,2),0), ((2,3),2), ((2,4),4)
, ((3,1),5), ((3,2),1), ((3,3),0), ((3,4),2)
, ((4,1),3), ((4,2),-1), ((4,3),1), ((4,4),0)
]
-- https://en.wikipedia.org/wiki/Floyd%E2%80%93Warshall_algorithm
floydWarshall_example :: IntMap [OutEdge Cost ()]
floydWarshall_example = IntMap.fromList
[ (1, [(3,-2,())])
, (2, [(1,4,()), (3,3,())])
, (3, [(4,2,())])
, (4, [(2,-1,())])
]
-- ------------------------------------------------------------------------
-- Test harness
graphShortestPathTestGroup :: TestTree
graphShortestPathTestGroup = $(testGroupGenerator)