-
Notifications
You must be signed in to change notification settings - Fork 0
/
Tests.hs
68 lines (59 loc) · 3.42 KB
/
Tests.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
-- Test suite
import Math.Topology.CubeCmplx.DirCubeCmplx
import Math.Topology.CubeCmplx.CornerReduce
import Math.Topology.CubeCmplx.DPTrace
import Math.Topology.CubeCmplx.Vtk
import qualified Data.HashSet as S (size)
import Data.Maybe (fromJust)
import Test.QuickCheck
import Test.QuickCheck.Gen (unGen, Gen)
import System.Random (mkStdGen)
-- Functions for testing --
rList :: Gen a -> Int -> [a]
rList g n = (unGen (listOf g)) (mkStdGen n) n
-- Property tests --
prop_spanTopCells vs = not $ null (spanTopCells vs)
prop_vertSpan vs = vsFst vs `vLT` vsSnd vs
prop_vsBdry vs = all (==True) . map (prop_vertSpan) $ vsBdry vs
prop_cmplxHullUnsafe cx = if cmplxNull cx then True
else prop_vertSpan $ cmplxHullUnsafe cx
-- Fuzz tests --
fuzz_cellNhd n = map (uncurry cellNhd) $
zip (rList (arbitrary :: Gen CubeCmplx) n)
(rList (arbitrary :: Gen CubeCell) n)
fuzz_cmplxCornersNaive n = map cmplxCornersNaive $
rList (arbitrary :: Gen CubeCmplx) n
fuzz_cmplxCorners n = map cmplxCorners $ rList (arbitrary :: Gen CubeCmplx) n
fuzz_cmplxSpanIntCorners n = map (uncurry cmplxSpanIntCorners) $
zip (rList (arbitrary :: Gen CubeCmplx) n)
(rList (arbitrary :: Gen VertSpan) n)
fuzz_cmplxCornersInt n = map (uncurry cmplxCornersInt) $
zip (rList (arbitrary :: Gen CubeCmplx) n)
(rList (arbitrary :: Gen VertSpan) n)
fuzz_vsFatten n = map vsFatten $ rList (arbitrary :: Gen VertSpan) n
fuzz_vsCornerPairs n = map vsCornerPairs $ rList (arbitrary :: Gen VertSpan) n
fuzz_cmplxHullUnsafe n = map cmplxHullUnsafe $ filter ((==False).cmplxNull) $
rList (arbitrary :: Gen CubeCmplx) n
--fuzz_rSubProb n = map (uncurry rSubProb) xs
-- where xs = zip (rList (arbitrary :: Gen CubeCmplx) n)
-- (rList (arbitrary :: Gen VertSpan) n)
--fuzz_rSubProbs n = map rSubProbs $ filter ((==False).cmplxNull) $
-- rList (arbitrary :: Gen CubeCmplx) n
--fuzz_disjointCov n = map disjointCov $ rList (arbitrary :: Gen VertSpan) n
fuzz_cmplxReduce' n = map (flip cmplxReduce' []) $
rList (arbitrary :: Gen CubeCmplx) n
fuzz_cmplxReduce n = map (flip cmplxReduce []) $
rList (arbitrary :: Gen CubeCmplx) n
fuzz_cmplxDelVsInt n = map (uncurry cmplxDelVsInt) $
zip (rList (arbitrary :: Gen CubeCmplx) n)
(rList (arbitrary :: Gen VertSpan) n)
-- Example tests --
eg_sqPairBack = (S.size $ cells (uncurry cmplxReduce $ sqPairBack)) == 15
eg_sqPairFwd = (S.size $ cells (uncurry cmplxReduce $ sqPairFwd)) == 14
eg_swissFlag = (S.size $ cells (uncurry cmplxReduce $ swissFlag)) == 16
eg_torus3d = (S.size $ cells (uncurry cmplxReduce $ torus3d)) == 8
eg_genusTwo3d = (S.size $ cells (uncurry cmplxReduce $ genusTwo3d)) == 11
-- Represent the classic swiss flag complex as a process trace problem
eg_swissFlag_pt = (fst $ swissFlag) ==
ptsCmplx [fromJust $ pTrace 1 [(P,1),(P,2),(V,2),(V,1)],
fromJust $ pTrace 2 [(P,2),(P,1),(V,1),(V,2)]]