sifflet-2.3.0: tests/Testing/Unit/GraphTests.hs
module Testing.Unit.GraphTests (tests)
where
import System.Cmd
import Test.HUnit
import Data.Graph.Inductive as G
import Data.Sifflet.Functoid
import Data.Sifflet.Geometry
import Data.Sifflet.Tree as T
import Data.Sifflet.TreeGraph
import Data.Sifflet.TreeLayout
import Data.Sifflet.WGraph
import Language.Sifflet.Expr
import Language.Sifflet.ExprTree
import Graphics.Rendering.Sifflet.DrawTreeGraph
import Text.Sifflet.Repr ()
import Testing.Unit.TreeTests hiding (tests)
import Testing.TestUtil
-- (Sym s) is a symbol, similar to (Name s), but its show method
-- is just the string s instead of (Sym s).
-- This is just here for testing with graphviz.
newtype Sym = Sym String
deriving (Eq)
instance Show Sym where
show (Sym s) = s
instance Repr Sym where
repr (Sym s) = s
{- SOME TEST TREES
> putTreeS t5
root
|
+- left
|
`- right
-}
t5 :: Tree Sym
t5 = fmap Sym (T.Node "root" [leaf "left", leaf "right"])
{-
> putTreeS t6
1
|
`- 2
|
`- 3
|
+- 4
| |
| +- 7
| |
| `- 8
|
+- 5
|
`- 6
|
+- 9
|
`- 10
-}
t6 :: Tree Int
t6 = T.Node 1 [T.Node 2 [T.Node 3 [T.Node 4 [leaf 7, leaf 8],
leaf 5,
T.Node 6 [leaf 9, leaf 10]]]]
{-
> putTreeS t7
'A'
|
+- 'B'
| |
| +- 'E'
| |
| `- 'F'
|
+- 'C'
|
`- 'D'
|
`- 'G'
-}
t7 :: Tree Char
t7 = T.Node 'A' [T.Node 'B' [leaf 'E', leaf 'F'],
leaf 'C',
T.Node 'D' [leaf 'G']]
-- UNIT TESTS
utestsNextNodes :: Test
utestsNextNodes =
assertAll [assertEqual "nextNodes 3-5" ([3, 4], 5)
(nextNodes "ab" 3),
assertEqual "nextNodes 5-8" ([5, 6, 7], 8)
(nextNodes "cde" 5),
assertEqual "nextNodes 8-8" ([], 8) (nextNodes [] 8)]
utestsTreeGraph :: Test
utestsTreeGraph =
let tn1 = (T.Node 1 [leaf 2, leaf 3])
tn3 = (T.Node 1 [T.Node 2 [leaf 5, leaf 6],
leaf 3,
T.Node 4 [leaf 7]])
tgStruct :: Tree e -> Tree G.Node
-- is this needed at all?
tgStruct t = graphToTreeStructure (orderedTreeToGraph t) 1
in assertAll
[assertEqual "tree graph nodes t5" tn1
(treeGraphNodesTree t5),
assertEqual "tree graph nodes t7" tn3
(treeGraphNodesTree t7),
assertEqual "tree graph struct t5" tn1
(tgStruct t5),
assertEqual "tree graph struct t7" tn3
(tgStruct t7)]
utestsTreeGraphReconstruct :: Test
utestsTreeGraphReconstruct =
let reconstruct :: Tree e -> Tree e
reconstruct = graphToOrderedTree . orderedTreeToGraph
in assertAll [assertEqual "tree graph inverse" t5 (reconstruct t5),
assertEqual "tree graph inverse" t6 (reconstruct t6),
assertEqual "tree graph inverse" t7 (reconstruct t7)]
utestsOrderedTreeGraph :: Test
utestsOrderedTreeGraph =
let t = T.Node "ham"
[T.Node "pineapple" [],
T.Node "juice"
[T.Node "can" [],
T.Node "cup" [],
T.Node "balls" []]]
g = mkGraph [(1, "ham"),
(2, "pineapple"),
(3, "juice"),
(4, "can"),
(5, "cup"),
(6, "balls")]
[(1, 2, WEdge 0), -- from node 1 to node 2 as 0th child
(1, 3, WEdge 1),
(3, 4, WEdge 0),
(3, 5, WEdge 1),
(3, 6, WEdge 2)]
in assertAll [-- assertEqual "ordered tree to graph" g
-- (orderedTreeToGraph t),
assert $ equal g (orderedTreeToGraph t),
assertEqual "graph to ordered tree" t (graphToOrderedTree g)]
utestsInsertRemove :: Test
utestsInsertRemove =
let g1 :: Gr String Int
g1 = mkGraph [(1, "ding"), (2, "aling"), (3, "along")]
[(1, 3, 0), (2, 3, 0), (3, 1, 0)]
g0 = mkGraph [(2, "aling"), (3, "along")]
[(2, 3, 0)]
g2 = mkGraph [(1, "ding"), (2, "aling"), (3, "along"), (4, "song")]
[(1, 3, 0), (2, 3, 0), (3, 1, 0)]
in assertAll
[assert $ equal g2 (fst (grInsertNode g1 "song")),
assert $ equal g0 (grRemoveNode g1 1)
]
testGrAddGraph :: Test
testGrAddGraph =
TestCase $
let g1 :: Gr () ()
g1 = mkUGraph [1 .. 3] [(1, 2), (1, 3), (2, 3)]
g2 :: Gr () ()
g2 = mkUGraph [1 .. 3] [(1, 2), (2, 3), (3, 1)]
g3 :: Gr () ()
g3 = mkUGraph [1..6] [(1, 2), (1, 3), (2, 3), (4, 5), (5, 6), (6, 4)]
in assert $ equal g3 (grAddGraph g1 g2)
testLayoutRoots :: Test
testLayoutRoots =
let m = eSymbol "m"
n = eSymbol "n"
t = exprToTree (eIf (eZerop n)
(eInt 0)
(ePlus m (eMinus m (eSub1 n))))
lt = treeLayout style0 zeroIoletCounter t
lf = map (treeLayout style0 zeroIoletCounter) (subForest t)
f1 = FLayoutTree lt
f2 = FLayoutForest lf (BBox 0 0 0 0)
in assertAll
[assertEqual "tlo to graph roots, function tree"
[1]
(flayoutToGraphRoots f1)
,
assertEqual "tlo to graph roots, function parts forest"
[1, 3, 4]
(flayoutToGraphRoots f2)
]
testGraphOrphans :: Test
testGraphOrphans =
let g0 :: Gr String ()
g0 = mkGraph [(0, "A"), (1, "B"), (2, "C"), (3, "D"), (4, "E")]
[(0, 1, ()), (0, 2, ()), (0, 3, ()),
(3, 2, ()),
(4, 1, ()), (4, 2, ())]
g1 :: Gr String ()
g1 = mkGraph [(0, "WFrame"), (1, "f"), (2, "g"), (3, "x"), (4, "y"),
(5, "add1"), (6, "y"), (7, "x")]
[(1, 2, ()), (1, 3, ()), (1, 4, ()),
(2, 5, ()), (2, 6, ()),
(5, 7, ())]
in assertAll
[assertEqual "graphOrphans g0" [0, 4] (graphOrphans g0),
assertEqual "graphOrphans g1" [0, 1] (graphOrphans g1)]
tests :: Test
tests = TestList [utestsInsertRemove,
testGrAddGraph,
utestsNextNodes,
utestsTreeGraph,
utestsTreeGraphReconstruct,
utestsOrderedTreeGraph,
testLayoutRoots,
testGraphOrphans
]
runU :: IO Counts
runU = runTestTT tests
testm :: (Show e, Repr e) => [Style] -> Tree e -> IO ()
testm styles t =
mapM_ (\s -> gtkShowTree s zeroIoletCounter t) styles
-- test render a graph, simple form
testRenderGraph1 :: (Repr e) => Tree e -> IO ()
testRenderGraph1 t =
let style = defaultStyle
tlo = treeLayout style zeroIoletCounter t
Size surfWidth surfHeight = treeLayoutPaddedSize style tlo
g = orderedTreeToGraph tlo
file = "tmp.png"
in graphWriteImageFile style (Just 1) (Just 2)
surfWidth surfHeight g file >>
system ("feh " ++ file) >>
return ()
testRenderGraph2a :: IO ()
testRenderGraph2a = testRenderGraph2Aux t3 (grTranslateNode 2 (-100) (-50))
testRenderGraph2b :: IO ()
testRenderGraph2b = testRenderGraph2Aux t3 (grTranslateNode 2 100 50)
testRenderGraph2c :: IO ()
testRenderGraph2c = testRenderGraph2Aux t3 (grTranslateNode 3 (-100) 20)
testRenderGraph3a :: IO ()
testRenderGraph3a = testRenderGraph2Aux t3 (grTranslateSubtree 2 100 50)
testRenderGraph3b :: IO ()
testRenderGraph3b = testRenderGraph2Aux t3 (grTranslateSubtree 4 (-50) (-50))
-- test render a graph, with a transformation
-- the second argument updates the graph, for example by
-- translating a node or a subtree
testRenderGraph2Aux ::
(Repr n) => Tree n -> (LayoutGraph n WEdge -> LayoutGraph n WEdge) -> IO ()
testRenderGraph2Aux t transform =
let style = defaultStyle
tlo = treeLayout style zeroIoletCounter t
Size surfWidth surfHeight = treeLayoutPaddedSize style tlo
g = transform (orderedTreeToGraph tlo)
file = "tmp.png"
in graphWriteImageFile style (Just 1) Nothing
surfWidth surfHeight g file >>
system ("feh " ++ file) >>
return ()