-- sample solutions for Revision Tutorial 5, 12 Dec 2012 import Test.QuickCheck import Data.Char import Data.List -- Question 1 f1 :: (Integral a) => a -> a -> Bool f1 a b = a `mod` b == 0 -- Question 2 f2 :: [Int] -> [Int] -> Int f2 [] [] = 1 f2 (x:xs) (y:ys) | f1 x y = x * f2 xs ys | otherwise = f2 xs ys f2 _ _ = error "Lists were of unequal length." zipE :: [Int] -> [Int] -> [(Int,Int)] zipE xs ys | length xs == length ys = zip xs ys | otherwise = error "Lists were of unequal length." f2' :: [Int] -> [Int] -> Int f2' xs ys = product [x | (x,y) <- zipE xs ys, f1 x y] f2'' :: [Int] -> [Int] -> Int f2'' xs ys = foldr ((*) . fst) 1 . filter (uncurry f1) \$ zipE xs ys prop_f2 xs = not (elem 0 xs) ==> f2 xs ys == f2' xs ys && f2 xs ys == f2'' xs ys where ys = reverse xs -- Question 3 f3 :: String -> [String] f3 = filter (isUpper . head) . words f3' :: String -> [String] f3' t = [(c:cs) | (c:cs) <- words t, isUpper c] f3'' :: String -> [String] f3'' t = f (words t) where f [] = [] f ((c:cs):xs) | isUpper c = (c:cs) : f xs | otherwise = f xs prop_f3 str = f3 str == f3' str && f3' str == f3'' str -- Question 4 f4 :: [Int] -> [Int] -> [Int] f4 as bs = [a + b | a <- as, b <- bs] f4' :: [Int] -> [Int] -> [Int] f4' as bs = concat (map (\a -> map (\b -> a + b) bs) as) f4'' :: [Int] -> [Int] -> [Int] f4'' [] _ = [] f4'' (a:as) bs = (f bs) ++ (f4'' as bs) where f :: [Int] -> [Int] f [] = [] f (x:xs) = (a + x) : f xs prop_f4 xs ys = f4 xs ys == f4' xs ys && f4' xs ys == f4'' xs ys -- Question 5 map' :: (a -> b) -> [a] -> [b] map' f = foldr ((:) . f) [] filter' :: (a -> Bool) -> [a] -> [a] filter' f = foldr (\a b -> if f a then a : b else b) [] -- For the higher-order versions of 2,3 and 4, see above. -- Question 6 data TwoTree a = Leaf a | Branch1 a (TwoTree a) | Branch2 a (TwoTree a) (TwoTree a) deriving (Show) treeFold :: (a -> b -> b) -> b -> TwoTree a -> b treeFold f a (Leaf e) = f e a treeFold f a (Branch1 e t) = f e (treeFold f a t) treeFold f a (Branch2 e t1 t2) = f e (treeFold f (treeFold f a t1) t2) -- Question 7 class StructurallySimilar a where similar :: a -> a -> Bool instance StructurallySimilar (TwoTree a) where similar (Leaf _) (Leaf _) = True similar (Branch1 _ t1) (Branch1 _ t2) = similar t1 t2 similar (Branch2 _ t1a t1b) (Branch2 _ t2a t2b) = similar t1a t2a && similar t1b t2b similar _ _ = False instance StructurallySimilar [a] where similar a b = length a == length b -- used "deriving" above to make TwoTree an instance of the Show class -- Question 8 product' [] = 0 product' (x:xs) = x * product' xs prop_product xs = foldr1 (*) xs == product' xs -- fix: product'' [] = 1 product'' (x:xs) = x * product'' xs -- This one is really obviously wrong x < y = not (x > y) prop_lt :: Int -> Int -> Bool prop_lt x y = (y >= x) `xor` (x Main.< y) where xor True a = not a xor False a = a -- fix with: not (x >= y)