test/QuickCheck.hs

   1 {-# LANGUAGE FlexibleInstances #-}
   2 {-# LANGUAGE ScopedTypeVariables #-}
   3 {-# OPTIONS_GHC -fno-warn-orphans #-}
   4 module QuickCheck where
   5
   6 import Test.QuickCheck
   7 import Test.Tasty
   8 import Test.Tasty.QuickCheck
   9
  10 import qualified Data.List as List
  11 import qualified Data.Set as Set
  12
  13 import Htirage
  14
  15 quickchecks :: TestTree
  16 quickchecks =
  17         testGroup "QuickCheck"
  18          [ testProperty "rankOfCombin n (combinOfRank n k r) == r" $ \(NKR (n,k,r)) ->
  19                 rankOfCombin n (combinOfRank n k r) == r
  20          , testProperty "combinOfRank n (length ns) (rankOfCombin n ns) == ns" $ \(NNS (n,ns)) ->
  21                 combinOfRank n (toInteger $ length ns) (rankOfCombin n ns) == ns
  22          ]
  23
  24 -- * Type 'NNS'
  25 newtype NNS = NNS (Integer, [Integer])
  26  deriving (Eq, Show)
  27 instance Arbitrary NNS where
  28         arbitrary = do
  29                 n <- arbitrarySizedNatural
  30                 k <- choose (0,n)
  31                 ns <- List.sort . List.take (fromInteger k) . nubList <$> infiniteListOf (choose (1,n))
  32                 return $ NNS (n,ns)
  33
  34 -- * Type 'NKR'
  35 newtype NKR = NKR (Integer, Integer, Integer)
  36  deriving (Eq, Show)
  37 instance Arbitrary NKR where
  38         arbitrary = do
  39                 n <- arbitrarySizedNatural
  40                 k <- choose (0, n)
  41                 r <- choose (0, (n`nCk`k) - 1)
  42                 return $ NKR (n,k,r)
  43
  44 -- | Like 'nub', but O(n * log n).
  45 nubList :: Ord a => [a] -> [a]
  46 nubList = go Set.empty where
  47         go _ [] = []
  48         go s (x:xs) | x`Set.member`s = go s xs
  49                     | otherwise      = x:go (Set.insert x s) xs