swish-0.9.0.0: tests/GraphTest.hs
--------------------------------------------------------------------------------
-- See end of this file for licence information.
--------------------------------------------------------------------------------
-- |
-- Module : GraphTest
-- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011, 2012 Douglas Burke
-- License : GPL V2
--
-- Maintainer : Douglas Burke
-- Stability : experimental
-- Portability : H98
--
-- This module defines test cases for module Graph.
--
--------------------------------------------------------------------------------
module Main where
import qualified Data.Foldable as F
import Test.HUnit
( Test(TestCase,TestList,TestLabel),
assertEqual, assertBool )
import Swish.GraphClass (Arc(..), ArcSet, LDGraph(..), Label(..))
import Swish.GraphClass (arc, arcFromTriple, arcToTriple)
import Swish.GraphMem
import Swish.GraphMatch
( LabelMap, GenLabelMap(..),
EquivalenceClass,
ScopedLabel(..), makeScopedLabel, makeScopedArc,
LabelIndex, nullLabelVal, emptyMap,
mapLabelIndex, {-mapLabelList,-} setLabelHash, newLabelMap,
graphLabels, assignLabelMap, newGenerationMap
-- graphMatch1 only used with pairSort
, equivalenceClasses
)
-- import Swish.Utils.ListHelpers (subset)
import TestHelpers (runTestSuite, testEq, testNe)
import Data.Function (on)
import Data.Hashable (hashWithSalt)
import Data.List (sort, sortBy, elemIndex)
import Data.Maybe (fromJust)
import Data.Ord (comparing)
import Data.Word (Word32)
import qualified Data.Map as M
import qualified Data.Set as S
default ( Int )
------------------------------------------------------------
-- Define some common values
------------------------------------------------------------
type Statement = Arc LabelMem
base1, base2, base3, base4 :: String
base1 = "http://id.ninebynine.org/wip/2003/test/graph1/node#"
base2 = "http://id.ninebynine.org/wip/2003/test/graph2/node/"
base3 = "http://id.ninebynine.org/wip/2003/test/graph3/node"
base4 = "http://id.ninebynine.org/wip/2003/test/graph3/nodebase"
------------------------------------------------------------
-- Set, get graph arcs as sets of triples
------------------------------------------------------------
setArcsT :: (Ord lb, LDGraph lg lb) =>
S.Set (lb, lb, lb) -> lg lb -> lg lb
setArcsT a g = setArcs g $ S.map arcFromTriple a
getArcsT :: (Ord lb, LDGraph lg lb) =>
lg lb -> S.Set (lb, lb, lb)
getArcsT g = S.map arcToTriple $ getArcs g
------------------------------------------------------------
-- Label map and entry creation helpers
------------------------------------------------------------
tstLabelMap :: (Label lb) => Word32 -> [(lb,LabelIndex)] -> LabelMap lb
tstLabelMap gen = LabelMap gen . M.fromList
------------------------------------------------------------
-- Graph helper function tests
------------------------------------------------------------
{-
-- select; no longer exported so need to check that
-- other tests still test this routine
testSelect :: String -> String -> String -> Test
testSelect lab = testEq ("Select"++lab )
isOne :: Int -> Bool
isOne = (1 ==)
testSelect01, testSelect02, testSelect03, testSelect04 :: Test
testSelect01 = testSelect "01"
(select isOne [0,1,2,0,1,2] "abcabc") "bb"
testSelect02 = testSelect "02"
(select isOne [1,1,1,1,1,1] "abcabc") "abcabc"
testSelect03 = testSelect "03"
(select isOne [0,0,0,0,0,0] "abcabc")
[]
testSelect04 = testSelect "04"
(select isOne [] [] )
[]
testSelectSuite :: Test
testSelectSuite = TestList
[
testSelect01, testSelect02, testSelect03, testSelect04
]
-}
-- subset: hopefully can remove soon
{-
testSubset :: String -> Bool -> [Int] -> [Int] -> Test
testSubset lab res l1s l2s = testEq ("Mapset"++lab ) res (l1s `subset` l2s)
testSubsetSuite :: Test
testSubsetSuite = TestList
[ testSubset "01" True [1,2,3] [0,1,2,3,4,5]
, testSubset "02" True [5,3,1] [0,1,2,3,4,5]
, testSubset "03" True [5,4,3,2,1,0] [0,1,2,3,4,5]
, testSubset "04" True [] []
, testSubset "05" False [0,1,2,3,4,5] [1,2,3]
, testSubset "06" False [0,1,2,3,4,5] [5,3,1]
, testSubset "07" True [] [1,2,3]
, testSubset "08" False [1,2,3] []
]
-}
------------------------------------------------------------
-- Simple graph label tests
------------------------------------------------------------
testLabSuite :: Test
testLabSuite = TestList
[ testEq "Lab01" False (labelIsVar lab1f)
, testEq "Lab02" True (labelIsVar lab1v)
, testEq "Lab03" False (labelIsVar lab2f)
, testEq "Lab04" True (labelIsVar lab2v)
{- This just tests the hash routine, which doesn't
really tell us that much, so replace by checks that the
hashes aren't the same
, testEq "Lab05" 39495998 (labelHash 1 lab1f)
, testEq "Lab06" 45349309 (labelHash 1 lab1v)
, testEq "Lab07" 39495997 (labelHash 1 lab2f)
, testEq "Lab08" 45349310 (labelHash 1 lab2v)
-}
, testNe "Hash Lab05/6" (labelHash 1 lab1f) (labelHash 1 lab1v)
, testNe "Hash Lab05/7" (labelHash 1 lab1f) (labelHash 1 lab2f)
, testNe "Hash Lab06/8" (labelHash 1 lab1v) (labelHash 1 lab2v)
, testNe "Hash Lab07/8" (labelHash 1 lab2f) (labelHash 1 lab2v)
, testNe "Hash Lab05/8" (labelHash 1 lab1f) (labelHash 1 lab2v)
, testNe "Hash Lab06/7" (labelHash 1 lab1v) (labelHash 1 lab2f)
, testEq "Lab09" "!lab1" (show lab1f)
, testEq "Lab10" "?lab1" (show lab1v)
, testEq "Lab11" "!lab2" (show lab2f)
, testEq "Lab12" "?lab2" (show lab2v)
, testEq "Lab13" "lab1" (getLocal lab1v)
, testEq "Lab14" "lab2" (getLocal lab2v)
, testEq "Lab15" lab1v (makeLabel "lab1")
, testEq "Lab16" lab2v (makeLabel "lab2")
]
------------------------------------------------------------
-- Simple graph tests
------------------------------------------------------------
lab1f, lab1v, lab2f, lab2v :: LabelMem
lab1f = LF "lab1"
lab1v = LV "lab1"
lab2f = LF "lab2"
lab2v = LV "lab2"
ga1 :: S.Set (LabelMem, LabelMem, LabelMem)
ga1 = S.fromList
[
(lab1f,lab1f,lab1f),
(lab1v,lab1v,lab1v),
(lab2f,lab2f,lab2f),
(lab2v,lab2v,lab2v),
(lab1f,lab1f,lab1v),
(lab1f,lab1f,lab2f),
(lab1f,lab1f,lab2v),
(lab1v,lab1v,lab1f),
(lab1v,lab1v,lab2f),
(lab1v,lab1v,lab2v),
(lab1f,lab1v,lab2f),
(lab1f,lab1v,lab2v),
(lab1v,lab2f,lab2v)
]
gs4 :: Statement -> Bool
gs4 (Arc _ _ (LV "lab2")) = True
gs4 _ = False
ga4 :: S.Set (LabelMem, LabelMem, LabelMem)
ga4 = S.fromList
[
(lab2v,lab2v,lab2v),
(lab1f,lab1f,lab2v),
(lab1v,lab1v,lab2v),
(lab1f,lab1v,lab2v),
(lab1v,lab2f,lab2v)
]
ga2 :: S.Set (LabelMem, LabelMem, LabelMem)
ga2 = S.fromList
[
(lab1f,lab1f,lab1f),
(lab1v,lab1v,lab1v),
(lab2f,lab2f,lab2f),
(lab2v,lab2v,lab2v)
]
ga3 :: S.Set (LabelMem, LabelMem, LabelMem)
ga3 = S.fromList
[
(lab1f,lab1f,lab1v),
(lab1f,lab1f,lab2f),
(lab1f,lab1f,lab2v),
(lab1v,lab1v,lab1f),
(lab1v,lab1v,lab2f),
(lab1v,lab1v,lab2v),
(lab1f,lab1v,lab2f),
(lab1f,lab1v,lab2v),
(lab1v,lab2f,lab2v)
]
gl4 :: S.Set LabelMem
gl4 = S.fromList [lab1f,lab1v,lab2f,lab2v]
gr1a, gr2a, gr3a, gr4a, gr4b, gr4c, gr4d, gr4e,
gr4g :: GraphMem LabelMem
gr1a = setArcsT ga1 (GraphMem S.empty)
gr2a = setArcsT ga2 emptyGraph
gr3a = setArcsT ga3 emptyGraph
gr4a = addGraphs gr2a gr3a
gr4b = addGraphs gr3a gr2a
gr4c = delete gr2a gr4a
gr4d = delete gr3a gr4a
gr4e = extract gs4 gr4a
gr4g = addGraphs gr2a gr4a
gl4f :: S.Set LabelMem
gl4f = labels gr4a
{-
gr4ee :: [Bool]
gr4ee = map gs4 $ S.toList (getArcs gr4a)
-}
testGraphSuite :: Test
testGraphSuite = TestList
[ testEq "Graph01" ga1 (getArcsT gr1a)
, testEq "Graph01" ga2 (getArcsT gr2a)
, testEq "Graph03" ga3 (getArcsT gr3a)
, testEq "Graph04" ga1 (getArcsT gr4a)
, testEq "Graph05" ga1 (getArcsT gr4b)
, testEq "Graph06" ga3 (getArcsT gr4c)
, testEq "Graph07" ga2 (getArcsT gr4d)
, testEq "Graph08" ga4 (getArcsT gr4e)
, testEq "Graph09" gl4 gl4f
, testEq "Graph10" ga1 (getArcsT gr4g)
]
------------------------------------------------------------
--
------------------------------------------------------------
------------------------------------------------------------
-- Define some common values
------------------------------------------------------------
s1, s2, s3, s4, s5, s6, s7, s8 :: LabelMem
s1 = LF "s1"
s2 = LF "s2"
s3 = LF "s3"
s4 = LF ""
s5 = LV "s5"
s6 = LF "basemore"
s7 = LF ("base"++"more")
s8 = LV "s8"
b1, b2, b3, b4 :: LabelMem
b1 = LV "b1"
b2 = LV "b2"
b3 = LV "b3"
b4 = LV "b4"
p1, p2, p3, p4 :: LabelMem
p1 = LF "p1"
p2 = LF "p2"
p3 = LF "p3"
p4 = LF "p4"
o1, o2, o3, o4, o5, o6 :: LabelMem
o1 = LF "o1"
o2 = LF "o2"
o3 = LF "o3"
o4 = LF ""
o5 = LV "o5"
o6 = LV "s5"
l1, l2, l3, l4, l5, l6, l7, l8, l9,
l10, l11, l12 :: LabelMem
l1 = LF "l1"
l2 = LF "l2-en"
l3 = LF "l2-fr"
l4 = LF "l4-type1"
l5 = LF "l4-type1"
l6 = LF "l4-type1"
l7 = LF "l4-type2"
l8 = LF "l4-type2"
l9 = LF "l4-type2"
l10 = LF "l10-xml"
l11 = LF "l10-xml-en"
l12 = LF "l10-xml-fr"
v1, v2, v3, v4 :: LabelMem
v1 = LV "v1"
v2 = LV "v2"
v3 = LV "v3"
v4 = LV "v4"
------------------------------------------------------------
-- Label construction and equality tests
------------------------------------------------------------
testLabelEq :: String -> Bool -> LabelMem -> LabelMem -> Test
testLabelEq lab eq n1 n2 =
TestCase ( assertEqual ("testLabelEq:"++lab) eq (n1==n2) )
nodelist :: [(String, LabelMem)]
nodelist =
[ ("s1",s1), ("s2",s2), ("s3",s3), ("s4",s4), ("s5",s5),
("s6",s6), ("s7",s7), ("s8",s8),
("o5",o5),
("p1",p1), ("p2",p2), ("p3",p3), ("p4",p4),
("o1",o1), ("o2",o2), ("o3",o3), ("o4",o4),
("l1",l1), ("l2",l2), ("l3",l3), ("l4",l4), ("l5",l5),
("l6",l6), ("l7",l7), ("l8",l8), ("l9",l9),
("l10",l10), ("l11",l11), ("l12",l12),
("v1",v1), ("v2",v2)
]
nodeeqlist :: [(String, String)]
nodeeqlist =
[
("s4","o4"),
("s5","o6"),
("s6","s7"),
("l4","l5"),
("l4","l6"),
("l5","l6"),
("l7","l8"),
("l7","l9"),
("l8","l9")
]
testLabelEqSuite :: Test
testLabelEqSuite = TestList
[ testLabelEq (testLab a b) (nodeTest a b) n1 n2
| (a,n1) <- nodelist , (b,n2) <- nodelist ]
where
testLab a b = a ++ "-" ++ b
nodeTest a b = (a == b) ||
(a,b) `elem` nodeeqlist ||
(b,a) `elem` nodeeqlist
------------------------------------------------------------
-- Label ordering tests
------------------------------------------------------------
testLabelOrd :: String -> Ordering -> LabelMem -> LabelMem -> Test
testLabelOrd lab order n1 n2 =
TestCase ( assertEqual ("testLabelOrd:"++lab) order (compare n1 n2) )
nodeorder :: [String]
nodeorder =
[
"o4",
"s4", "s6", "s7",
"l1", "l10", "l11", "l12", "l2", "l3", "l4", "l5", "l6", "l7", "l8", "l9",
"o1", "o2", "o3",
"p1", "p2", "p3", "p4",
"s1", "s2", "s3",
"b1", "b2", "b3", "b4",
"o5",
"s5", "s8",
"v1", "v2"
]
testLabelOrdSuite :: Test
testLabelOrdSuite = TestList
[ testLabelOrd (testLab a b) (testOrd a b) n1 n2
| (a,n1) <- nodelist , (b,n2) <- nodelist ]
where
testLab a b = a ++ "-" ++ b
testOrd a b
| nodeTest a b = EQ
| otherwise = comparing fromJust
(elemIndex a nodeorder)
(elemIndex b nodeorder)
nodeTest a b = (a == b) ||
(a,b) `elem` nodeeqlist ||
(b,a) `elem` nodeeqlist
------------------------------------------------------------
-- Statement construction and equality tests
------------------------------------------------------------
testStmtEq :: String -> Bool -> Statement -> Statement -> Test
testStmtEq lab eq t1 t2 =
TestCase ( assertEqual ("testStmtEq:"++lab) eq (t1==t2) )
-- String argument is no longer needed, due to refactoring of
-- tlist, but left in
--
slist :: [(String, LabelMem)]
slist =
[
("s1",s1), ("s4",s4), ("s5",s5), ("s6",s6), ("s7",s7)
]
plist :: [(String, LabelMem)]
plist =
[
("p1",p1)
]
olist :: [(String, LabelMem)]
olist =
[ ("o1",o1), ("o4",o4), ("o5",o5),
("l1",l1), ("l4",l4), ("l7",l7), ("l8",l8), ("l10",l10)
]
tlist :: [(String, Statement)]
tlist =
[ t s p o | (_,s) <- slist, (_,p) <- plist, (_,o) <- olist ]
where
t s p o = let a = Arc s p o in (show a, a)
stmteqlist :: [(String, String)]
stmteqlist =
[
("(s6,p1,l1)", "(s7,p1,l1)"),
("(s6,p1,l4)", "(s7,p1,l4)"),
("(s6,p1,l7)", "(s7,p1,l7)"),
("(s6,p1,l7)", "(s7,p1,l8)"),
("(s6,p1,l8)", "(s7,p1,l7)"),
("(s6,p1,l8)", "(s7,p1,l8)"),
("(s6,p1,l10)","(s7,p1,l10)"),
("(s6,p1,o1)", "(s7,p1,o1)"),
("(s6,p1,o4)", "(s7,p1,o4)"),
("(s6,p1,o5)", "(s7,p1,o5)"),
("(s1,p1,l7)", "(s1,p1,l8)"),
("(s4,p1,l7)", "(s4,p1,l8)"),
("(s5,p1,l7)", "(s5,p1,l8)"),
("(s6,p1,l7)", "(s6,p1,l8)"),
("(s7,p1,l7)", "(s7,p1,l8)")
]
testStmtEqSuite :: Test
testStmtEqSuite = TestList
[ testStmtEq (testLab a b) (nodeTest a b) t1 t2
| (a,t1) <- tlist , (b,t2) <- tlist ]
where
testLab a b = a ++ "-" ++ b
nodeTest a b = (a == b) ||
(a,b) `elem` stmteqlist ||
(b,a) `elem` stmteqlist
------------------------------------------------------------
-- Graph element handling support routines
------------------------------------------------------------
lmap :: LabelMap LabelMem
lmap = tstLabelMap 5 [(s1,(1,1)),(s2,(2,2)),(s3,(3,3)),(s4,(4,4)),
(o1,(1,1)),(o2,(2,2)),(o3,(3,3))]
-- setLabelHash :: (Label lb) => LabelMap lb -> (lb,Int) -> LabelMap lb
lmap1, lmap2a, lmap2b, lmap3 :: LabelMap LabelMem
lmap1 = setLabelHash lmap (s2,22)
lmap2a = setLabelHash lmap1 (o1,66)
lmap2b = setLabelHash lmap2a (o5,67)
-- newLabelMap :: (Label lb) => LabelMap lb -> [(lb,Int)] -> LabelMap lb
lmap3 = newLabelMap lmap [(s1,61),(s3,63),(o2,66)]
llst :: [String]
llst = ["s1","s2","s3","s4","o1","o2","o3"]
-- showLabelMap :: (Label lb) => LabelMap lb -> String
testShowLabelMap :: Test
testShowLabelMap = testEq "showLabelMap" showMap (show lmap)
where
showMap = "LabelMap gen=5, map=\n"++
" (!,(4,4))\n"++
" (!o1,(1,1))\n"++
" (!o2,(2,2))\n"++
" (!o3,(3,3))\n"++
" (!s1,(1,1))\n"++
" (!s2,(2,2))\n"++
" (!s3,(3,3))"
testMapLabelHash00 :: Test
testMapLabelHash00 = testEq "mapLabelHash00" showMap (show lmap1)
where
showMap = "LabelMap gen=5, map=\n"++
" (!,(4,4))\n"++
" (!o1,(1,1))\n"++
" (!o2,(2,2))\n"++
" (!o3,(3,3))\n"++
" (!s1,(1,1))\n"++
" (!s2,(5,22))\n"++
" (!s3,(3,3))"
-- mapLabelIndex :: (Label lb) => LabelMap lb -> lb -> LabelIndex
testLabelMapSuite :: Test
testLabelMapSuite = TestList
[ testShowLabelMap
, testMapLabelHash00
, testEq "testMapLabelIndex01" (1,1) (mapLabelIndex lmap s1 )
, testEq "testMapLabelIndex02" (2,2) (mapLabelIndex lmap s2 )
, testEq "testMapLabelIndex03" (3,3) (mapLabelIndex lmap s3 )
, testEq "testMapLabelIndex04" (4,4) (mapLabelIndex lmap s4 )
, testEq "testMapLabelIndex05" (1,1) (mapLabelIndex lmap o1 )
, testEq "testMapLabelIndex06" (4,4) (mapLabelIndex lmap o4 )
, testEq "testMapLabelIndex07" nullLabelVal (mapLabelIndex lmap o5 )
, testEq "testMapLabelIndex08" nullLabelVal (mapLabelIndex lmap o6 )
, testEq "MapLabelHash01" (1,1) (mapLabelIndex lmap1 s1 )
, testEq "MapLabelHash02" (5,22) (mapLabelIndex lmap1 s2 )
, testEq "MapLabelHash03" (3,3) (mapLabelIndex lmap1 s3 )
, testEq "MapLabelHash04" (4,4) (mapLabelIndex lmap1 s4 )
, testEq "MapLabelHash05" (1,1) (mapLabelIndex lmap1 o1 )
, testEq "MapLabelHash06" (4,4) (mapLabelIndex lmap1 o4 )
, testEq "MapLabelHash07" nullLabelVal (mapLabelIndex lmap1 o5 )
, testEq "MapLabelHash08" nullLabelVal (mapLabelIndex lmap1 o6 )
, testEq "MapLabelHash11" (1,1) (mapLabelIndex lmap2b s1 )
, testEq "MapLabelHash12" (5,22) (mapLabelIndex lmap2b s2 )
, testEq "MapLabelHash13" (3,3) (mapLabelIndex lmap2b s3 )
, testEq "MapLabelHash14" (4,4) (mapLabelIndex lmap2b s4 )
, testEq "MapLabelHash15" (5,66) (mapLabelIndex lmap2b o1 )
, testEq "MapLabelHash16" (2,2) (mapLabelIndex lmap2b o2 )
, testEq "MapLabelHash17" (4,4) (mapLabelIndex lmap2b o4 )
, testEq "MapLabelHash18" nullLabelVal (mapLabelIndex lmap1 o5 )
, testEq "LabelMap01" (6,61) (mapLabelIndex lmap3 s1 )
, testEq "LabelMap02" (2,2) (mapLabelIndex lmap3 s2 )
, testEq "LabelMap03" (6,63) (mapLabelIndex lmap3 s3 )
, testEq "LabelMap04" (4,4) (mapLabelIndex lmap3 s4 )
, testEq "LabelMap05" (1,1) (mapLabelIndex lmap3 o1 )
, testEq "LabelMap06" (6,66) (mapLabelIndex lmap3 o2 )
]
------------------------------------------------------------
-- Graph matching support
------------------------------------------------------------
t01, t02, t03, t04, t05, t06 :: Statement
t01 = arc s1 p1 o1
t02 = arc s2 p1 o2
t03 = arc s3 p1 o3
t04 = arc s1 p1 l1
t05 = arc s2 p1 l4
t06 = arc s3 p1 l10
tOrder16 :: [Statement]
tOrder16 = [t04, t01, t05, t02, t06, t03]
t10, t11, t12 :: Statement
t10 = arc s1 p1 b1
t11 = arc b1 p2 b2
t12 = arc b2 p3 o1
t20, t21, t22 :: Statement
t20 = arc s1 p1 b3
t21 = arc b3 p2 b4
t22 = arc b4 p3 o1
as1, as2, as4, as5, as6 :: S.Set Statement
as1 = S.singleton t01
as2 = S.fromList [t01,t02,t03,t04,t05,t06]
as4 = S.fromList [t01,t02,t03,t04,t05,t06,t10,t11,t12]
as5 = S.fromList [t01,t02,t03,t04,t05,t06,t20,t21,t22]
as6 = S.fromList [t01,t02,t03,t04,t05,t06,t10,t11,t12,t20,t21,t22]
-- graphLabels :: (Label lb) => ArcSet lb -> S.Set lb
-- not clear both the 'raw' and 'string' versions are still needed.
ls4, glas4 :: S.Set LabelMem
ls4 = S.fromList [s1,s2,s3,p1,p2,p3,o1,o2,o3,l1,l4,l10,b1,b2]
glas4 = graphLabels as4
testGraphLabels04, testGraphLabels14 :: Test
testGraphLabels04 = testEq "GraphLabels04" ls4 glas4
testGraphLabels14 = testEq "GraphLabels14" str (show glas4)
where
-- str = "[!s1,!p1,!o1,!s2,!o2,!s3,!o3,!l1,!l4-type1,!l10-xml,?b1,!p2,?b2,!p3]"
str = "fromList [!l1,!l10-xml,!l4-type1,!o1,!o2,!o3,!p1,!p2,!p3,!s1,!s2,!s3,?b1,?b2]"
-- str = show ls4
ls5, glas5 :: S.Set LabelMem
ls5 = S.fromList [s1,s2,s3,p1,p2,p3,o1,o2,o3,l1,l4,l10,b3,b4]
glas5 = graphLabels as5
testGraphLabels05, testGraphLabels15 :: Test
testGraphLabels05 = testEq "GraphLabels05" ls5 glas5
testGraphLabels15 = testEq "GraphLabels15" str (show glas5)
where
-- str = "[!s1,!p1,!o1,!s2,!o2,!s3,!o3,!l1,!l4-type1,!l10-xml,?b3,!p2,?b4,!p3]"
str = "fromList [!l1,!l10-xml,!l4-type1,!o1,!o2,!o3,!p1,!p2,!p3,!s1,!s2,!s3,?b3,?b4]"
-- str = show ls5
ls6, glas6 :: S.Set LabelMem
ls6 = S.fromList [s1,s2,s3,p1,p2,p3,o1,o2,o3,l1,l4,l10,b1,b2,b3,b4]
glas6 = graphLabels as6
testGraphLabels06, testGraphLabels16 :: Test
testGraphLabels06 = testEq "GraphLabels05" ls6 glas6
testGraphLabels16 = testEq "GraphLabels16" str (show glas6)
where
-- str = "[!s1,!p1,!o1,!s2,!o2,!s3,!o3"++
-- ",!l1,!l4-type1,!l10-xml,?b1,!p2,?b2,!p3,?b3,?b4]"
str = "fromList [!l1,!l10-xml,!l4-type1,!o1,!o2,!o3,!p1,!p2,!p3,!s1,!s2,!s3,?b1,?b2,?b3,?b4]"
-- str = show ls6
-- assignLabels :: (Label lb) => [lb] -> LabelMap lb -> LabelMap lb
bhash :: Word32
-- bhash = 23 -- before trying to support Hashable 1.2.0
bhash = fromIntegral (23 `hashWithSalt` (0::Word32))
-- since the hashing is now done by hashable, is it worth checking
-- the hash values directly? It would perhaps be better to just
-- quickcheck that values get sorted.
-- copy of internal code in GraphMatch
toHash :: (Label lb) => Word32 -> lb -> Word32
toHash s lbl =
fromIntegral $
if labelIsVar lbl
then 23 `hashWithSalt` s
else labelHash (fromIntegral s) lbl
l1hash, l4hash, l10hash :: Word32
l1hash = toHash 0 l1
l4hash = toHash 0 l4
l10hash = toHash 0 l10
l1hash2, l4hash2, l10hash2 :: Word32
l1hash2 = l1hash
l4hash2 = l4hash
l10hash2 = l10hash
o1hash, o2hash, o3hash :: Word32
o1hash = toHash 0 o1
o2hash = toHash 0 o2
o3hash = toHash 0 o3
p1hash, p2hash, p3hash :: Word32
p1hash = toHash 0 p1
p2hash = toHash 0 p2
p3hash = toHash 0 p3
s1hash, s2hash, s3hash :: Word32
s1hash = toHash 0 s1
s2hash = toHash 0 s2
s3hash = toHash 0 s3
lmap5 :: LabelMap LabelMem
lmap5 = tstLabelMap 2
[
(b4,(1,bhash)),
(b3,(1,bhash)),
(l10,(1,l10hash)),
(l4,(1,l4hash)),
(l1,(1,l1hash)),
(o3,(1,o3hash)),
(o2,(1,o2hash)),
(o1,(1,o1hash)),
(p3,(1,p3hash)),
(p2,(1,p2hash)),
(p1,(1,p1hash)),
(s3,(1,s3hash)),
(s2,(1,s2hash)),
(s1,(1,s1hash))
]
testAssignLabelMap05 :: Test
testAssignLabelMap05 = testEq "AssignLabels05" lmap5
(newGenerationMap $ assignLabelMap ls5 emptyMap)
lmap6 :: LabelMap LabelMem
lmap6 = tstLabelMap 2
[
(b2,(2,bhash)),
(b1,(2,bhash)),
(b4,(1,bhash)),
(b3,(1,bhash)),
(l10,(1,l10hash)),
(l4,(1,l4hash)),
(l1,(1,l1hash)),
(o3,(1,o3hash)),
(o2,(1,o2hash)),
(o1,(1,o1hash)),
(p3,(1,p3hash)),
(p2,(1,p2hash)),
(p1,(1,p1hash)),
(s3,(1,s3hash)),
(s2,(1,s2hash)),
(s1,(1,s1hash))
]
testAssignLabelMap06 :: Test
testAssignLabelMap06 = testEq "AssignLabels06" lmap6 (assignLabelMap ls6 lmap5)
lmapc :: LabelMap LabelMem
lmapc = tstLabelMap 1 [(s1,(1,11)),(s2,(1,12)),(s3,(1,13)),
(p1,(1,21)),(p2,(1,22)),(p3,(1,13)),
(o1,(1,31)),(o2,(1,32)),(o3,(1,13)),
(l1,(1,41)),(l4,(1,42)),(l10,(1,43)),
(b1,(1,51)),(b2,(1,51)),(b3,(1,51)),(b4,(1,51))]
-- [[[TODO: test hash value collision on non-variable label]]]
testGraphMatchSupportSuite :: Test
testGraphMatchSupportSuite = TestList
[ testGraphLabels04
, testGraphLabels14
, testGraphLabels05
, testGraphLabels15
, testGraphLabels06
, testGraphLabels16
, testAssignLabelMap05
, testAssignLabelMap06
-- implicitly tested elsewhere but included here for completeness
, testEq "O16-identity" tOrder16 $ sort tOrder16
, testEq "O16-compare" tOrder16 $ sort [t01,t02,t03,t04,t05,t06]
]
------------------------------------------------------------
-- Test steps in graph equality test
------------------------------------------------------------
matchable :: a -> b -> Bool
matchable _ _ = True
s1_1, s2_1, s3_1 :: ScopedLabel LabelMem
s1_1 = makeScopedLabel 1 s1
s2_1 = makeScopedLabel 1 s2
s3_1 = makeScopedLabel 1 s3
p1_1, p2_1, p3_1 :: ScopedLabel LabelMem
p1_1 = makeScopedLabel 1 p1
p2_1 = makeScopedLabel 1 p2
p3_1 = makeScopedLabel 1 p3
o1_1, o2_1, o3_1 :: ScopedLabel LabelMem
o1_1 = makeScopedLabel 1 o1
o2_1 = makeScopedLabel 1 o2
o3_1 = makeScopedLabel 1 o3
l1_1, l4_1, l10_1 :: ScopedLabel LabelMem
l1_1 = makeScopedLabel 1 l1
l4_1 = makeScopedLabel 1 l4
l10_1 = makeScopedLabel 1 l10
b1_1, b2_1, b3_1, b4_1 :: ScopedLabel LabelMem
b1_1 = makeScopedLabel 1 b1
b2_1 = makeScopedLabel 1 b2
b3_1 = makeScopedLabel 1 b3
b4_1 = makeScopedLabel 1 b4
s1_2, s2_2, s3_2 :: ScopedLabel LabelMem
s1_2 = makeScopedLabel 2 s1
s2_2 = makeScopedLabel 2 s2
s3_2 = makeScopedLabel 2 s3
p1_2, p2_2, p3_2 :: ScopedLabel LabelMem
p1_2 = makeScopedLabel 2 p1
p2_2 = makeScopedLabel 2 p2
p3_2 = makeScopedLabel 2 p3
o1_2, o2_2, o3_2 :: ScopedLabel LabelMem
o1_2 = makeScopedLabel 2 o1
o2_2 = makeScopedLabel 2 o2
o3_2 = makeScopedLabel 2 o3
l1_2, l4_2, l10_2 :: ScopedLabel LabelMem
l1_2 = makeScopedLabel 2 l1
l4_2 = makeScopedLabel 2 l4
l10_2 = makeScopedLabel 2 l10
b1_2, b2_2, b3_2, b4_2 :: ScopedLabel LabelMem
b1_2 = makeScopedLabel 2 b1
b2_2 = makeScopedLabel 2 b2
b3_2 = makeScopedLabel 2 b3
b4_2 = makeScopedLabel 2 b4
t01_1 :: Arc (ScopedLabel LabelMem)
t01_1 = makeScopedArc 1 t01
t01_2, t02_2, t03_2, t04_2, t05_2, t06_2 :: Arc (ScopedLabel LabelMem)
t01_2 = makeScopedArc 2 t01
t02_2 = makeScopedArc 2 t02
t03_2 = makeScopedArc 2 t03
t04_2 = makeScopedArc 2 t04
t05_2 = makeScopedArc 2 t05
t06_2 = makeScopedArc 2 t06
t10_1, t11_1, t12_1, t20_1, t21_1, t22_1 :: Arc (ScopedLabel LabelMem)
t10_1 = makeScopedArc 1 t10
t11_1 = makeScopedArc 1 t11
t12_1 = makeScopedArc 1 t12
t20_1 = makeScopedArc 1 t20
t21_1 = makeScopedArc 1 t21
t22_1 = makeScopedArc 1 t22
t10_2, t11_2, t12_2, t20_2, t21_2, t22_2 :: Arc (ScopedLabel LabelMem)
t10_2 = makeScopedArc 2 t10
t11_2 = makeScopedArc 2 t11
t12_2 = makeScopedArc 2 t12
t20_2 = makeScopedArc 2 t20
t21_2 = makeScopedArc 2 t21
t22_2 = makeScopedArc 2 t22
-- Compare graph as6 with self, in steps
as61, as62 :: ArcSet (ScopedLabel LabelMem)
as61 = S.map (makeScopedArc 1) as6
as62 = S.map (makeScopedArc 2) as6
eq1lmap :: LabelMap (ScopedLabel LabelMem)
eq1lmap = newGenerationMap $
assignLabelMap (graphLabels as62) $
assignLabelMap (graphLabels as61) emptyMap
eq1ltst :: LabelMap (ScopedLabel LabelMem)
eq1ltst = tstLabelMap 2
[
(b4_2,(1,bhash)),
(b3_2,(1,bhash)),
(p3_2,(1,p3hash)),
(b2_2,(1,bhash)),
(p2_2,(1,p2hash)),
(b1_2,(1,bhash)),
(l10_2,(1,l10hash)),
(l4_2,(1,l4hash)),
(l1_2,(1,l1hash)),
(o3_2,(1,o3hash)),
(s3_2,(1,s3hash)),
(o2_2,(1,o2hash)),
(s2_2,(1,s2hash)),
(o1_2,(1,o1hash)),
(p1_2,(1,p1hash)),
(s1_2,(1,s1hash)),
(b4_1,(1,bhash)),
(b3_1,(1,bhash)),
(p3_1,(1,p3hash)),
(b2_1,(1,bhash)),
(p2_1,(1,p2hash)),
(b1_1,(1,bhash)),
(l10_1,(1,l10hash)),
(l4_1,(1,l4hash)),
(l1_1,(1,l1hash)),
(o3_1,(1,o3hash)),
(s3_1,(1,s3hash)),
(o2_1,(1,o2hash)),
(s2_1,(1,s2hash)),
(o1_1,(1,o1hash)),
(p1_1,(1,p1hash)),
(s1_1,(1,s1hash))
]
testEqAssignMap01 :: Test
testEqAssignMap01 = testEq "EqAssignMap01" eq1ltst eq1lmap
eq1hs1, eq1hs2 :: [Arc (ScopedLabel LabelMem)]
eq1hs1 = [t10_1,t11_1,t12_1,t20_1,t21_1,t22_1]
eq1hs2 = [t10_2,t11_2,t12_2,t20_2,t21_2,t22_2]
eq1lmap' :: LabelMap (ScopedLabel LabelMem)
eq1lmap' = tstLabelMap 2 [(s1_1,(1,142577)),(s2_1,(1,142578)),(s3_1,(1,142579)),
(s1_2,(1,142577)),(s2_2,(1,142578)),(s3_2,(1,142579)),
(p1_1,(1,142385)),(p2_1,(1,142386)),(p3_1,(1,142387)),
(p1_2,(1,142385)),(p2_2,(1,142386)),(p3_2,(1,142387)),
(o1_1,(1,142321)),(o2_1,(1,142322)),(o3_1,(1,142323)),
(o1_2,(1,142321)),(o2_2,(1,142322)),(o3_2,(1,142323)),
(l1_1,(1,142129)),(l4_1,(1,1709580)),(l10_1,(1,3766582)),
(l1_2,(1,142129)),(l4_2,(1,1709580)),(l10_2,(1,3766582)),
(b1_1,(2,3880463)),(b2_1,(2,3400925)),
(b3_1,(2,3880463)),
(b4_1,(2,3400925)),
(b1_2,(2,3880463)),(b2_2,(2,3400925)),
(b3_2,(2,3880463)),
(b4_2,(2,3400925))]
eq1lmap'' :: LabelMap (ScopedLabel LabelMem)
eq1lmap'' = newLabelMap eq1lmap'
[
(b1_1,2576315),(b2_1,3400925),(b3_1,1571691),
(b1_2,2576315),(b2_2,3400925),(b3_2,1571691)
]
eq1ltst'' :: LabelMap (ScopedLabel LabelMem)
eq1ltst'' = tstLabelMap 3 [
(s1_1,(1,142577)),(s2_1,(1,142578)),(s3_1,(1,142579)),
(p1_1,(1,142385)),(p2_1,(1,142386)),(p3_1,(1,142387)),
(o1_1,(1,142321)),(o2_1,(1,142322)),(o3_1,(1,142323)),
(l1_1,(1,142129)),(l4_1,(1,1709580)),(l10_1,(1,3766582)),
(b1_1,(3,2576315)),
(b2_1,(3,3400925)),
(b3_1,(3,1571691)),
(b4_1,(2,3400925)),
(s1_2,(1,142577)),(s2_2,(1,142578)),(s3_2,(1,142579)),
(p1_2,(1,142385)),(p2_2,(1,142386)),(p3_2,(1,142387)),
(o1_2,(1,142321)),(o2_2,(1,142322)),(o3_2,(1,142323)),
(l1_2,(1,142129)),(l4_2,(1,1709580)),(l10_2,(1,3766582)),
(b1_2,(3,2576315)),
(b2_2,(3,3400925)),
(b3_2,(3,1571691)),
(b4_2,(2,3400925))
]
testEqNewLabelMap07 :: Test
testEqNewLabelMap07 = testEq "EqNewLabelMap07" eq1ltst'' eq1lmap''
-- Repeat same tests for as4...
as41, as42 :: ArcSet (ScopedLabel LabelMem)
as41 = S.map (makeScopedArc 1) as4
as42 = S.map (makeScopedArc 2) as4
eq2lmap :: LabelMap (ScopedLabel LabelMem)
eq2lmap = newGenerationMap $
assignLabelMap (graphLabels as42) $
assignLabelMap (graphLabels as41) emptyMap
eq2ltst :: LabelMap (ScopedLabel LabelMem)
eq2ltst = tstLabelMap 2
[
(p3_2,(1,p3hash)),
(b2_2,(1,bhash)),
(b1_2,(1,bhash)),
(p2_2,(1,p2hash)),
(l10_2,(1,l10hash)),
(l4_2,(1,l4hash)),
(l1_2,(1,l1hash)),
(o3_2,(1,o3hash)),
(s3_2,(1,s3hash)),
(o2_2,(1,o2hash)),
(s2_2,(1,s2hash)),
(o1_2,(1,o1hash)),
(p1_2,(1,p1hash)),
(s1_2,(1,s1hash)),
(p3_1,(1,p3hash)),
(b2_1,(1,bhash)),
(p2_1,(1,p2hash)),
(b1_1,(1,bhash)),
(l10_1,(1,l10hash)),
(l4_1,(1,l4hash)),
(l1_1,(1,l1hash)),
(o3_1,(1,o3hash)),
(s3_1,(1,s3hash)),
(o2_1,(1,o2hash)),
(s2_1,(1,s2hash)),
(o1_1,(1,o1hash)),
(p1_1,(1,p1hash)),
(s1_1,(1,s1hash))
]
testEqAssignMap21 :: Test
testEqAssignMap21 = testEq "EqAssignMap21" eq2ltst eq2lmap
eq2hs1, eq2hs2 :: [Arc (ScopedLabel LabelMem)]
eq2hs1 = [t10_1,t11_1,t12_1]
eq2hs2 = [t10_2,t11_2,t12_2]
eq2lmap' :: LabelMap (ScopedLabel LabelMem)
eq2lmap' = tstLabelMap 2 [
(s1_1,(1,142577)),(s2_1,(1,142578)),(s3_1,(1,142579)),
(p1_1,(1,142385)),(p2_1,(1,142386)),(p3_1,(1,142387)),
(o1_1,(1,142321)),(o2_1,(1,142322)),(o3_1,(1,142323)),
(l1_1,(1,142129)),(l4_1,(1,1709580)),(l10_1,(1,3766582)),
(b1_1,(2,3880463)),(b2_1,(2,3400925)),
(s1_2,(1,142577)),(s2_2,(1,142578)),(s3_2,(1,142579)),
(p1_2,(1,142385)),(p2_2,(1,142386)),(p3_2,(1,142387)),
(o1_2,(1,142321)),(o2_2,(1,142322)),(o3_2,(1,142323)),
(l1_2,(1,142129)),(l4_2,(1,1709580)),(l10_2,(1,3766582)),
(b1_2,(2,3880463)),(b2_2,(2,3400925))
]
eq2lmap'' :: LabelMap (ScopedLabel LabelMem)
eq2lmap'' = newLabelMap eq2lmap'
[
(b2_1,3400925),
(b2_2,3400925)
]
eq2ltst'' :: LabelMap (ScopedLabel LabelMem)
eq2ltst'' = tstLabelMap 3 [
(s1_1,(1,142577)),(s2_1,(1,142578)),(s3_1,(1,142579)),
(p1_1,(1,142385)),(p2_1,(1,142386)),(p3_1,(1,142387)),
(o1_1,(1,142321)),(o2_1,(1,142322)),(o3_1,(1,142323)),
(l1_1,(1,142129)),(l4_1,(1,1709580)),(l10_1,(1,3766582)),
(b1_1,(2,3880463)),
(b2_1,(3,3400925)),
(s1_2,(1,142577)),(s2_2,(1,142578)),(s3_2,(1,142579)),
(p1_2,(1,142385)),(p2_2,(1,142386)),(p3_2,(1,142387)),
(o1_2,(1,142321)),(o2_2,(1,142322)),(o3_2,(1,142323)),
(l1_2,(1,142129)),(l4_2,(1,1709580)),(l10_2,(1,3766582)),
(b1_2,(2,3880463)),
(b2_2,(3,3400925))
]
testEqNewLabelMap27 :: Test
testEqNewLabelMap27 = testEq "EqNewLabelMap27" eq2ltst'' eq2lmap''
-- Compare as1 with as2, in steps
as11, as22 :: ArcSet (ScopedLabel LabelMem)
as11 = S.map (makeScopedArc 1) as1
as22 = S.map (makeScopedArc 2) as2
eq3hs1, eq3hs2 :: ArcSet (ScopedLabel LabelMem)
eq3hs1 = S.singleton t01_1
eq3hs2 = S.fromList [t01_2,t02_2,t03_2,t04_2,t05_2,t06_2]
testEqGraphMap31_1, testEqGraphMap31_2 :: Test
testEqGraphMap31_1 = testEq "testEqGraphMap31_1" eq3hs1 as11
testEqGraphMap31_2 = testEq "testEqGraphMap31_2" eq3hs2 as22
eq3lmap :: LabelMap (ScopedLabel LabelMem)
eq3lmap = newGenerationMap $
assignLabelMap (graphLabels as11) $
assignLabelMap (graphLabels as22) emptyMap
eq3ltst :: LabelMap (ScopedLabel LabelMem)
eq3ltst = tstLabelMap 2
[
(o1_1,(1,o1hash))
, (p1_1,(1,p1hash))
, (s1_1,(1,s1hash))
, (l10_2,(1,l10hash))
, (l4_2,(1,l4hash))
, (l1_2,(1,l1hash))
, (o3_2,(1,o3hash))
, (s3_2,(1,s3hash))
, (o2_2,(1,o2hash))
, (s2_2,(1,s2hash))
, (o1_2,(1,o1hash))
, (p1_2,(1,p1hash))
, (s1_2,(1,s1hash))
]
testEqAssignMap32 :: Test
testEqAssignMap32 = testEq "EqAssignMap32" eq3ltst eq3lmap
type EquivClass = EquivalenceClass (ScopedLabel LabelMem)
type EquivArgs = ((Word32, Word32), [ScopedLabel LabelMem])
ec31 :: [EquivClass]
ec31 = equivalenceClasses eq3lmap (graphLabels as11)
ec31test :: [EquivArgs]
ec31test =
sortBy (compare `on` (snd.fst))
[ ((1,o1hash),[o1_1])
, ((1,p1hash),[p1_1])
, ((1,s1hash),[s1_1])
]
ec32 :: [EquivClass]
ec32 = equivalenceClasses eq3lmap (graphLabels as22)
ec32test :: [EquivArgs]
ec32test =
sortBy (compare `on` (snd.fst))
[ ((1,l1hash),[l1_2])
, ((1,o2hash),[o2_2])
, ((1,o3hash),[o3_2])
, ((1,o1hash),[o1_2])
, ((1,p1hash),[p1_2])
, ((1,s2hash),[s2_2])
, ((1,s3hash),[s3_2])
, ((1,s1hash),[s1_2])
, ((1,l10hash),[l10_2])
, ((1,l4hash),[l4_2])
]
testEquivClass33_1, testEquivClass33_2 :: Test
testEquivClass33_1 = testEq "EquivClass33_1" ec31test ec31
testEquivClass33_2 = testEq "EquivClass33_2" ec32test ec32
{- as pairSOrt is no-longer exported need to check this code gets tested
-- This value is nonsense for this test,
-- but a parameter is needed for graphMatch1 (below)
ec3pairs :: [(EquivClass, EquivClass)]
ec3pairs = zip (pairSort ec31) (pairSort ec32)
-}
{- This is a pointless test in this case
ec3test :: [(EquivClass, EquivClass)]
ec3test =
[ ( ((1,142321),[o1_1]), ((1,142321),[o1_2]) )
, ( ((1,142385),[p1_1]), ((1,142385),[p1_2]) )
, ( ((1,142577),[s1_1]), ((1,142577),[s1_2]) )
]
testEquivClass33_3 = testEq "EquivClass33_3" ec3test ec3pairs
-}
{- pairSort is no longer exported
eq3lmap1 :: (Bool, LabelMap (ScopedLabel LabelMem))
eq3lmap1 = graphMatch1 False matchable eq3hs1 eq3hs2 eq3lmap ec3pairs
-}
eq3ltst1 :: LabelMap (ScopedLabel LabelMem)
eq3ltst1 = tstLabelMap 2
[ (o1_1,(1,142321))
, (p1_1,(1,142385))
, (s1_1,(1,142577))
, (l10_2,(1,3766582))
, (l4_2,(1,1709580))
, (l1_2,(1,142129))
, (o3_2,(1,142323))
, (s3_2,(1,142579))
, (o2_2,(1,142322))
, (s2_2,(1,142578))
, (o1_2,(1,142321))
, (p1_2,(1,142385))
, (s1_2,(1,142577))
]
-- testEqAssignMap34 = testEq "EqAssignMap34" (Just eq3ltst1) eq3lmap1
-- testEqAssignMap34 = testEq "EqAssignMap34" Nothing eq3lmap1
{- pairSort is not exported
testEqAssignMap34 :: Test
testEqAssignMap34 = testEq "EqAssignMap34" False (fst eq3lmap1)
-}
{-
eq3rc1 = reclassify eq3hs1 eq3lmap
eq3rctst1 = []
testEqReclassify35_1 = testEqv "EqReclassify35_1" (makeEntries eq3rctst1) eq3rc1
eq3rc2 = reclassify eq3hs2 eq3lmap
eq3rctst2 = []
testEqReclassify35_2 = testEqv "EqReclassify35_2" (makeEntries eq3rctst2) eq3rc2
-}
-- Test suite
testGraphMatchStepSuite :: Test
testGraphMatchStepSuite = TestList
[ testEqAssignMap01
-- , testEqReclassify03_1, testEqReclassify03_2
, testEqNewLabelMap07
-- , testEqGraphMatch08
, testEqAssignMap21
-- , testEqReclassify23_1, testEqReclassify23_2
, testEqNewLabelMap27
-- , testEqGraphMatch28
, testEqGraphMap31_1, testEqGraphMap31_2
, testEqAssignMap32
, testEquivClass33_1, testEquivClass33_2 -- , testEquivClass33_3
-- , testEqAssignMap34 pairSort is not exported
-- , testEqReclassify35_1, testEqReclassify35_2
]
------------------------------------------------------------
-- Graph equality tests
------------------------------------------------------------
testGraphEq :: ( Label lb ) => String -> Bool -> GraphMem lb -> GraphMem lb -> Test
testGraphEq lab eq gg1 gg2 =
TestCase ( assertEqual ("testGraphEq:"++lab) eq (gg1==gg2) )
toG :: [Statement] -> GraphMem LabelMem
toG stmts = GraphMem { arcs = S.fromList stmts }
g1, g2, g3, g4, g5, g6, g7, g8 :: GraphMem LabelMem
g1 = toG [t01]
g2 = toG [t01,t02,t03,t04,t05,t06]
g3 = toG [t06,t05,t04,t03,t02,t01]
g4 = toG [t01,t02,t03,t04,t05,t06,t10,t11,t12]
g5 = toG [t01,t02,t03,t04,t05,t06,t20,t21,t22]
g6 = toG [t01,t02,t03,t04,t05,t06,t10,t11,t12,t20,t21,t22]
g7 = toG [t01,t02]
g8 = toG [t02,t01]
glist :: [(String, GraphMem LabelMem)]
glist =
[ ("g1",g1), ("g2",g2), ("g3",g3), ("g4",g4), ("g5",g5), ("g6",g6) ]
grapheqlist :: [(String, String)]
grapheqlist =
[ ("g2","g3")
, ("g4","g5")
]
testGraphEqSuitePart :: Test
testGraphEqSuitePart = TestLabel "testGraphEqSuitePart" $ TestList
[ testGraphEq "g1-g2" False g1 g2
, testGraphEq "g2-g1" False g2 g1
, testGraphEq "g2-g2" True g2 g2
, testGraphEq "g2-g3" True g2 g3
, testGraphEq "g1-g4" False g1 g4
, testGraphEq "g2-g4" False g2 g4
, testGraphEq "g3-g4" False g3 g4
, testGraphEq "g4-g3" False g4 g3
, testGraphEq "g4-g4" True g4 g4
, testGraphEq "g4-g5" True g4 g5
, testGraphEq "g4-g6" False g4 g6
, testGraphEq "g6-g6" True g6 g6
, testGraphEq "g7-g7" True g7 g7
, testGraphEq "g7-g8" True g7 g8
, testGraphEq "g8-g7" True g8 g7
]
testGraphEqSuite :: Test
testGraphEqSuite = TestLabel "testGraphEqSuite" $ TestList
[ testGraphEq (testLab ll1 ll2) (nodeTest ll1 ll2) gg1 gg2
| (ll1,gg1) <- glist , (ll2,gg2) <- glist ]
where
testLab ll1 ll2 = ll1 ++ "-" ++ ll2
nodeTest ll1 ll2 = (ll1 == ll2) ||
(ll1,ll2) `elem` grapheqlist ||
(ll2,ll1) `elem` grapheqlist
-- Selected tests for debugging
geq12, geq21, geq22, geq23, geq14, geq24, geq77, geq78, geq87 :: Test
geq12 = testGraphEq "g1-g2" False g1 g2
geq21 = testGraphEq "g2-g1" False g2 g1
geq22 = testGraphEq "g2-g2" True g2 g2
geq23 = testGraphEq "g2-g3" True g2 g3
geq14 = testGraphEq "g1-g4" False g1 g4
geq24 = testGraphEq "g2-g4" False g2 g4
geq77 = testGraphEq "g7-g7" True g7 g7
geq78 = testGraphEq "g7-g8" True g7 g8
geq87 = testGraphEq "g8-g7" True g8 g7
------------------------------------------------------------
-- More graph equality tests
------------------------------------------------------------
--
-- These tests are based on the 10-node, triply connected
-- graph examples in Jeremy Carroll's paper on matching RDF
-- graphs.
-- Graph pattern 1:
-- pentangle-in-pentangle, corresponding vertices linked upward
v101, v102, v103, v104, v105, v106, v107, v108,
v109, v110 :: LabelMem
v101 = LV "v101"
v102 = LV "v102"
v103 = LV "v103"
v104 = LV "v104"
v105 = LV "v105"
v106 = LV "v106"
v107 = LV "v107"
v108 = LV "v108"
v109 = LV "v109"
v110 = LV "v110"
p101, p102, p103, p104, p105, p106, p107, p108,
p109, p110, p111, p112, p113, p114, p115 :: LabelMem
p101 = LV "p101"
p102 = LV "p102"
p103 = LV "p103"
p104 = LV "p104"
p105 = LV "p105"
p106 = LV "p106"
p107 = LV "p107"
p108 = LV "p108"
p109 = LV "p109"
p110 = LV "p110"
p111 = LV "p111"
p112 = LV "p112"
p113 = LV "p113"
p114 = LV "p114"
p115 = LV "p115"
t10102, t10203, t10304, t10405, t10501, t10106,
t10207, t10308, t10409, t10510, t10607,
t10708, t10809, t10910, t11006 :: Statement
t10102 = arc v101 p101 v102
t10203 = arc v102 p102 v103
t10304 = arc v103 p103 v104
t10405 = arc v104 p104 v105
t10501 = arc v105 p105 v101
t10106 = arc v101 p106 v106
t10207 = arc v102 p107 v107
t10308 = arc v103 p108 v108
t10409 = arc v104 p109 v109
t10510 = arc v105 p110 v110
t10607 = arc v106 p111 v107
t10708 = arc v107 p112 v108
t10809 = arc v108 p113 v109
t10910 = arc v109 p114 v110
t11006 = arc v110 p115 v106
-- Graph pattern 2:
-- pentangle-in-pentangle, corresponding vertices linked downward
v201, v202, v203, v204, v205, v206, v207, v208,
v209, v210 :: LabelMem
v201 = LV "v201"
v202 = LV "v202"
v203 = LV "v203"
v204 = LV "v204"
v205 = LV "v205"
v206 = LV "v206"
v207 = LV "v207"
v208 = LV "v208"
v209 = LV "v209"
v210 = LV "v210"
p201, p202, p203, p204, p205, p206, p207, p208,
p209, p210, p211, p212, p213, p214, p215 :: LabelMem
p201 = LV "p201"
p202 = LV "p202"
p203 = LV "p203"
p204 = LV "p204"
p205 = LV "p205"
p206 = LV "p206"
p207 = LV "p207"
p208 = LV "p208"
p209 = LV "p209"
p210 = LV "p210"
p211 = LV "p211"
p212 = LV "p212"
p213 = LV "p213"
p214 = LV "p214"
p215 = LV "p215"
t20102, t20203, t20304, t20405, t20501, t20601,
t20702, t20803, t20904, t21005, t20607,
t20708, t20809, t20910, t21006 :: Statement
t20102 = arc v201 p201 v202
t20203 = arc v202 p202 v203
t20304 = arc v203 p203 v204
t20405 = arc v204 p204 v205
t20501 = arc v205 p205 v201
t20601 = arc v206 p206 v201
t20702 = arc v207 p207 v202
t20803 = arc v208 p208 v203
t20904 = arc v209 p209 v204
t21005 = arc v210 p210 v205
t20607 = arc v206 p211 v207
t20708 = arc v207 p212 v208
t20809 = arc v208 p213 v209
t20910 = arc v209 p214 v210
t21006 = arc v210 p215 v206
-- Graph pattern 3:
-- star-in-pentangle, corresponding vertices linked toward star
-- Although this graph is similarly linked to patterns 1 and 2,
-- it is topologically different as it contains circuits only of
-- length 5, where the others have circuits of length 4 and 5
-- (ignoring direction of arcs)
v301, v302, v303, v304, v305, v306, v307, v308,
v309, v310 :: LabelMem
v301 = LV "v301"
v302 = LV "v302"
v303 = LV "v303"
v304 = LV "v304"
v305 = LV "v305"
v306 = LV "v306"
v307 = LV "v307"
v308 = LV "v308"
v309 = LV "v309"
v310 = LV "v310"
p301, p302, p303, p304, p305, p306, p307, p308,
p309, p310, p311, p312, p313, p314, p315 :: LabelMem
p301 = LV "p301"
p302 = LV "p302"
p303 = LV "p303"
p304 = LV "p304"
p305 = LV "p305"
p306 = LV "p306"
p307 = LV "p307"
p308 = LV "p308"
p309 = LV "p309"
p310 = LV "p310"
p311 = LV "p311"
p312 = LV "p312"
p313 = LV "p313"
p314 = LV "p314"
p315 = LV "p315"
t30102, t30203, t30304, t30405, t30501, t30106,
t30207, t30308, t30409, t30510, t30608,
t30709, t30810, t30906, t31007 :: Statement
t30102 = arc v301 p301 v302
t30203 = arc v302 p302 v303
t30304 = arc v303 p303 v304
t30405 = arc v304 p304 v305
t30501 = arc v305 p305 v301
t30106 = arc v301 p306 v306
t30207 = arc v302 p307 v307
t30308 = arc v303 p308 v308
t30409 = arc v304 p309 v309
t30510 = arc v305 p310 v310
t30608 = arc v306 p311 v308
t30709 = arc v307 p312 v309
t30810 = arc v308 p313 v310
t30906 = arc v309 p314 v306
t31007 = arc v310 p315 v307
-- Graph pattern 4:
-- pentangle-in-pentangle, corresponding vertices linked upward
-- The vertices 6-10 are linked in reverse order to the
-- corresponding vertices 1-5.
v401, v402, v403, v404, v405, v406, v407, v408,
v409, v410 :: LabelMem
v401 = LV "v401"
v402 = LV "v402"
v403 = LV "v403"
v404 = LV "v404"
v405 = LV "v405"
v406 = LV "v406"
v407 = LV "v407"
v408 = LV "v408"
v409 = LV "v409"
v410 = LV "v410"
p401, p402, p403, p404, p405, p406, p407, p408,
p409, p410, p411, p412, p413, p414, p415 :: LabelMem
p401 = LV "p401"
p402 = LV "p402"
p403 = LV "p403"
p404 = LV "p404"
p405 = LV "p405"
p406 = LV "p406"
p407 = LV "p407"
p408 = LV "p408"
p409 = LV "p409"
p410 = LV "p410"
p411 = LV "p411"
p412 = LV "p412"
p413 = LV "p413"
p414 = LV "p414"
p415 = LV "p415"
t40102, t40203, t40304, t40405, t40501, t40106,
t40207, t40308, t40409, t40510, t41009,
t40908, t40807, t40706, t40610:: Statement
t40102 = arc v401 p401 v402
t40203 = arc v402 p402 v403
t40304 = arc v403 p403 v404
t40405 = arc v404 p404 v405
t40501 = arc v405 p405 v401
t40106 = arc v401 p406 v406
t40207 = arc v402 p407 v407
t40308 = arc v403 p408 v408
t40409 = arc v404 p409 v409
t40510 = arc v405 p410 v410
t41009 = arc v410 p411 v409
t40908 = arc v409 p412 v408
t40807 = arc v408 p413 v407
t40706 = arc v407 p414 v406
t40610 = arc v406 p415 v410
-- Graph pattern 5:
-- Same as pattern 1, except same fixed property in all cases.
p5 :: LabelMem
p5 = LF "p5"
t50102, t50203, t50304, t50405, t50501, t50106, t50207,
t50308, t50409, t50510, t50607, t50708, t50809,
t50910, t51006 :: Statement
t50102 = arc v101 p5 v102
t50203 = arc v102 p5 v103
t50304 = arc v103 p5 v104
t50405 = arc v104 p5 v105
t50501 = arc v105 p5 v101
t50106 = arc v101 p5 v106
t50207 = arc v102 p5 v107
t50308 = arc v103 p5 v108
t50409 = arc v104 p5 v109
t50510 = arc v105 p5 v110
t50607 = arc v106 p5 v107
t50708 = arc v107 p5 v108
t50809 = arc v108 p5 v109
t50910 = arc v109 p5 v110
t51006 = arc v110 p5 v106
-- Graph pattern 6:
-- Same as pattern 5, with different variables
t60102, t60203, t60304, t60405, t60501, t60106,
t60207, t60308, t60409, t60510, t60607, t60708,
t60809, t60910, t61006 :: Statement
t60102 = arc v201 p5 v202
t60203 = arc v202 p5 v203
t60304 = arc v203 p5 v204
t60405 = arc v204 p5 v205
t60501 = arc v205 p5 v201
t60106 = arc v201 p5 v206
t60207 = arc v202 p5 v207
t60308 = arc v203 p5 v208
t60409 = arc v204 p5 v209
t60510 = arc v205 p5 v210
t60607 = arc v206 p5 v207
t60708 = arc v207 p5 v208
t60809 = arc v208 p5 v209
t60910 = arc v209 p5 v210
t61006 = arc v210 p5 v206
--
arcsToGraph :: (Ord a) => [Arc a] -> GraphMem a
arcsToGraph as = GraphMem { arcs = S.fromList as }
-- Very simple case
g100 :: GraphMem LabelMem
g100 = arcsToGraph
[ t10102, t10203, t10304, t10405, t10501,
t10607, t10708, t10809, t10910, t11006
]
g200 :: GraphMem LabelMem
g200 = arcsToGraph
[ t20102, t20203, t20304, t20405, t20501,
t20607, t20708, t20809, t20910, t21006
]
-- 10/3 node graph comparisons
g101 :: GraphMem LabelMem
g101 = arcsToGraph
[ t10102, t10203, t10304, t10405, t10501,
t10106, t10207, t10308, t10409, t10510,
t10607, t10708, t10809, t10910, t11006 ]
g201 :: GraphMem LabelMem
g201 = arcsToGraph
[ t20102, t20203, t20304, t20405, t20501,
t20601, t20702, t20803, t20904, t21005,
t20607, t20708, t20809, t20910, t21006 ]
g301 :: GraphMem LabelMem
g301 = arcsToGraph
[ t30102, t30203, t30304, t30405, t30501,
t30106, t30207, t30308, t30409, t30510,
t30608, t30709, t30810, t30906, t31007 ]
g401 :: GraphMem LabelMem
g401 = arcsToGraph
[ t40102, t40203, t40304, t40405, t40501,
t40106, t40207, t40308, t40409, t40510,
t40610, t40706, t40807, t40908, t41009 ]
g501 :: GraphMem LabelMem
g501 = arcsToGraph
[ t50102, t50203, t50304, t50405, t50501,
t50106, t50207, t50308, t50409, t50510,
t50607, t50708, t50809, t50910, t51006 ]
g601 :: GraphMem LabelMem
g601 = arcsToGraph
[ t60102, t60203, t60304, t60405, t60501,
t60106, t60207, t60308, t60409, t60510,
t60607, t60708, t60809, t60910, t61006 ]
-- Remove one arc from each
g102 :: GraphMem LabelMem
g102 = arcsToGraph
[ t10102, t10203, t10304, t10405,
t10106, t10207, t10308, t10409, t10510,
t10607, t10708, t10809, t10910, t11006 ]
g202 :: GraphMem LabelMem
g202 = arcsToGraph
[ t20102, t20203, t20304, t20405, t20501,
t20601, t20702, t20803, t20904, t21005,
t20708, t20809, t20910, t21006 ]
g302 :: GraphMem LabelMem
g302 = arcsToGraph
[ t20102, t20203, t20304, t20405, t20501,
t20601, t20702, t20803, t20904,
t20607, t20708, t20809, t20910, t21006 ]
-- Remove two adjacent arcs from each
g103 :: GraphMem LabelMem
g103 = arcsToGraph
[ t10102, t10203, t10304,
t10106, t10207, t10308, t10409, t10510,
t10607, t10708, t10809, t10910, t11006 ]
g203 :: GraphMem LabelMem
g203 = arcsToGraph
[ t20102, t20203, t20304, t20405, t20501,
t20601, t20702, t20803, t20904, t21005,
t20607, t20708, t21006 ]
g303 :: GraphMem LabelMem
g303 = arcsToGraph
[ t20102, t20203, t20304, t20405, t20501,
t20601, t20702, t20803, t20904,
t20607, t20708, t20809, t21006 ]
-- Remove two adjacent arcs from one, non-adjacent from another
g104 :: GraphMem LabelMem
g104 = arcsToGraph
[ t10102, t10203, t10304,
t10106, t10207, t10308, t10409, t10510,
t10607, t10708, t10809, t10910, t11006 ]
g204 :: GraphMem LabelMem
g204 = arcsToGraph
[ t20102, t20203, t20304, t20405, t20501,
t20601, t20702, t20803,
t20607, t20708, t20809, t20910, t21006 ]
-- Compare two rings of 5 with one ring of 10
-- (each node double-connected, but different overall topology)
t10901 :: Statement
t10901 = arc v109 p109 v101
g105 :: GraphMem LabelMem
g105 = arcsToGraph
[ t10102, t10203, t10304, t10405,
t10901, t10510,
t10607, t10708, t10809, t11006 ]
g205 :: GraphMem LabelMem
g205 = arcsToGraph
[ t20102, t20203, t20304, t20405, t20501,
t20607, t20708, t20809, t20910, t21006 ]
-- Reverse one arc from test 01
-- (also, rearrange arcs to catch ordering artefacts)
t20201 :: Statement
t20201 = arc v202 p201 v201
g106 :: GraphMem LabelMem
g106 = arcsToGraph
[ t10102, t10203, t10304, t10405, t10501,
t10106, t10207, t10308, t10409, t10510,
t10607, t10708, t10809, t10910, t11006 ]
g206 :: GraphMem LabelMem
g206 = arcsToGraph
[ t20607, t20708, t20809, t20910, t21006,
t20601, t20702, t20803, t20904, t21005,
t20102, t20203, t20304, t20405, t20501 ]
g306 :: GraphMem LabelMem
g306 = arcsToGraph
[ t20607, t20708, t20809, t20910, t21006,
t20601, t20702, t20803, t20904, t21005,
t20201, t20203, t20304, t20405, t20501 ]
-- Similar tests to 02,03,04,
-- but add identified property rather than removing arcs
f01, f02 :: LabelMem
f01 = LF "f01"
f02 = LF "f02"
-- Fix one arc from each
f10102, f10501, f21006, f20510 :: Statement
f10102 = arc v101 f01 v102
f10501 = arc v105 f01 v101
f21006 = arc v210 f01 v206
f20510 = arc v205 f01 v210
g107 :: GraphMem LabelMem
g107 = arcsToGraph
[ f10102, t10203, t10304, t10405, t10501,
t10106, t10207, t10308, t10409, t10510,
t10607, t10708, t10809, t10910, t11006 ]
g207 :: GraphMem LabelMem
g207 = arcsToGraph
[ t10102, t10203, t10304, t10405, f10501,
t10106, t10207, t10308, t10409, t10510,
t10607, t10708, t10809, t10910, t11006 ]
g307 :: GraphMem LabelMem
g307 = arcsToGraph
[ t20607, t20708, t20809, t20910, f21006,
t20601, t20702, t20803, t20904, t21005,
t20102, t20203, t20304, t20405, t20501 ]
g407 :: GraphMem LabelMem
g407 = arcsToGraph
[ t20607, t20708, t20809, t20910, t21006,
t20601, t20702, t20803, t20904, t21005,
t20102, t20203, t20304, t20405, t20501 ]
-- Fix two adjacent arcs from each
f10203, f10405, f20910, f20601 :: Statement
f10203 = arc v102 f01 v103
f10405 = arc v104 f01 v105
f20910 = arc v209 f01 v210
f20601 = arc v206 f01 v201
g108 :: GraphMem LabelMem
g108 = arcsToGraph
[ f10102, f10203, t10304, t10405, t10501,
t10106, t10207, t10308, t10409, t10510,
t10607, t10708, t10809, t10910, t11006 ]
g208 :: GraphMem LabelMem
g208 = arcsToGraph
[ t10102, t10203, t10304, f10405, f10501,
t10106, t10207, t10308, t10409, t10510,
t10607, t10708, t10809, t10910, t11006 ]
g308 :: GraphMem LabelMem
g308 = arcsToGraph
[ t20607, t20708, t20809, f20910, f21006,
t20601, t20702, t20803, t20904, t21005,
t20102, t20203, t20304, t20405, t20501 ]
g408 :: GraphMem LabelMem
g408 = arcsToGraph
[ t20607, t20708, t20809, t20910, f21006,
f20601, t20702, t20803, t20904, t21005,
t20102, t20203, t20304, t20405, t20501 ]
-- Fix two adjacent arcs with different properties
g10203, g10102, g10405 :: Statement
g10203 = arc v102 f02 v103
g10102 = arc v101 f02 v102
g10405 = arc v104 f02 v105
g109, g209, g309 :: GraphMem LabelMem
g109 = arcsToGraph
[ f10102, g10203, t10304, t10405, t10501,
t10106, t10207, t10308, t10409, t10510,
t10607, t10708, t10809, t10910, t11006 ]
g209 = arcsToGraph
[ g10102, t10203, t10304, t10405, f10501,
t10106, t10207, t10308, t10409, t10510,
t10607, t10708, t10809, t10910, t11006 ]
g309 = arcsToGraph
[ t10102, t10203, t10304, g10405, f10501,
t10106, t10207, t10308, t10409, t10510,
t10607, t10708, t10809, t10910, t11006 ]
mgeq00 :: Test
mgeq00 = testGraphEq "g100-g200" True g100 g200
mgeq0112, mgeq0113, mgeq0114, mgeq0115, mgeq0116, mgeq0156 :: Test
mgeq0112 = testGraphEq "g101-g201" True g101 g201
mgeq0113 = testGraphEq "g101-g301" False g101 g301
mgeq0114 = testGraphEq "g101-g401" False g101 g401
mgeq0115 = testGraphEq "g101-g501" False g101 g501
mgeq0116 = testGraphEq "g101-g601" False g101 g601
mgeq0156 = testGraphEq "g501-g601" True g501 g601
mgeq0212, mgeq0213 :: Test
mgeq0212 = testGraphEq "g102-g202" True g102 g202
mgeq0213 = testGraphEq "g102-g302" False g102 g302
mgeq0312, mgeq0313 :: Test
mgeq0312 = testGraphEq "g103-g203" True g103 g203
mgeq0313 = testGraphEq "g103-g303" False g103 g303
mgeq04, mgeq05 :: Test
mgeq04 = testGraphEq "g104-g204" False g104 g204
mgeq05 = testGraphEq "g105-g205" False g105 g205
mgeq0612, mgeq0613 :: Test
mgeq0612 = testGraphEq "g106-g206" True g106 g206
mgeq0613 = testGraphEq "g106-g306" False g106 g306
mgeq0712, mgeq0713, mgeq0714 :: Test
mgeq0712 = testGraphEq "g107-g207" True g107 g207
mgeq0713 = testGraphEq "g107-g307" True g107 g307
mgeq0714 = testGraphEq "g107-g407" False g107 g407
mgeq0812, mgeq0813, mgeq0814 :: Test
mgeq0812 = testGraphEq "g108-g208" True g108 g208
mgeq0813 = testGraphEq "g108-g308" True g108 g308
mgeq0814 = testGraphEq "g108-g408" False g108 g408
mgeq0912, mgeq0913 :: Test
mgeq0912 = testGraphEq "g109-g209" True g109 g209
mgeq0913 = testGraphEq "g109-g309" False g109 g309
testGraphEqSuiteMore :: Test
testGraphEqSuiteMore = TestList
[ mgeq00
, mgeq0112, mgeq0113, mgeq0114, mgeq0115, mgeq0116, mgeq0156
, mgeq0212, mgeq0213
, mgeq0312, mgeq0313
, mgeq04
, mgeq05
, mgeq0612, mgeq0613
, mgeq0712, mgeq0713, mgeq0714
, mgeq0812, mgeq0813, mgeq0814
, mgeq0912, mgeq0913
]
------------------------------------------------------------
-- All tests
------------------------------------------------------------
allTests :: Test
allTests = TestList
[ -- testSelectSuite
-- testSubsetSuite
testLabSuite
, testGraphSuite
, testLabelEqSuite
, testLabelOrdSuite
, TestCase (assertBool "arc neq" (Arc True True True /= Arc True True False)) -- silly test of Eq instance
, testStmtEqSuite
, testLabelMapSuite
, testGraphMatchSupportSuite
, testGraphMatchStepSuite
, testGraphEqSuitePart
, testGraphEqSuite
, testGraphEqSuiteMore
-- test of Foldable instance of Arc
, TestCase (assertEqual "fold Arc" [1::Int,2,4] (F.fold (Arc [1::Int] [2] [4])))
]
main :: IO ()
main = runTestSuite allTests
{-
runTestFile t = do
h <- openFile "a.tmp" WriteMode
runTestText (putTextToHandle h False) t
hClose h
tf = runTestFile
tt = runTestTT
geq = testGraphEqSuite
geq1 = testGraphEqSuiteMore
ttmore = tt testGraphEqSuiteMore -- this test may take a long time
tfmore = tf testGraphEqSuiteMore
ttstep = tt testGraphMatchStepSuite
tfstep = tf testGraphMatchStepSuite
-}
--------------------------------------------------------------------------------
--
-- Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin,
-- 2011, 2012 Douglas Burke
-- All rights reserved.
--
-- This file is part of Swish.
--
-- Swish is free software; you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation; either version 2 of the License, or
-- (at your option) any later version.
--
-- Swish is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-- GNU General Public License for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with Swish; if not, write to:
-- The Free Software Foundation, Inc.,
-- 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
--
--------------------------------------------------------------------------------