hgraph-1.10.0.0: tests/Digraph/Connectivity.hs
module Main where
import HGraph.Directed
import HGraph.Directed.Connectivity
import HGraph.Directed.Connectivity.OneWayWellLinkedness
import qualified HGraph.Directed.AdjacencyMap as AM
import qualified Data.Set as S
import qualified Data.Map as M
import Data.Maybe
import TestUtils
import Test.HUnit hiding (Node)
import System.Exit (exitFailure, exitSuccess)
v1 = 1 :: Int
tests = TestList
[ TestLabel "Maximal paths 1" $ TestCase
( do
let d = addVertex v1 AM.emptyDigraph
ps = allMaximalPaths d
assertEqual "Paths"
[[1]]
ps
)
, TestLabel "Maximal paths 2" $ TestCase
( do
let d = foldr addArc (foldr addVertex AM.emptyDigraph [v1,2]) [(1,2)]
ps = allMaximalPaths d
assertEqual "Paths"
[[1,2]]
ps
)
, TestLabel "Maximal paths 3" $ TestCase
( do
let d = foldr addArc (foldr addVertex AM.emptyDigraph [v1,2,3,4,5]) [(1,2), (2,3), (3,4), (4,5)]
ps = allMaximalPaths d
assertEqual "Paths"
[[1,2,3,4,5]]
ps
)
, TestLabel "Maximal paths 4" $ TestCase
( do
let d = foldr addArc (foldr addVertex AM.emptyDigraph [v1,2,3,4]) $ zip [1,2,3,4] [2,3,4,1]
ps = allMaximalPaths d
assertEqual "Paths"
(S.fromList $ [ arcSet [1,2,3,4,1]])
(S.fromList $ map arcSet ps)
)
, TestLabel "Maximal paths 5" $ TestCase
( do
let d = foldr addArc (foldr addVertex AM.emptyDigraph [v1,2,3,4,5]) $ zip [1,2,5,5] [5,5,3,4]
ps = allMaximalPaths d
assertEqual "Paths"
(S.fromList [[1,5,3], [2,5,3], [1,5,4], [2,5,4]])
(S.fromList ps)
)
, TestLabel "Maximal paths 6" $ TestCase
( do
let d = foldr addArc (foldr addVertex AM.emptyDigraph [v1,2,3]) $
[ (v,u)
| v <- [1..3]
, u <- [1..3]
, u /= v
]
ps = allMaximalPaths d
assertEqual "Paths"
(S.fromList $ map arcSet
[ [1,2,1], [1,3,1]
, [1,2,3,1], [1,3,2,1]
, [2,3,2]
]
)
(S.fromList $ map arcSet ps)
)
, TestLabel "Maximal paths 7" $ TestCase
( do
let d = foldr addArc (foldr addVertex AM.emptyDigraph [0,1,2,3,4]) $
[ (0,1), (0,2), (0,4)
, (1,0), (2,1), (2,4)
, (3,1), (3,2), (3,4)
, (4,0)
]
ps = allMaximalPaths d
assertEqual "Paths"
(S.fromList $ map arcSet
[ [3,2,4,0,1], [3,4,0,1]
, [3,4,0,2,1], [3,1,0,2,4]
, [3,2,1,0,4], [3,1,0,4]
]
)
(S.fromList $ map arcSet ps)
)
, TestLabel "Maximum flow 0" $ TestCase
( do
let w = 2
h = 4
s = w * h
t = s + 1
let d = foldr addArc (foldr addVertex (AM.emptyDigraph :: AM.Digraph Int) (s:t:[0..w * h - 1])) $
[ (v, v + 1)
| r <- [0..h-1]
, c <- [0..w-2]
, let v = r*w + c
]
++
[ (v, v + w)
| r <- [0..h-2]
, c <- [0..w-1]
, let v = r*w + c
]
++
[(s,a) | a <- [0,w,2*w]]
++
[(b,t) | b <- [w+1, 2*w + 1, 3*w + 1]]
flow = maxFlow d s t
assertEqual "s degree"
( 3 )
(length [v | v <- vertices d, M.lookup (s,v) flow == Just True])
assertEqual "t degree"
( 3 )
(length [v | v <- vertices d, M.lookup (v,t) flow == Just True])
)
, TestLabel "Linkage 1" $ TestCase
( do
let d = foldr addArc (foldr addVertex (AM.emptyDigraph :: AM.Digraph Int) [0,1]) $
[ (0,1), (1,0) ]
inst0 =
LinkageInstance
{ liLinkage = M.fromList $
concatMap (\(i, (s,t)) -> [(s, i), (t, i)]) [(0,(0,1))]
, liTerminalPairs = M.singleton 0 (0,1)
, liPath = M.empty
}
{-assertEqual "extend 0-1 linkage"
(Just inst0{liPath = M.singleton 0 [0,1]})
(extendLinkage d inst0)-}
assertBool "0-1 linkage"
(isJust $ linkageI d [(0,1)])
assertBool "0-1 1-0 linkage"
(isJust $ linkageI d [(0,1), (1,0)])
)
, TestLabel "Linkage 2" $ TestCase
( do
let d = foldr addArc (foldr addVertex (AM.emptyDigraph :: AM.Digraph Int) [0,1,2]) $
[ (0,1), (1,2), (2,0) ]
inst0 =
LinkageInstance
{ liLinkage = M.fromList $
concatMap (\(i, (s,t)) -> [(s, i), (t, i)]) [(0,(0,2)), (1, (2,0))]
, liTerminalPairs = M.fromList [(0,(0,2)), (1,(2,0))]
, liPath = M.empty
}
assertEqual "extend 0-2 linkage"
(Just inst0{ liPath = M.singleton 0 [2,1]
, liLinkage = M.fromList [(0,1), (1,0), (2,1)]
, liTerminalPairs = M.fromList [(0, (0,1)), (1, (2,0))]
})
(extendLinkage d inst0)
assertBool "0-2 linkage"
(isJust $ linkageI d [(0,2)])
assertBool "0-2 2-0 linkage"
(isJust $ linkageI d [(0,2), (2,0)])
)
, TestLabel "Linkage 3" $ TestCase
( do
let d = foldr addArc (foldr addVertex (AM.emptyDigraph :: AM.Digraph Int) [0..11]) $
[ (0,1), (1,2), (2,1)
, (1,0), (1,4), (1,7)
, (3,4), (3,5), (3,11)
, (4,6), (4,5), (4,7), (4,3)
, (5,10), (5,6), (5,8), (5,3)
, (6,4), (6,5)
, (7,9), (7,8)
, (8,9), (8,10)
, (11,3)
]
assertBool "0-10 linkage"
(isJust $ linkageI d [(0,10)])
assertBool "3-9 linkage"
(isJust $ linkageI d [(3,9)])
assertBool "0-10 3-9 linkage"
(isNothing $ linkageI d [(0,10), (3,9)])
)
, TestLabel "Well-linked sets 0" $ TestCase
( do
-- 0 → 1 → 2 → 3
-- ↓ ↓ ↓ ↓
-- 4 → 5 → 6 → 7
-- ↓ ↓ ↓ ↓
-- 8 → 9 → 10 → 11
-- ↓ ↓ ↓ ↓
-- 12 → 13 → 14 → 15
-- ↓ ↓ ↓ ↓
-- 16 → 17 → 18 → 19
let w = 4
h = 5
let d = foldr addArc (foldr addVertex (AM.emptyDigraph :: AM.Digraph Int) [0..w * h - 1]) $
[ (v, v + 1)
| r <- [0..h-1]
, c <- [0..w-2]
, let v = r*w + c
]
++
[ (v, v + w)
| r <- [0..h-2]
, c <- [0..w-1]
, let v = r*w + c
]
assertEqual "0,4 → 11,15 well-linked"
Nothing
(separableSets d [0,4] [11,15])
assertEqual "4,8 → 5,9 not well-linked"
(Just ([8],[5]))
(separableSets d [4,8] [5,9])
assertEqual "0,4,8 → 9,13,17 not well-linked"
(Just ([0,4,8],[9,13,17]))
(separableSets d [0,4,8] [9,13,17])
)
, TestLabel "Well-linked sets 0" $ TestCase
( do
-- 4
-- ↓
-- 2 → 1 → 0
-- ↓ ↑ ↓
-- ∟ → 3 → 5
let d = foldr addArc (foldr addVertex (AM.emptyDigraph :: AM.Digraph Int) [0..5]) $
[ (0, 5)
, (1, 0)
, (2, 1), (2, 3)
, (3, 1), (3, 5)
, (4, 1)
]
dSplit = splitVertices d
s = numVertices dSplit
t = s + 1
a = map (2*) [2,3,4]
b = map (\v -> 2*v + 1) [0,1,5]
dSplit' = foldr addArc (foldr addVertex dSplit [s,t]) $
[(s, va) | va <- a] ++
[(vb, t) | vb <- b]
assertEqual "max flow 2"
2
(maxFlowValue dSplit' s t)
assertEqual "no 3 one-way-well-linked set pair"
Nothing
(vertexWellLinkedPair d 3)
)
, TestLabel "Vertex well-linked sets 1" $ TestCase
( do
-- 0 → 1
-- ↓ ↓
-- 2 → 3
-- ↓ ↓
-- 4 → 5
let w = 2
h = 3
let d = foldr addArc (foldr addVertex (AM.emptyDigraph :: AM.Digraph Int) [0..w * h - 1]) $
[ (v, v + 1)
| r <- [0..h-1]
, c <- [0..w-2]
, let v = r*w + c
]
++
[ (v, v + w)
| r <- [0..h-2]
, c <- [0..w-1]
, let v = r*w + c
]
dSplit = splitVertices d
assertEqual "0,2 → 3,5 edge well-linked"
(Just (S.fromList [0,2], S.fromList [3,4]))
(edgeWellLinkedPair (removeVertex 5 d) 2)
assertEqual "0,2 → 3,5 well-linked"
(Just (S.fromList [0,1], S.fromList [3,5]))
(vertexWellLinkedPair d 2)
)
, TestLabel "Strong components 1" $ TestCase
( do
let d = digraphFromArcList AM.emptyDigraph [(0,1), (0,2), (1,3), (2,3)]
components0 = strongComponents d
assertEqual "Vertices" 4 (numVertices d)
assertEqual "Arcs" 4 (numArcs d)
assertEqual "Strong components 0"
(S.fromList [[0],[1],[2],[3]])
(S.fromList components0)
let d1 = addArc (3,0) d
components1 = strongComponents d1
assertEqual "Strong components 1"
([S.fromList [0,1,2,3]])
(map S.fromList components1)
)
]
arcSet p = S.fromList $ zip p $ tail p
main = do
count <- runTestTT tests
if errors count + failures count > 0 then exitFailure else exitSuccess