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" $ \(SortedNNS (n,ns)) ->
  21                 combinOfRank n (toInteger $ length ns) (rankOfCombin n ns) == ns
  22          , testProperty "rankOfSequence n (sequenceOfRank n k r) == r" $ \(NKR (n,k,r)) ->
  23                 rankOfSequence n (sequenceOfRank n k r) == r
  24          , testProperty "sequenceOfRank n (length ns) (rankOfSequence n ns) == ns" $ \(NNS (n,ns)) ->
  25                 sequenceOfRank n (toInteger $ length ns) (rankOfSequence n ns) == ns
  26          ]
  27
  28 -- * Type 'NNS'
  29 newtype NNS = NNS (Integer, [Integer])
  30  deriving (Eq, Show)
  31 instance Arbitrary NNS where
  32         arbitrary = do
  33                 n <- arbitrarySizedNatural
  34                 k <- choose (0,n)
  35                 ns <- List.take (fromInteger k) . nubList <$> infiniteListOf (choose (1,n))
  36                 return $ NNS (n,ns)
  37
  38 -- * Type 'SortedNNS'
  39 newtype SortedNNS = SortedNNS (Integer, [Integer])
  40  deriving (Eq, Show)
  41 instance Arbitrary SortedNNS where
  42         arbitrary = do
  43                 n <- arbitrarySizedNatural
  44                 k <- choose (0,n)
  45                 ns <- List.sort . List.take (fromInteger k) . nubList <$> infiniteListOf (choose (1,n))
  46                 return $ SortedNNS (n,ns)
  47
  48 -- * Type 'NKR'
  49 newtype NKR = NKR (Integer, Integer, Integer)
  50  deriving (Eq, Show)
  51 instance Arbitrary NKR where
  52         arbitrary = do
  53                 n <- arbitrarySizedNatural
  54                 k <- choose (0, n)
  55                 r <- choose (0, (n`nCk`k) - 1)
  56                 return $ NKR (n,k,r)
  57
  58 -- | Like 'nub', but O(n * log n).
  59 nubList :: Ord a => [a] -> [a]
  60 nubList = go Set.empty where
  61         go _ [] = []
  62         go s (x:xs) | x`Set.member`s = go s xs
  63                     | otherwise      = x:go (Set.insert x s) xs