Add remaining haskell book exercises
This commit is contained in:
128
Haskell-book/14/qc/tests/UsingQuickCheckTest.hs
Normal file
128
Haskell-book/14/qc/tests/UsingQuickCheckTest.hs
Normal file
@@ -0,0 +1,128 @@
|
||||
module Main where
|
||||
|
||||
import Data.List (sort)
|
||||
import UsingQuickCheck
|
||||
import Test.QuickCheck
|
||||
|
||||
prop_half :: (Eq a, Fractional a) => a -> Bool
|
||||
prop_half x = (halfIdentity x) == x
|
||||
|
||||
associativeGen :: (Integer -> Integer -> Integer -> Bool) -> Gen Bool
|
||||
associativeGen f = do
|
||||
x <- (arbitrary :: Gen Integer)
|
||||
y <- (arbitrary :: Gen Integer)
|
||||
z <- (arbitrary :: Gen Integer)
|
||||
elements [f x y z]
|
||||
|
||||
commutativeGen :: (Integer -> Integer -> Bool) -> Gen Bool
|
||||
commutativeGen f = do
|
||||
x <- (arbitrary :: Gen Integer)
|
||||
y <- (arbitrary :: Gen Integer)
|
||||
elements [f x y]
|
||||
|
||||
assocNotNegGen :: (Int -> Int -> Int -> Bool) -> Gen Bool
|
||||
assocNotNegGen f = do
|
||||
x <- choose (1 :: Int, 100)
|
||||
y <- choose (1 :: Int, 100)
|
||||
z <- choose (1 :: Int, 100)
|
||||
elements [f x y z]
|
||||
|
||||
commutNotNegGen :: (Int -> Int -> Bool) -> Gen Bool
|
||||
commutNotNegGen f = do
|
||||
x <- choose (1 :: Int, 100)
|
||||
y <- choose (1 :: Int, 100)
|
||||
elements [f x y]
|
||||
|
||||
|
||||
prop_quotRem :: Property
|
||||
prop_quotRem =
|
||||
forAll (prop_quotRem') (\(x ,y) -> (quot x y) * y + (rem x y) == x)
|
||||
where prop_quotRem' = do
|
||||
x <- choose (1 :: Int, 10000)
|
||||
y <- choose (1 :: Int, 10000)
|
||||
return (x, y)
|
||||
|
||||
prop_divMod :: Property
|
||||
prop_divMod =
|
||||
forAll (prop_divMod') (\(x ,y) -> (div x y) * y + (mod x y) == x)
|
||||
where prop_divMod' = do
|
||||
x <- choose (1 :: Int, 10000)
|
||||
y <- choose (1 :: Int, 10000)
|
||||
return (x, y)
|
||||
|
||||
prop_reverse :: Property
|
||||
prop_reverse =
|
||||
forAll prop_reverse' (\xs -> (reverse . reverse) xs == id xs)
|
||||
where prop_reverse' = do
|
||||
x <- (arbitrary :: Gen [Integer])
|
||||
return x
|
||||
|
||||
prop_dollar :: Property
|
||||
prop_dollar =
|
||||
forAll prop_dollar' (\x -> x)
|
||||
where prop_dollar' = do
|
||||
x <- (arbitrary :: Gen Integer)
|
||||
return ((id $ x) == (id x))
|
||||
|
||||
prop_point :: Property
|
||||
prop_point =
|
||||
forAll prop_point' (\x -> x)
|
||||
where prop_point' = do
|
||||
x <- (arbitrary :: Gen Integer)
|
||||
let pointFunc = negate . id
|
||||
let appliedFunc = \y -> negate (id y)
|
||||
return (pointFunc x == appliedFunc x)
|
||||
|
||||
prop_foldr1 :: Property
|
||||
prop_foldr1 =
|
||||
forAll prop_foldr1' (\x -> x)
|
||||
where prop_foldr1' = do
|
||||
x <- (arbitrary :: Gen [Integer])
|
||||
y <- (arbitrary :: Gen [Integer])
|
||||
return ((foldr (:) x y) == (x ++ y))
|
||||
|
||||
prop_foldr2 :: Property
|
||||
prop_foldr2 =
|
||||
forAll prop_foldr2' (\x -> x)
|
||||
where prop_foldr2' = do
|
||||
x <- (arbitrary :: Gen [[Integer]])
|
||||
return ((foldr (++) [] x) == (concat x))
|
||||
|
||||
prop_length :: Property
|
||||
prop_length =
|
||||
forAll prop_length' (\x -> x)
|
||||
where prop_length' = do
|
||||
n <- (arbitrary :: Gen Int)
|
||||
xs <- (arbitrary :: Gen [Integer])
|
||||
return ((length (take n xs)) == n)
|
||||
|
||||
prop_readShow :: Property
|
||||
prop_readShow =
|
||||
forAll prop_readShow' (\x -> x)
|
||||
where prop_readShow' = do
|
||||
x <- (arbitrary :: Gen Integer)
|
||||
return ((read (show x)) == x)
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
quickCheck (prop_half :: Double -> Bool)
|
||||
quickCheck $ (listOrdered :: [Int] -> Bool) . sort
|
||||
|
||||
quickCheck $ associativeGen plusAssociative
|
||||
quickCheck $ commutativeGen plusCommutative
|
||||
quickCheck $ associativeGen mulAssociative
|
||||
quickCheck $ commutativeGen mulCommutative
|
||||
|
||||
quickCheck prop_quotRem
|
||||
quickCheck prop_divMod
|
||||
|
||||
quickCheck $ assocNotNegGen (\x y z -> x ^ (y ^ z) == (x ^ y) ^ z)
|
||||
quickCheck $ commutNotNegGen (\x y -> x ^ y == y ^ x)
|
||||
|
||||
quickCheck prop_reverse
|
||||
quickCheck prop_dollar
|
||||
quickCheck prop_point
|
||||
quickCheck prop_foldr1
|
||||
quickCheck prop_foldr2
|
||||
quickCheck prop_length
|
||||
quickCheck prop_readShow
|
||||
Reference in New Issue
Block a user