module UsingQuickCheck where import Data.List (isPrefixOf, isSuffixOf, sort) import Data.Numbers.Primes import Test.Hspec import Test.QuickCheck -- 1. half :: Float -> Float half x = x / 2 halfIdentity :: Float -> Float halfIdentity = (* 2) . half runQcHalfIdentity :: IO () runQcHalfIdentity = quickCheck (\x -> x == halfIdentity x) -- 2. listOrdered :: (Ord a) => [a] -> Bool listOrdered xs = snd $ foldr go (Nothing, True) xs where go _ status@(_, False) = status go y (Nothing, t) = (Just y, t) go y (Just x, _) = (Just y, x >= y) prop_ListOrderedInt :: [Int] -> Bool prop_ListOrderedInt x = listOrdered (sort x) == True prop_ListOrderedBool :: [Bool] -> Bool prop_ListOrderedBool x = listOrdered (sort x) == True prop_ListOrderedString :: [String] -> Bool prop_ListOrderedString x = listOrdered (sort x) == True prop_ListOrderedChar :: [Char] -> Bool prop_ListOrderedChar x = listOrdered (sort x) == True runAllListOrderedQc = quickCheck prop_ListOrderedInt >> quickCheck prop_ListOrderedBool >> quickCheck prop_ListOrderedString >> quickCheck prop_ListOrderedChar -- 3. plusAssociative x y z = x + (y + z) == (x + y) + z prop_PlusAssociative :: Int -> Int -> Int -> Bool prop_PlusAssociative x y z = (plusAssociative x y z) plusCommutative x y = x + y == y + x prop_PlusCommutative :: Int -> Int -> Bool prop_PlusCommutative x y = (plusCommutative x y) runQcPlus :: IO () runQcPlus = quickCheck prop_PlusAssociative >> quickCheck prop_PlusCommutative -- 4. multAssociative x y z = x * (y * z) == (x * y) * z prop_MultAssociative :: Int -> Int -> Int -> Bool prop_MultAssociative x y z = (multAssociative x y z) multCommutative x y = x * y == y * x prop_MultCommutative :: Int -> Int -> Bool prop_MultCommutative x y = (multCommutative x y) runQcMult :: IO () runQcMult = quickCheck prop_MultAssociative >> quickCheck prop_MultCommutative -- 5. myQuotRem x y = (quot x y) * y + (rem x y) == x prop_QuotRem :: Int -> Int -> Property prop_QuotRem x y = x > 0 && y > 0 ==> myQuotRem x y divMod x y = (div x y) * y + (mod x y) == x -- Thanks to https://www.fpcomplete.com/blog/2017/01/quickcheck for these examples an explanations: prop_PrefixSuffix :: [Int] -> Int -> Bool prop_PrefixSuffix xs n = isPrefixOf prefix xs && isSuffixOf (reverse prefix) (reverse xs) where prefix = take n xs prop_Sqrt :: Double -> Bool prop_Sqrt x | x < 0 = isNaN sqrtX | x == 0 || x == 1 = sqrtX == x | x < 1 = sqrtX > x | x > 1 = sqrtX > 1 && sqrtX < x where sqrtX = sqrt x prop_Index_v1 :: [Integer] -> Int -> Bool prop_Index_v1 xs n = xs !! n == head (drop n xs) prop_Index_v2 :: (NonEmptyList Integer) -> NonNegative Int -> Bool prop_Index_v2 (NonEmpty xs) (NonNegative n) = xs !! n == head (drop n xs) prop_Index_v3 :: (NonEmptyList Integer) -> NonNegative Int -> Property prop_Index_v3 (NonEmpty xs) (NonNegative n) = n < length xs ==> xs !! n == head (drop n xs) prop_Index_v4 :: (NonEmptyList Integer) -> Property prop_Index_v4 (NonEmpty xs) = forAll (choose (0, length xs - 1)) $ \n -> xs !! n == head (drop n xs) prop_PrimeFactors :: (Positive Int) -> Bool prop_PrimeFactors (Positive n) = isPrime n || all isPrime (primeFactors n) prop_PrimeSum_v1 :: Int -> Int -> Property prop_PrimeSum_v1 p q = p > 2 && q > 2 && isPrime p && isPrime q ==> even (p + q) prop_PrimeSum_v1' :: Int -> Int -> Property prop_PrimeSum_v1' p q = p > 2 && q > 2 && isPrime p && isPrime q ==> classify (p < 20 && q < 20) "trivial" $ even (p + q) prop_PrimeSum_v2 :: (Positive (Large Int)) -> (Positive (Large Int)) -> Property prop_PrimeSum_v2 (Positive (Large p)) (Positive (Large q)) = p > 2 && q > 2 && isPrime p && isPrime q ==> collect (if p < q then (p, q) else (q, p)) $ even (p + q) prop_PrimeSum_v3 :: Property prop_PrimeSum_v3 = forAll (choose (1, 1000)) $ \i -> forAll (choose (1, 1000)) $ \j -> let (p, q) = (primes !! i, primes !! j) in collect (if p < q then (p, q) else (q, p)) $ even (p + q) newtype Prime a = Prime a deriving (Show) instance (Integral a, Arbitrary a) => Arbitrary (Prime a) where arbitrary = do x <- frequency [ (10, choose (0, 1000)) , (5, choose (1001, 10000)) , (1, choose (10001, 50000)) ] return $ Prime (primes !! x) prop_PrimeSum_v4 :: Prime Int -> Prime Int -> Property prop_PrimeSum_v4 (Prime p) (Prime q) = p > 2 && q > 2 ==> classify (p < 1000 || q < 1000) "has small prime" $ even (p + q)