-- 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)