tree-features: 1a425ff8eb892496ab8f45114cc31b60953bc768
1: module FeatureTest (tests, sizedTreeOf) where
2:
3: import Test.Tasty (testGroup)
4: import Test.Tasty.QuickCheck (testProperty)
5: import Data.List
6: import Features
7: import Test.QuickCheck
8:
9: -- Sized Trees have a decreasing parameter which bounds their size
10:
11: sizedTreeOf :: Arbitrary a => Int -> Gen (TreeOf a)
12: sizedTreeOf n' = let n = abs n' `mod` 1000
13: in do head <- arbitrary
14: count <- choose (1, n)
15: nums <- numsSumTo n count
16: tail <- mapM sizedTreeOf nums
17: return $ if n > 1
18: then Node tail
19: else Leaf head
20:
21: sizedTree :: Int -> Gen Tree
22: sizedTree = fmap posTree . sizedTreeOf
23:
24: sizedRequest :: Int -> Gen Request
25: sizedRequest n = do first <- sizedTree n
26: second <- listOf (sizedTree n)
27: return (first, second)
28:
29: -- Helpers for implementing sized Trees
30:
31: posTree :: Num n => TreeOf [n] -> TreeOf [n]
32: posTree = fmap (map abs)
33:
34: uniqueNumsTo size count = do nums <- numsTo size
35: return (takeUnique count nums [])
36:
37: numsTo 0 = error "numsTo 0"
38: numsTo n = do head <- choose (1, n)
39: tail <- numsTo n
40: return (head : tail)
41:
42: numsSumTo size n = do nums <- uniqueNumsTo size n
43: let diffed = diffs 0 (sort nums)
44: return $ filter (/= 0) (size - sum diffed : diffed)
45:
46: diffs n [] = []
47: diffs n (x:xs) = x - n : diffs x xs
48:
49: takeUnique 0 xs acc = acc
50: takeUnique n xs acc = let xs' = dropWhile (`elem` acc) xs
51: in takeUnique (n-1) xs' (head xs' : acc)
52:
53: -- Properties for Trees
54:
55: extractFromTree n = forAll (sizedTree (1 + abs n)) positive
56: where positive t = all (>= 0) (extractFeatures' t)
57:
58: extractFromRequest n' = forAll (sizedRequest n) positive
59: where n = abs n' `mod` 1000
60: positive r = all (>= 0) (extractFeatures r)
61:
62: -- Properties for sized helpers
63:
64: numsSumToSumTo :: Int -> Int -> Property
65: numsSumToSumTo size' n' = forAll (numsSumTo size n) sums
66: where size = (abs size' `mod` 1000) + n
67: n = abs n' `mod` 1000
68: sums xs = sum xs == size
69:
70: enoughUniqueNums :: Int -> Int -> Property
71: enoughUniqueNums size' count' = forAll (uniqueNumsTo size count) enough
72: where enough = (== count) . length
73: size = abs size' `mod` 1000
74: count = abs count' `mod` 1000
75:
76: sizedTreeSized size' = forAll (sizedTree size) sized
77: where size = 1 + (abs size' `mod` 10)
78: sized t = leaves t == size
79:
80: tests = testGroup "Feature tests"
81: [
82: testProperty "numsSumToSumTo" numsSumToSumTo
83: , testProperty "enoughUniqueNums" enoughUniqueNums
84: , testProperty "sizedTreeSized" sizedTreeSized
85: , testProperty "extractFromTree" extractFromTree
86: , testProperty "extractFromRequest" extractFromRequest
87: ]
Generated by git2html.