Viewing:
module UsingQuickCheck where
import Data.Char (toUpper)
import Data.List (sort)
import Test.QuickCheck
-- 1.
half :: (Eq a, Fractional a, Arbitrary a) => a -> a
half x = x / 2
halfIdentity :: (Eq a, Fractional a, Arbitrary a) => a -> a
halfIdentity = (* 2) . half
propHalfsies :: Double -> Bool
propHalfsies x = x == halfIdentity x
runPropHalfsies :: IO ()
runPropHalfsies = quickCheck propHalfsies
-- 2.
listOrdered :: (Ord a, Arbitrary a, Eq 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)
propListOrderedInt :: [Int] -> Bool
propListOrderedInt xs = listOrdered $ sort xs
propListOrderedBool :: [Bool] -> Bool
propListOrderedBool xs = listOrdered $ sort xs
propListOrderedChar :: String -> Bool
propListOrderedChar xs = listOrdered $ sort xs
propListOrderedString :: [String] -> Bool
propListOrderedString xs = listOrdered $ sort xs
propListOrderedFloat :: [Float] -> Bool
propListOrderedFloat xs = listOrdered $ sort xs
runListOrderedInt :: IO ()
runListOrderedInt = quickCheck propListOrderedInt
runListOrderedBool :: IO ()
runListOrderedBool = quickCheck propListOrderedBool
runListOrderedChar :: IO ()
runListOrderedChar = quickCheck propListOrderedChar
runListOrderedString :: IO ()
runListOrderedString = quickCheck propListOrderedString
runListOrderedFloat :: IO ()
runListOrderedFloat = quickCheck propListOrderedFloat
-- 3.
plusAssociative :: Int -> Int -> Int -> Bool
plusAssociative x y z = x + (y + z) == (x + y) + z
runPlusAssociative :: IO ()
runPlusAssociative = quickCheck plusAssociative
plusCommutative :: Int -> Int -> Bool
plusCommutative x y = x + y == y + x
runPlusCommutative :: IO ()
runPlusCommutative = quickCheck plusCommutative
-- 4.
multAssociative :: Int -> Int -> Int -> Bool
multAssociative x y z = x * (y * z) == (x * y) * z
runMultAssociative :: IO ()
runMultAssociative = quickCheck multAssociative
multCommutative :: Int -> Int -> Bool
multCommutative x y = x * y == y * x
runMultCommutative :: IO ()
runMultCommutative = quickCheck multCommutative
-- 5.
propQuotRem :: Int -> Int -> Bool
propQuotRem x y = (quot x y) * y + (rem x y) == x
propertyQuotRem :: Int -> Int -> Property
propertyQuotRem x y = x /= 0 && y /= 0 ==> propQuotRem x y
runQuotRem :: IO ()
runQuotRem = quickCheck propertyQuotRem
propDivMod :: Int -> Int -> Bool
propDivMod x y = (div x y) * y + (mod x y) == x
propertyDivMod :: Int -> Int -> Property
propertyDivMod x y = x /= 0 && y /= 0 ==> propDivMod x y
runDivMod :: IO ()
runDivMod = quickCheck propertyDivMod
-- 6.
-- Neither associative nor commutative
expAssociative :: Int -> Int -> Int -> Bool
expAssociative x y z = x ^ (y ^ z) == (x ^ y) ^ z
runExpAssociative :: IO ()
runExpAssociative = quickCheck expAssociative
expCommutative :: Int -> Int -> Bool
expCommutative x y = x ^ y == y ^ x
runExpCommutative :: IO ()
runExpCommutative = quickCheck expCommutative
-- 7.
testReverseReverse :: IO ()
testReverseReverse =
quickCheck (\xs -> (reverse . reverse $ xs) == (xs :: [Int]))
-- 8.
propParenthetical :: (Eq a) => (a -> a -> a) -> a -> a -> a -> Bool
propParenthetical f x y z = (f (f x y) z) == (f z $ f x y)
propParentheticalAddition :: Int -> Int -> Int -> Bool
propParentheticalAddition = propParenthetical (+)
testParenthicalness :: IO ()
testParenthicalness = quickCheck propParentheticalAddition
propComposing :: (Eq a, Eq b, Eq c) => (b -> c) -> (a -> b) -> a -> Bool
propComposing f g x = f (g x) == (f $ g x)
propComposingInt :: Int -> Bool
propComposingInt x = propComposing (+ 2) (+ 9) x
propComposingBool :: Bool -> Bool
propComposingBool x = propComposing (== True) (== False) x
runTestComposingInt :: IO ()
runTestComposingInt = quickCheck propComposingInt
runTestComposingBool :: IO ()
runTestComposingBool = quickCheck propComposingBool
-- 9.
propFoldyA :: [(String, String)] -> [(String, String)] -> Bool
propFoldyA xs ys = foldr (:) ys xs == (++) xs ys
runPropFoldyA :: IO ()
runPropFoldyA = quickCheck propFoldyA
-- yep
propFoldyB :: [String] -> Bool
propFoldyB xs = foldr (++) [] xs == concat xs
runPropFoldyB :: IO ()
runPropFoldyB = quickCheck propFoldyB
-- yep
-- 10.
badListLengthProp :: Int -> [a] -> Bool
badListLengthProp n xs = length (take n xs) == n
badListLengthPropIntStrings :: Int -> [String] -> Property
badListLengthPropIntStrings n xs = n > 0 ==> badListLengthProp n xs
runBadListLengthProp :: IO ()
runBadListLengthProp = quickCheck badListLengthPropIntStrings
-- 11.
propReadAndShow :: (Eq a, Read a, Show a) => a -> Bool
propReadAndShow x = (read (show x)) == x
propReadAndShowBool :: Bool -> Bool
propReadAndShowBool = propReadAndShow
propReadAndShowListFloat :: [Float] -> Bool
propReadAndShowListFloat = propReadAndShow
runPropReadAndShowBool :: IO ()
runPropReadAndShowBool = quickCheck propReadAndShowBool
runPropReadAndShowListFloat :: IO ()
runPropReadAndShowListFloat = quickCheck propReadAndShowListFloat
-- Failure
square :: (Num a) => a -> a
square x = x * x
-- sqrt must take a floating
-- which are floats and doubles
-- Precision is lost in doing this, so it won't always equals
squareIdentity :: Float -> Float
squareIdentity = square . sqrt
propSquareIdentity :: Float -> Bool
propSquareIdentity x = squareIdentity x == x
runPropSquareIdentity :: IO ()
runPropSquareIdentity = quickCheck propSquareIdentity
-- Fails for these [-1.2442006, 0.5, -0.1]
-- Idempotence
twice :: (a -> a) -> a -> a
twice f = f . f
fourTimes :: (a -> a) -> a -> a
fourTimes = twice . twice
-- 1.
capitalizeWord :: String -> String
capitalizeWord "" = ""
capitalizeWord (x:xs) = toUpper x : xs
capitalCapitan :: String -> Bool
capitalCapitan x =
(capitalizeWord x == twice capitalizeWord x) &&
(capitalizeWord x == fourTimes capitalizeWord x)
propertyCapitalize :: IO ()
propertyCapitalize = quickCheck capitalCapitan
-- 2.
sortsAlot :: [String] -> Bool
sortsAlot x =
(sort x == twice sort x) && (sort x == fourTimes sort (x :: [String]))
propertySortsAlot :: IO ()
propertySortsAlot = quickCheck sortsAlot
-- Make a Gen random generator for the datatype
-- 1.
data Fool
= Fulse
| Frue
deriving (Eq, Show)
foolGen :: Gen Fool
foolGen = elements [Fulse, Frue]
foolGenWeighted :: Gen Fool
foolGenWeighted = frequency [(2, return Fulse), (1, return Frue)]
instance Arbitrary Fool where
arbitrary = foolGen
-- Hangman testing