-- sample solutions for Revision Tutorial 4, 5 Dec 2012 import Test.QuickCheck import Control.Monad -- defines liftM, liftM2, used below -- Question 1, from 2011 exam data Expr = Var String | Expr :+: Expr | Expr :*: Expr deriving (Eq, Show) -- code that enables QuickCheck to generate arbitrary values of type Expr instance Arbitrary Expr where arbitrary = sized arb where arb 0 = liftM Var arbitrary arb n | n > 0 = oneof [liftM Var arbitrary, liftM2 (:+:) sub sub, liftM2 (:*:) sub sub] where sub = arb (n `div` 2) -- 1a isNorm :: Expr -> Bool isNorm (a :+: b) = isNorm a && isNorm b isNorm a = isTerm a isTerm :: Expr -> Bool isTerm (Var x) = True isTerm (a :+: b) = False isTerm (a :*: b) = isTerm a && isTerm b test1a = isTerm (Var "x") == True && isTerm ((Var "x" :*: Var "y") :*: Var "z") == True && isTerm ((Var "x" :*: Var "y") :+: Var "z") == False && isTerm (Var "x" :*: (Var "y" :+: Var "z")) == False && isNorm (Var "x") == True && isNorm (Var "x" :*: Var "y" :*: Var "z") == True && isNorm ((Var "x" :*: Var "y") :+: Var "z") == True && isNorm (Var "x" :*: (Var "y" :+: Var "z")) == False && isNorm ((Var "x" :*: Var "y") :+: (Var "x" :*: Var "z")) == True && isNorm ((Var "u" :+: Var "v") :*: (Var "x" :+: Var "y")) == False && isNorm (((Var "u" :*: Var "x") :+: (Var "u" :*: Var "y")) :+: ((Var "v" :*: Var "x") :+: (Var "v" :*: Var "y"))) == True prop1a e = isTerm e ==> isNorm e prop1a' e f = isNorm e && isNorm f ==> isNorm (e :+: f) -- 1b norm :: Expr -> Expr norm (Var v) = Var v norm (a :+: b) = norm a :+: norm b norm (a :*: b) = norm a *** norm b where (a :+: b) *** c = (a *** c) :+: (b *** c) a *** (b :+: c) = (a *** b) :+: (a *** c) a *** b = a :*: b test1b = norm (Var "x") == (Var "x") && norm ((Var "x" :*: Var "y") :*: Var "z") == ((Var "x" :*: Var "y") :*: Var "z") && norm ((Var "x" :*: Var "y") :+: Var "z") == ((Var "x" :*: Var "y") :+: Var "z") && norm (Var "x" :*: (Var "y" :+: Var "z")) == ((Var "x" :*: Var "y") :+: (Var "x" :*: Var "z")) && norm ((Var "u" :+: Var "v") :*: (Var "x" :+: Var "y")) == (((Var "u" :*: Var "x") :+: (Var "u" :*: Var "y")) :+: ((Var "v" :*: Var "x") :+: (Var "v" :*: Var "y"))) prop1b a = isNorm (norm a) && norm (norm a) == norm a test1 = test1a && test1b check1 = quickCheck prop1a >> quickCheck prop1a' >> quickCheck prop1b -- Question 2, from 2010 exam -- 2a type Scalar = Int type Vector = (Int,Int) add :: Vector -> Vector -> Vector add (u,v) (x,y) = (u+x, v+y) mul :: Scalar -> Vector -> Vector mul u (x,y) = (u*x, u*y) test2a = add (1,2) (3,4) == (4,6) && mul 2 (3,4) == (6,8) -- 2b data Term = Vec Scalar Scalar | Add Term Term | Mul Scalar Term deriving (Eq, Show) -- code that enables QuickCheck to generate arbitrary values of type Term instance Arbitrary Term where arbitrary = sized arb where arb 0 = liftM2 Vec arbitrary arbitrary arb n | n > 0 = oneof [liftM2 Vec arbitrary arbitrary, liftM2 Add sub sub, liftM2 Mul arbitrary sub] where sub = arb (n `div` 2) eva :: Term -> Vector eva (Vec x y) = (x,y) eva (Add t u) = add (eva t) (eva u) eva (Mul x t) = mul x (eva t) test2b = eva (Vec 1 2) == (1,2) && eva (Add (Vec 1 2) (Vec 3 4)) == (4,6) && eva (Mul 2 (Vec 3 4)) == (6,8) && eva (Mul 2 (Add (Vec 1 2) (Vec 3 4))) == (8,12) && eva (Add (Mul 2 (Vec 1 2)) (Mul 2 (Vec 3 4))) == (8,12) prop2b t t' t'' = eva (Add t t') == eva (Add t' t) && eva (Add (Add t t') t'') == eva (Add t (Add t' t'')) -- 2c sho :: Term -> String sho (Vec x y) = show (x,y) sho (Add t u) = "(" ++ sho t ++ "+" ++ sho u ++ ")" sho (Mul x t) = "(" ++ show x ++ "*" ++ sho t ++ ")" test2c = sho (Vec 1 2) == "(1,2)" && sho (Add (Vec 1 2) (Vec 3 4)) == "((1,2)+(3,4))" && sho (Mul 2 (Vec 3 4)) == "(2*(3,4))" && sho (Mul 2 (Add (Vec 1 2) (Vec 3 4))) == "(2*((1,2)+(3,4)))" && sho (Add (Mul 2 (Vec 1 2)) (Mul 2 (Vec 3 4))) == "((2*(1,2))+(2*(3,4)))" prop2c t = count '(' (sho t) == count ')' (sho t) && count '(' (sho t) == count ',' (sho t) + count '+' (sho t) + count '*' (sho t) where count x xs = length (filter (==x) xs) test2 = test2a && test2b && test2c check2 = quickCheck prop2b >> quickCheck prop2c -- Question 3, from 2009 exam, paper 1 type Point = (Int,Int) data Points = Rectangle Point Point | Union Points Points | Difference Points Points deriving (Eq, Show) -- code that enables QuickCheck to generate arbitrary values of type Points instance Arbitrary Points where arbitrary = sized arb where arb 0 = liftM2 Rectangle arbitrary arbitrary arb n | n > 0 = oneof [liftM2 Rectangle arbitrary arbitrary, liftM2 Union sub sub, liftM2 Difference sub sub] where sub = arb (n `div` 2) -- 3a inPoints :: Point -> Points -> Bool inPoints (x,y) (Rectangle (left,top) (right,bottom)) = left <= x && x <= right && top <= y && y <= bottom inPoints p (Union ps qs) = inPoints p ps || inPoints p qs inPoints p (Difference ps qs) = inPoints p ps && not (inPoints p qs) test3a = inPoints (1,1) (Rectangle (0,0) (2,1)) == True && inPoints (3,4) (Rectangle (0,0) (2,1)) == False && inPoints (1,1) (Union (Rectangle (0,0) (0,1)) (Rectangle (1,0) (1,1))) == True && inPoints (2,2) (Union (Rectangle (0,0) (0,1)) (Rectangle (1,0) (1,1))) == False && inPoints (1,1) (Difference (Rectangle (0,0) (1,1)) (Rectangle (0,0) (0,1))) == True && inPoints (0,0) (Difference (Rectangle (0,0) (1,1)) (Rectangle (0,0) (0,1))) == False prop3a p ps ps' = inPoints p ps ==> ( inPoints p (Union ps ps') && inPoints p (Union ps' ps) && not (inPoints p (Difference ps' ps)) ) -- 3b showPoints :: Point -> Points -> [String] showPoints (a,b) ps = [ makeline y | y <- [0..b] ] where makeline y = [ if inPoints (x,y) ps then '*' else ' ' | x <- [0..a] ] test3b = showPoints (4,2) (Rectangle (1,1) (3,3)) == [" ", " *** ", " *** "] && showPoints (5,2) (Difference (Rectangle (0,0) (4,1)) (Rectangle (2,0) (2,2))) == ["** ** ", "** ** ", " "] test3 = test3a && test3b check3 = quickCheck prop3a