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