Quickcheck tests.
This commit is contained in:
parent
5a9e51c640
commit
4b23320532
295
hs/treetrie4.hs
295
hs/treetrie4.hs
|
@ -1,3 +1,4 @@
|
||||||
|
{-# LANGUAGE FlexibleInstances #-}
|
||||||
module TreeTrie where
|
module TreeTrie where
|
||||||
|
|
||||||
-- import Debug.Trace
|
-- import Debug.Trace
|
||||||
|
@ -6,6 +7,9 @@ import qualified Data.Map.Strict as Map
|
||||||
import qualified Data.Set as Set
|
import qualified Data.Set as Set
|
||||||
import Test.HUnit
|
import Test.HUnit
|
||||||
|
|
||||||
|
import Test.QuickCheck
|
||||||
|
import Control.Monad
|
||||||
|
|
||||||
data Trie a = Mt
|
data Trie a = Mt
|
||||||
| Ok a
|
| Ok a
|
||||||
| Br (Map.Map Integer (Trie a), Trie a, Map.Map Char (Trie a)) -- Opens, Wild, rest
|
| Br (Map.Map Integer (Trie a), Trie a, Map.Map Char (Trie a)) -- Opens, Wild, rest
|
||||||
|
@ -63,6 +67,7 @@ update x k w h = if k == w then Map.delete x h else Map.insert x k h
|
||||||
|
|
||||||
---------------------------------------------------------------------------
|
---------------------------------------------------------------------------
|
||||||
|
|
||||||
|
union :: Ord t => Trie (Set.Set t) -> Trie (Set.Set t) -> Trie (Set.Set t)
|
||||||
union = combine unionCombine id id
|
union = combine unionCombine id id
|
||||||
unionCombine (Ok vs) (Ok ws) = Ok (Set.union vs ws)
|
unionCombine (Ok vs) (Ok ws) = Ok (Set.union vs ws)
|
||||||
unionCombine r1 r2 | null r1 = r2
|
unionCombine r1 r2 | null r1 = r2
|
||||||
|
@ -91,107 +96,189 @@ seqs ('<' : n : s) r = Br (Map.singleton (read (n : []) :: Integer) (seqs s r),
|
||||||
seqs ('*' : s) r = Br (Map.empty, seqs s r, Map.empty)
|
seqs ('*' : s) r = Br (Map.empty, seqs s r, Map.empty)
|
||||||
seqs (x : s) r = Br (Map.empty, Mt, Map.singleton x (seqs s r))
|
seqs (x : s) r = Br (Map.empty, Mt, Map.singleton x (seqs s r))
|
||||||
|
|
||||||
main = runTestTT $
|
simpleTestCases = test [
|
||||||
test [
|
"seqs simple" ~:
|
||||||
"seqs simple" ~:
|
Br (Map.singleton 0 (ok [1]), Mt, Map.empty) ~=? seqs "<0" (ok [1]),
|
||||||
Br (Map.singleton 0 (ok [1]), Mt, Map.empty) ~=? seqs "<0" (ok [1]),
|
"union simple1" ~:
|
||||||
"union simple1" ~:
|
Br (Map.empty, Mt,
|
||||||
Br (Map.empty, Mt,
|
Map.fromList [('a', ok [1]),
|
||||||
Map.fromList [('a', ok [1]),
|
('b', ok [2])]) ~=?
|
||||||
('b', ok [2])]) ~=?
|
union (seqs "a" (ok [1])) (seqs "b" (ok [2])),
|
||||||
union (seqs "a" (ok [1])) (seqs "b" (ok [2])),
|
"union simple2" ~:
|
||||||
"union simple2" ~:
|
Br (Map.empty, Mt,
|
||||||
Br (Map.empty, Mt,
|
Map.fromList [('a', ok [1,2]),
|
||||||
Map.fromList [('a', ok [1,2]),
|
('b', ok [2])]) ~=?
|
||||||
('b', ok [2])]) ~=?
|
unions [seqs "a" (ok [1]),
|
||||||
unions [seqs "a" (ok [1]),
|
seqs "b" (ok [2]),
|
||||||
seqs "b" (ok [2]),
|
seqs "a" (ok [2])],
|
||||||
seqs "a" (ok [2])],
|
"union idem" ~:
|
||||||
"union idem" ~:
|
(seqs "abc" (ok [1])) ~=?
|
||||||
(seqs "abc" (ok [1])) ~=?
|
union (seqs "abc" (ok [1])) (seqs "abc" (ok [1])),
|
||||||
union (seqs "abc" (ok [1])) (seqs "abc" (ok [1])),
|
"union wild" ~:
|
||||||
"union wild" ~:
|
Br (Map.singleton 1 (Br (Map.empty,
|
||||||
Br (Map.singleton 1 (Br (Map.empty,
|
ok [1],
|
||||||
ok [1],
|
Map.singleton 'a' (ok [1,2]))),
|
||||||
Map.singleton 'a' (ok [1,2]))),
|
ok [1],
|
||||||
ok [1],
|
Map.empty) ~=?
|
||||||
Map.empty) ~=?
|
union (seqs "*" (ok [1])) (seqs "<1a" (ok [2])),
|
||||||
union (seqs "*" (ok [1])) (seqs "<1a" (ok [2])),
|
"route union wild1" ~: Set.fromList [1,2] ~=?
|
||||||
"route union wild1" ~: Set.fromList [1,2] ~=?
|
route "<1a" (union
|
||||||
route "<1a" (union
|
(seqs "*" (ok [1]))
|
||||||
(seqs "*" (ok [1]))
|
(seqs "<1a" (ok [2]))) Set.empty,
|
||||||
(seqs "<1a" (ok [2]))) Set.empty,
|
"route union wild2" ~: Set.fromList [1] ~=?
|
||||||
"route union wild2" ~: Set.fromList [1] ~=?
|
route "<1b" (union
|
||||||
route "<1b" (union
|
(seqs "*" (ok [1]))
|
||||||
(seqs "*" (ok [1]))
|
(seqs "<1a" (ok [2]))) Set.empty,
|
||||||
(seqs "<1a" (ok [2]))) Set.empty,
|
"route union wild3" ~: Set.fromList [1] ~=?
|
||||||
"route union wild3" ~: Set.fromList [1] ~=?
|
route "<0" (union
|
||||||
route "<0" (union
|
(seqs "*" (ok [1]))
|
||||||
(seqs "*" (ok [1]))
|
(seqs "<1a" (ok [2]))) Set.empty,
|
||||||
(seqs "<1a" (ok [2]))) Set.empty,
|
"route union wild4" ~: Set.fromList [1] ~=?
|
||||||
"route union wild4" ~: Set.fromList [1] ~=?
|
route "<2aa" (union
|
||||||
route "<2aa" (union
|
(seqs "*" (ok [1]))
|
||||||
(seqs "*" (ok [1]))
|
(seqs "<1a" (ok [2]))) Set.empty,
|
||||||
(seqs "<1a" (ok [2]))) Set.empty,
|
"intersection simple1" ~:
|
||||||
"intersection simple1" ~:
|
seqs "a" (ok [1,2]) ~=? intersection (seqs "a" (ok [1])) (seqs "a" (ok [2])),
|
||||||
seqs "a" (ok [1,2]) ~=? intersection (seqs "a" (ok [1])) (seqs "a" (ok [2])),
|
"intersection simple2" ~:
|
||||||
"intersection simple2" ~:
|
empty ~=? intersection (seqs "a" (ok [1])) (seqs "b" (ok [2])),
|
||||||
empty ~=? intersection (seqs "a" (ok [1])) (seqs "b" (ok [2])),
|
"intersection idem" ~:
|
||||||
"intersection idem" ~:
|
(seqs "abc" (ok [1])) ~=?
|
||||||
(seqs "abc" (ok [1])) ~=?
|
intersection (seqs "abc" (ok [1])) (seqs "abc" (ok [1])),
|
||||||
intersection (seqs "abc" (ok [1])) (seqs "abc" (ok [1])),
|
"difference simple1" ~:
|
||||||
"difference simple1" ~:
|
seqs "a" (ok [1]) ~=? difference (seqs "a" (ok [1,2])) (seqs "a" (ok [2])),
|
||||||
seqs "a" (ok [1]) ~=? difference (seqs "a" (ok [1,2])) (seqs "a" (ok [2])),
|
"difference simple1a" ~:
|
||||||
"difference simple1a" ~:
|
seqs "ab" (ok [1]) ~=? difference (seqs "ab" (ok [1,2])) (seqs "ab" (ok [2])),
|
||||||
seqs "ab" (ok [1]) ~=? difference (seqs "ab" (ok [1,2])) (seqs "ab" (ok [2])),
|
"difference simple2" ~:
|
||||||
"difference simple2" ~:
|
empty ~=? difference (seqs "a" (ok [1])) (seqs "a" (ok [1])),
|
||||||
empty ~=? difference (seqs "a" (ok [1])) (seqs "a" (ok [1])),
|
"difference wild" ~:
|
||||||
"difference wild" ~:
|
Br (Map.empty,
|
||||||
Br (Map.empty,
|
ok [1],
|
||||||
ok [1],
|
Map.fromList [('a', Mt)]) ~=?
|
||||||
Map.fromList [('a', Mt)]) ~=?
|
difference (seqs "*" (ok [1])) (seqs "a" (ok [1])),
|
||||||
difference (seqs "*" (ok [1])) (seqs "a" (ok [1])),
|
"difference wild 2" ~:
|
||||||
"difference wild 2" ~:
|
Br (Map.singleton 1 (Br (Map.empty,
|
||||||
Br (Map.singleton 1 (Br (Map.empty,
|
ok [1],
|
||||||
ok [1],
|
Map.singleton 'a' Mt)),
|
||||||
Map.singleton 'a' Mt)),
|
ok [1],
|
||||||
ok [1],
|
Map.empty) ~=?
|
||||||
Map.empty) ~=?
|
difference (seqs "*" (ok [1])) (seqs "<1a" (ok [1])),
|
||||||
difference (seqs "*" (ok [1])) (seqs "<1a" (ok [1])),
|
"difference wild 3" ~:
|
||||||
"difference wild 3" ~:
|
Br (Map.singleton 0 Mt,
|
||||||
Br (Map.singleton 0 Mt,
|
ok [1],
|
||||||
ok [1],
|
Map.empty) ~=?
|
||||||
Map.empty) ~=?
|
difference (seqs "*" (ok [1])) (seqs "<0" (ok [1])),
|
||||||
difference (seqs "*" (ok [1])) (seqs "<0" (ok [1])),
|
"union after difference" ~:
|
||||||
"union after difference" ~:
|
seqs "*" (ok [1]) ~=?
|
||||||
seqs "*" (ok [1]) ~=?
|
union (difference (seqs "*" (ok [1])) (seqs "a" (ok [1]))) (seqs "a" (ok [1])),
|
||||||
union (difference (seqs "*" (ok [1])) (seqs "a" (ok [1]))) (seqs "a" (ok [1])),
|
"union after difference 2" ~:
|
||||||
"union after difference 2" ~:
|
Br (Map.empty,
|
||||||
Br (Map.empty,
|
ok [1],
|
||||||
ok [1],
|
Map.fromList [('a', ok [2])]) ~=?
|
||||||
Map.fromList [('a', ok [2])]) ~=?
|
union (difference (seqs "*" (ok [1])) (seqs "a" (ok [1]))) (seqs "a" (ok [2])),
|
||||||
union (difference (seqs "*" (ok [1])) (seqs "a" (ok [1]))) (seqs "a" (ok [2])),
|
"intersection no overlap opens" ~:
|
||||||
"intersection no overlap opens" ~:
|
empty ~=?
|
||||||
empty ~=?
|
intersection (seqs "<2aa" (ok [1])) (seqs "<1b" (ok [2])),
|
||||||
intersection (seqs "<2aa" (ok [1])) (seqs "<1b" (ok [2])),
|
"intersection no overlap opens 2" ~:
|
||||||
"intersection no overlap opens 2" ~:
|
Br (Map.empty, Mt, Map.singleton 'x' (ok [1,2])) ~=?
|
||||||
Br (Map.empty, Mt, Map.singleton 'x' (ok [1,2])) ~=?
|
(intersection
|
||||||
(intersection
|
(union (seqs "x" (ok [1])) (seqs "<2aa" (ok [1])))
|
||||||
(union (seqs "x" (ok [1])) (seqs "<2aa" (ok [1])))
|
(union (seqs "x" (ok [2])) (seqs "<1b" (ok [2])))),
|
||||||
(union (seqs "x" (ok [2])) (seqs "<1b" (ok [2])))),
|
"intersection no overlap opens 3" ~:
|
||||||
"intersection no overlap opens 3" ~:
|
Br (Map.fromList [(1,Br (Map.empty,
|
||||||
Br (Map.fromList [(1,Br (Map.empty,
|
ok [3,4],
|
||||||
ok [3,4],
|
Map.fromList [('b', ok [2,3,4])])),
|
||||||
Map.fromList [('b', ok [2,3,4])])),
|
(2,Br (Map.empty,
|
||||||
(2,Br (Map.empty,
|
Br (Map.empty, ok [3,4], Map.empty),
|
||||||
Br (Map.empty, ok [3,4], Map.empty),
|
Map.fromList [('a',Br (Map.empty,
|
||||||
Map.fromList [('a',Br (Map.empty,
|
ok [3,4],
|
||||||
ok [3,4],
|
Map.fromList [('a',
|
||||||
Map.fromList [('a',
|
ok [1,3,4])]))]))],
|
||||||
ok [1,3,4])]))]))],
|
ok [3,4],
|
||||||
ok [3,4],
|
Map.empty) ~=?
|
||||||
Map.empty) ~=?
|
(intersection
|
||||||
(intersection
|
(union (seqs "*" (ok [3])) (seqs "<2aa" (ok [1])))
|
||||||
(union (seqs "*" (ok [3])) (seqs "<2aa" (ok [1])))
|
(union (seqs "*" (ok [4])) (seqs "<1b" (ok [2]))))
|
||||||
(union (seqs "*" (ok [4])) (seqs "<1b" (ok [2]))))
|
]
|
||||||
]
|
|
||||||
|
---------------------------------------------------------------------------
|
||||||
|
|
||||||
|
newtype Pattern = Pattern { getPattern :: String } deriving (Eq, Ord, Show)
|
||||||
|
newtype Message = Message { getMessage :: String } deriving (Eq, Ord, Show)
|
||||||
|
|
||||||
|
instance Arbitrary Pattern where
|
||||||
|
arbitrary = liftM Pattern $ sized $ trieNoLargerThan
|
||||||
|
where leaf = oneof $ [return "x",
|
||||||
|
return "y",
|
||||||
|
return "z",
|
||||||
|
return "*"]
|
||||||
|
trieNoLargerThan leafLimit =
|
||||||
|
if leafLimit >= 1
|
||||||
|
then frequency [(2, leaf), (3, node leafLimit)]
|
||||||
|
else leaf
|
||||||
|
node leafLimit =
|
||||||
|
do degree <- choose (0, min 4 leafLimit)
|
||||||
|
kids <- genChildren leafLimit degree
|
||||||
|
return $ "<" ++ show degree ++ concat kids
|
||||||
|
genChildren leafLimit 0 = return []
|
||||||
|
genChildren leafLimit degree =
|
||||||
|
do childLimit <- choose (1, leafLimit - (degree - 1))
|
||||||
|
child <- trieNoLargerThan childLimit
|
||||||
|
rest <- genChildren (leafLimit - childLimit) (degree - 1)
|
||||||
|
return (child : rest)
|
||||||
|
|
||||||
|
instance Arbitrary Message where
|
||||||
|
arbitrary = do Pattern p <- arbitrary
|
||||||
|
m <- sequence $ [if c == '*'
|
||||||
|
then do Message m <- scale (`div` 2) arbitrary
|
||||||
|
return m
|
||||||
|
else return (c : [])
|
||||||
|
| c <- p]
|
||||||
|
return $ Message $ concat m
|
||||||
|
|
||||||
|
instance Arbitrary (Set.Set Integer) where
|
||||||
|
arbitrary = resize 5 $ sized set
|
||||||
|
where set 0 = return Set.empty
|
||||||
|
set n = do v <- arbitrary `suchThat` (\v -> v >= 0)
|
||||||
|
s <- set (n - 1)
|
||||||
|
return $ Set.insert v s
|
||||||
|
|
||||||
|
genTrie k 0 = return Mt
|
||||||
|
genTrie k n = do Pattern p <- arbitrary
|
||||||
|
rest <- genTrie k (n - 1)
|
||||||
|
return $ union (seqs p k) rest
|
||||||
|
|
||||||
|
type TrieOfPids = Trie (Set.Set Integer)
|
||||||
|
|
||||||
|
instance Arbitrary TrieOfPids where
|
||||||
|
-- arbitrary = do vs <- arbitrary
|
||||||
|
-- resize 6 $ sized $ genTrie (Ok vs)
|
||||||
|
arbitrary = resize 6 $ sized $ genTrie (ok [1])
|
||||||
|
|
||||||
|
isWild (Br (os, w, h)) = Map.null os && Map.null h
|
||||||
|
isWild _ = False
|
||||||
|
|
||||||
|
trieContains t (Message m) = not $ Set.null $ route m t Set.empty
|
||||||
|
|
||||||
|
combineBasics :: (TrieOfPids -> TrieOfPids -> TrieOfPids) ->
|
||||||
|
(Bool -> Bool -> Bool) ->
|
||||||
|
(TrieOfPids, TrieOfPids, Message) ->
|
||||||
|
Property
|
||||||
|
combineBasics tf bf (trie1, trie2, element) =
|
||||||
|
not (isWild trie1) && not (isWild trie2) && (p || q1 || q2) ==> p == q
|
||||||
|
where p = combined `trieContains` element
|
||||||
|
q1 = trie1 `trieContains` element
|
||||||
|
q2 = trie2 `trieContains` element
|
||||||
|
q = bf q1 q2
|
||||||
|
combined = tf trie1 trie2
|
||||||
|
|
||||||
|
unionBasics = combineBasics union (||)
|
||||||
|
intersectionBasics = combineBasics intersection (&&)
|
||||||
|
differenceBasics = combineBasics difference (\ x y -> x && not y)
|
||||||
|
|
||||||
|
qCheck name t = do putStrLn name
|
||||||
|
quickCheckWith stdArgs { maxSuccess = 500 } t
|
||||||
|
|
||||||
|
main = do runTestTT simpleTestCases
|
||||||
|
qCheck "differenceBasics" differenceBasics
|
||||||
|
qCheck "intersectionBasics" intersectionBasics
|
||||||
|
qCheck "unionBasics" unionBasics
|
||||||
|
|
Loading…
Reference in New Issue