import Test.QuickCheck
import Text.Show.Functions
import Data.Char
import Data.Maybe
import Data.List
---------------------------------------------------------------------
-- 1. Exercises from The Craft of Functional Programming
length' :: [a] -> Int
length' xs = sum (map (\x -> 1) xs)
--
iter :: Int -> (a -> a) -> (a -> a)
iter 0 f = id
iter n f = f . iter (n-1) f
{-
-- alternatively:
iter :: Int -> (a -> a) -> (a -> a)
iter 0 f x = x
iter n f x = f (iter (n-1) f x)
-}
--
prop_IterN x y =
x >= 0 && y >= 0 ==>
f1 x y == f2 x y
where
f1 = (\n -> iter n succ) :: Int -> Int -> Int
f2 = (+)
--
sumSquares :: Integer -> Integer
sumSquares n = foldr (+) 0 $ map (\x -> x*x) [1..n]
--
mystery xs = foldr (++) [] (map sing xs)
where
sing x = [x]
prop_Mystery xs = mystery xs == (xs :: [Int])
--
{-
(id . f) is the same as f, because the result of f is fed to the
identity function id, and thus not changed
(id :: Bool -> Bool)
(f . id) is the same as f, because the argument of f is fed to the
identity function id, and thus not changed
(id :: Int -> Int)
id f is the same as f, because applying id to something does not
change it
(id :: (Int -> Bool) -> (Int -> Bool))
-}
--
composeList :: [a -> a] -> (a -> a)
composeList = foldr (.) id
{-
-- alternatively
composeList :: [a -> a] -> (a -> a)
composeList [] = id
composeList (f:fs) = f . composeList fs
-}
--
flip' :: (a -> b -> c) -> (b -> a -> c)
flip' f = \x y -> f y x
---------------------------------------------------------------------
-- 2. List Comprehensions and Higher-order functions
prop_A1 xs = map (+1) xs == [ x+1 | x <- xs :: [Int] ]
prop_A2 xs ys = concat (map (\x -> map (\y -> x+y) ys) xs) == [ x+y | x <- xs, y <- ys :: [Int] ]
prop_A3 xs = map (+2) (filter (>3) xs) == [ x+2 | x <- xs :: [Int], x > 3 ]
prop_A4 xys = map (\(x,_) -> x+3) xys == [ x+3 | (x,_) <- xys :: [(Int,Int)] ]
prop_A4' xys = map ((+3) . fst) xys == [ x+3 | (x,_) <- xys :: [(Int,Int)] ]
prop_A5 xys = map ((+4) . fst) (filter (\(x,y) -> x+y < 5) xys) == [ x+4 | (x,y) <- xys :: [(Int,Int)], x+y < 5 ]
prop_A6 mxs = map (\(Just x) -> x+5) (filter isJust mxs) == [ x+5 | Just x <- mxs :: [Maybe Int] ]
prop_B1 xs = [ x+3 | x <- xs ] == map (+3) (xs :: [Int])
prop_B2 xs = [ x | x <- xs, x > 7 ] == filter (>7) (xs :: [Int])
prop_B3 xs ys = [ (x,y) | x <- xs, y <- ys ] == concat (map (\x -> map (\y -> (x,y)) (ys :: [Int])) (xs :: [Int]))
prop_B4 xys = [ x+y | (x,y) <- xys, x+y > 3 ] == filter (>3) (map (\(x,y) -> x+y) (xys :: [(Int,Int)]))
{-
instance Arbitrary a => Arbitrary (Maybe a) where
arbitrary =
frequency
[ (1, do return Nothing)
, (5, do x <- arbitrary
return (Just x))
]
-}
-------------------------------------------------------------------------
-- 3. Generating Lists
listOfLength :: Int -> Gen a -> Gen [a]
listOfLength n gen = sequence [ gen | i <- [1..n] ]
pairsOfEqualLengthLists :: Gen a -> Gen ([a],[a])
pairsOfEqualLengthLists gen =
do n <- choose (0,100)
xs <- listOfLength (abs n) gen
ys <- listOfLength (abs n) gen
return (xs,ys)
prop_ZipUnzip :: [(Int,Int)] -> Bool
prop_ZipUnzip xys =
zip xs ys == xys
where
(xs,ys) = unzip xys
-- simple, but bad, solution
prop_UnzipZip :: [Int] -> [Int] -> Property
prop_UnzipZip xs ys =
length xs == length ys ==>
unzip (zip xs ys) == (xs,ys)
-- alternative solution 1
data TwoSameLengthLists a = SameLength [a] [a]
deriving (Show)
instance Arbitrary a => Arbitrary (TwoSameLengthLists a) where
arbitrary =
do (xs,ys) <- pairsOfEqualLengthLists arbitrary
return (SameLength xs ys)
prop_UnzipZip1 :: TwoSameLengthLists Int -> Bool
prop_UnzipZip1 (SameLength xs ys) =
unzip (zip xs ys) == (xs,ys)
-- alternative solution 2
prop_UnzipZip2 :: Property
prop_UnzipZip2 =
forAll (pairsOfEqualLengthLists arbitrary) $ \(xs,ys) ->
unzip (zip xs ys) == (xs :: [Int],ys :: [Int])
-------------------------------------------------------------------------
-- 4. Generating Ordered Lists
orderedList :: Gen [Integer]
orderedList =
do x <- arbitrary
ds <- arbitrary
return (make x ds)
where
make x [] = []
make x (d:ds) = x : make (x+abs d) ds