diff options
| author | Eugen Wissner <belka@caraus.de> | 2025-12-11 10:28:11 +0100 |
|---|---|---|
| committer | Eugen Wissner <belka@caraus.de> | 2025-12-11 10:28:11 +0100 |
| commit | 98329e0a3dd4f78b5d815ac3896272ec70904901 (patch) | |
| tree | 80f9c56cfe2ac20232358f236d32e84bd683be1b /Haskell-book/14/qc/tests/UsingQuickCheckTest.hs | |
| parent | 3624c712d72d246f21d4e710cec7c11e052e0326 (diff) | |
| download | book-exercises-98329e0a3dd4f78b5d815ac3896272ec70904901.tar.gz | |
Add remaining haskell book exercises
Diffstat (limited to 'Haskell-book/14/qc/tests/UsingQuickCheckTest.hs')
| -rw-r--r-- | Haskell-book/14/qc/tests/UsingQuickCheckTest.hs | 128 |
1 files changed, 128 insertions, 0 deletions
diff --git a/Haskell-book/14/qc/tests/UsingQuickCheckTest.hs b/Haskell-book/14/qc/tests/UsingQuickCheckTest.hs new file mode 100644 index 0000000..da5ddb5 --- /dev/null +++ b/Haskell-book/14/qc/tests/UsingQuickCheckTest.hs @@ -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
\ No newline at end of file |
