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:           ]