import Test.QuickCheck import Data.List import Data.Maybe -------------------------------------------------------------------------- -- 1. Exercises from The Craft of Functional Programming size :: Expr -> Int size (Lit _) = 0 size (Add a b) = 1 + size a + size b size (Sub a b) = 1 + size a + size b --- data Expr = Lit Int | Add Expr Expr | Sub Expr Expr | Mul Expr Expr | Div Expr Expr deriving ( Eq, Show ) eval :: Expr -> Int eval (Lit n) = n eval (Add a b) = eval a + eval b eval (Sub a b) = eval a - eval b eval (Mul a b) = eval a * eval b eval (Div a b) = eval a `div` eval b --- evalMaybe :: Expr -> Maybe Int evalMaybe (Lit n) = Just n evalMaybe (Add a b) = evalMaybe a `add` evalMaybe b where Nothing `add` _ = Nothing _ `add` Nothing = Nothing Just x `add` Just y = Just (x+y) evalMaybe (Sub a b) = evalMaybe a `sub` evalMaybe b where Nothing `sub` _ = Nothing _ `sub` Nothing = Nothing Just x `sub` Just y = Just (x-y) evalMaybe (Mul a b) = evalMaybe a `mul` evalMaybe b where Nothing `mul` _ = Nothing _ `mul` Nothing = Nothing Just x `mul` Just y = Just (x*y) evalMaybe (Div a b) = evalMaybe a `dvv` evalMaybe b where Nothing `dvv` _ = Nothing _ `dvv` Nothing = Nothing _ `dvv` (Just 0) = Nothing Just x `dvv` Just y = Just (x `div` y) --- -- Alternative implementation that simplifies matters by concentrating the -- pattern matching on `Just`/`Nothing` to a single place: data Expr' = Lit' Int | Op Ops Expr' Expr' deriving ( Eq, Show ) data Ops = Add' | Sub' | Mul' | Div' | Mod' deriving ( Eq, Show ) eval' :: Expr' -> Maybe Int eval' (Lit' n) = Just n eval' (Op op a b) = ops op (eval' a) (eval' b) where ops _ Nothing _ = Nothing ops _ _ Nothing = Nothing ops op _ (Just 0) | isDiv op = Nothing ops op (Just x) (Just y) = Just (evalOp op x y) isDiv op = op `elem` [Div',Mod'] evalOp Add' x y = x + y evalOp Sub' x y = x - y evalOp Mul' x y = x * y evalOp Div' x y = x `div` y evalOp Mod' x y = x `mod` y --- -- Side note: The above can be greatly simplified by using do-notation. This is -- because `Maybe` can be seen as and "instruction type", just like `IO`. For -- example, this code does the same as `evalMaybe` for the `Add` case: evalMaybe' (Add a b) = do a' <- evalMaybe' a b' <- evalMaybe' b return (a'+b') -------------------------------------------------------------------------- data Tree = Leaf Int | Split Tree Tree deriving ( Eq, Show ) --- collapse :: Tree -> [Int] collapse (Leaf a) = [a] collapse (Split l r) = collapse l ++ collapse r --- mirror :: Tree -> Tree mirror (Split l r) = Split (mirror r) (mirror l) mirror t = t --- genTree :: Int -> Gen Tree genTree s = frequency [ (s, do l <- genTree s' r <- genTree s' return (Split l r)) , (1, do a <- arbitrary return (Leaf a) ) ] where s' = s `div` 2 instance Arbitrary Tree where arbitrary = sized genTree prop_mirrorMirror t = mirror (mirror t) == t --- prop_mirrorCollapse t = collapse (mirror t) == reverse (collapse t) -------------------------------------------------------------------------- -- 2. Exercises on type Expr from the Lecture {- See file AnswersWeek6ExprVar.hs -} -------------------------------------------------------------------------- -- 3. File Systems data File = File String | Dir String [File] deriving ( Eq, Show ) type FileSystem = [File] -- this function returns all paths search :: FileSystem -> String -> [String] search files name = [ name | File name' <- files , name == name' ] ++ [ dir ++ "/" ++ path | Dir dir files' <- files , path <- search files' name ] -- this function returns maybe a path searchMaybe :: FileSystem -> String -> Maybe String searchMaybe files name = listToMaybe ( [ name | File name' <- files , name == name' ] ++ [ dir ++ "/" ++ path | Dir dir files' <- files , Just path <- [searchMaybe files' name] ] ) -- it can also be defined using the first one... searchMaybe' :: FileSystem -> String -> Maybe String searchMaybe' files name = listToMaybe (search files name) exampleFileSystem :: FileSystem exampleFileSystem = [ File "apa" , Dir "bepa" [ File "apa", Dir "bepa" [], Dir "cepa" [ File "bepa" ] ] , Dir "cepa" [ Dir "bepa" [], Dir "cepa" [ File "apa" ] ] ] -------------------------------------------------------------------------- -- 4. Exercises on Propositional Logic data Proposition = Var Name | Proposition :&: Proposition | Proposition :|: Proposition | Not Proposition deriving ( Eq, Show ) type Name = String --- vars :: Proposition -> [Name] vars (Var x) = [x] vars (a :&: b) = vars a `union` vars b vars (a :|: b) = vars a `union` vars b vars (Not a) = vars a truthValue :: [(Name,Bool)] -> Proposition -> Bool truthValue val (Var x) = fromJust (lookup x val) truthValue val (a :&: b) = truthValue val a && truthValue val b truthValue val (a :|: b) = truthValue val a || truthValue val b truthValue val (Not a) = not (truthValue val a) --- -- allVals xs enumerates all possible valuations of the variables xs: -- 1. when xs = [], there is just one valuation -- 2. otherwise, we enumerate all possible valuations for the rest -- of the variables, plus all possible values of x allVals :: [Name] -> [[(Name,Bool)]] allVals [] = [[]] allVals (x:xs) = [ (x,b):val | val <- allVals xs , b <- [False,True] ] tautology :: Proposition -> Bool tautology a = and [ truthValue val a | val <- allVals (vars a) ] -- an example hamlet :: Proposition hamlet = Var "to be" :|: Not (Var "to be") --------------------------------------------------------------------- -- 5. Approximating 0-solutions to functions solve :: (Double -> Double) -> (Double,Double) -> Double solve f (x0,x1) | fx =? 0 = x | x0 == x1 = error "no solution found!" | fx0 > 0 || fx1 < 0 = error "interval does not contain 0!" | fx < 0 = solve f (x,x1) | fx > 0 = solve f (x0,x) where x = (x0 + x1) / 2 fx = f x fx0 = f x0 fx1 = f x1 x =? y = abs (x-y) < 0.0000000001