-- Solution suggestions, FP exam 2008-12. David Sands. --

import Data.Maybe
import Data.Char
import Data.List
import Test.QuickCheck

------------ Q 1 --------------
sameElems :: Eq a => [a] -> [a] -> Bool
 
sameElems []     ys = null ys
sameElems (x:xs) ys = x `elem` ys && sameElems xs (delete x ys)


-- alternative
sameElems' xs ys = all null [xs\\ys, ys\\xs]


selections :: [a] -> [(a,[a])]
selections []     = []
selections (x:xs) = (x,xs): map xon (selections xs)
                    where xon (y,ys) = (y,x:ys)


prop_selections1,prop_selections2 :: [Int] -> Bool

prop_selections1 ps = ps == map fst (selections ps)

prop_selections2 ps = all (sameElems ps) [x:xs | (x,xs) <- selections ps] 

------------ Q 2 ---------------
type Seconds = Int
type Cents   = Int

callCost :: Seconds -> Cents
callCost c 
  | c <= cTime = cFee
  | otherwise  = cFee 
               + uCost * (1 + (c - 1 - cTime) `div` uTime)

  where  -- call price data --
        cFee        = 40 :: Cents    -- connection fee
        cTime       = 10 :: Seconds  -- time period covered by connection fee

        uTime       = 30 :: Seconds  -- length of the billing units
        uCost       = 45 :: Cents    -- cost of the each unit



letterTable :: [String] -> IO ()
letterTable = putStr . alphawords

alphawords :: [String] -> String
alphawords = unlines . map display . filter (all isAlpha)
             where display w = w ++ ": " 
                                 ++ show (length w)
                                 ++ " letters"
 
------------ Q 3 ---------------
data Expr
    = Num Integer
    | Add Expr Expr
    | Mul Expr Expr
    | Var Name
    | Expr :/ Expr

evalA :: Expr -> Integer
evalA (Num i) = i
evalA (Add e f) = evalA e + evalA f
evalA (Mul e f) = evalA e * evalA f

operMaybe op (Just a) (Just b)  =  Just (a `op` b)
operMaybe _   _       _         =  Nothing

eval :: [(Name,Integer)] -> Expr -> Maybe Integer
eval t e = ev e where 
  ev (Num i)   = Just i
  ev (Add e f) = ev e `addop` ev f where addop = operMaybe (+)
  ev (Mul e f) = ev e `mulop` ev f where mulop = operMaybe (*) 
  ev (Var n)   = lookup n t
  ev (e :/ f)  = case ev f of 
                      Just 0    -> Nothing
                      otherwise -> ev e `divop` ev f 
                                   where divop = operMaybe div  

data BigExpr = Sum Name Expr Expr Expr
                          --  lower-bound, upper-bound, sum-expression
evalBig :: [(Name,Integer)] -> BigExpr -> Maybe Integer

evalBig t (Sum n fromExp toExpr e) 
   = case (eval t fromExp, eval t toExpr) of
        (Just i, Just j) -> foldr (operMaybe (+)) (Just 0) values 
                            where values = [eval ((n,v):t) e | v <- [i..j] ]
        _                -> Nothing -- since one of the ranges was undefined

-- Assumptions: undefined range expressions means the sum is undefined. 
-- Empty range gives result zero (i.e. the usual mathematical convention). 

----------- Q 4 --------------

type Name = String
type Born = Int

data Family = Fam Name Born [Family]

duck = Fam "Uncle Scrooge" 1898 
           [Fam "Donald" 1932 []
           ,Fam "Ronald" 1932 
                [ Fam "Huey"  1968 []
                , Fam "Duey"  1968 []
                , Fam "Louie" 1968 []
                ]
           ] 

y :: Family -> Born
-- Computes the year of birth of the youngest in the family.
y = maximum . z
    where z (Fam _ born kids) = born : concatMap z kids


prop_ages :: Family -> Bool
prop_ages (Fam _ pBorn kids) = all younger kids 
                            && all prop_ages kids
        where younger (Fam _ b _) = pBorn < b                 

parent :: Name -> Family -> Maybe String

parent n f = lookup n (parentTable f)
  where parentTable (Fam m _ kids) = [(k,m) | (Fam k _ _) <- kids ] 
                                     ++ concatMap parentTable kids