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