module Main where import HGraph.Directed import HGraph.Directed.Subgraph import qualified HGraph.Directed.AdjacencyMap as AM import qualified Data.Map as M import qualified Data.Set as S import Test.HUnit hiding (Node) import System.Exit (exitFailure, exitSuccess) tests = TestList [ TestLabel "Subgraph 0" $ TestCase ( do let d = addVertex 1 AM.emptyDigraph assertBool "Subgraph" (d `contains` d) ) , TestLabel "Subgraph 1" $ TestCase ( do let d = foldr addVertex AM.emptyDigraph [0,1] h1 = foldr addVertex AM.emptyDigraph [1] h2 = foldr addVertex AM.emptyDigraph [2] assertBool "Subgraph h1" (d `contains` h1) assertBool "Subgraph h2" (not $ d `contains` h2) assertBool "Iso h2" (isSubgraphIsomorphism d h2 (M.singleton 2 1)) assertBool "Subgraph Iso h2" (h2 `isSubgraphOf` d) ) , TestLabel "Subgraph 2" $ TestCase ( do let d = foldr addArc (foldr addVertex AM.emptyDigraph [0,1,2,3]) $ zip [0,1,2] [1,2,3] h = foldr addArc (foldr addVertex AM.emptyDigraph [0,1]) $ zip [0] [1] assertBool "Subgraph h" (d `contains` h) assertBool "Iso h" (isSubgraphIsomorphism d h (M.fromList [(0,0), (1,1)])) assertBool "Subgraph Iso h" (h `isSubgraphOf` d) ) , TestLabel "Subgraph 3" $ TestCase ( do let d = foldr addArc (foldr addVertex AM.emptyDigraph [0,1,2,3]) $ zip [0,0,0,1] [1,2,3,0] h1 = foldr addArc (foldr addVertex AM.emptyDigraph [0,1,2,3,4]) $ [] h2 = foldr addArc (foldr addVertex AM.emptyDigraph [0,1,2]) $ zip [0,0,1] [1,2,0] assertBool "not subgraph h" (not $ h1 `isSubgraphOf` d) assertBool "Subgraph Iso h" (h2 `isSubgraphOf` d) ) , TestLabel "Subgraph 4" $ TestCase ( do let d = foldr addArc (foldr addVertex AM.emptyDigraph [0,1]) $ zip [0] [1] h1 = foldr addArc (foldr addVertex AM.emptyDigraph [0,1]) $ zip [0,1] [1,0] h2 = foldr addArc (foldr addVertex AM.emptyDigraph [0,1,2]) $ zip [0,1] [1,2] assertBool "subgraph iso h1" (d `isSubgraphOf` h1) assertBool "Subgraph Iso h2" (d `isSubgraphOf` h2) ) ] arcSet p = S.fromList $ zip p $ tail p main = do count <- runTestTT tests if errors count + failures count > 0 then exitFailure else exitSuccess