import Data.List
import Test.QuickCheck
-- Exam from 2010-12 solved during the lecture.
-- Q1 -------------------------------------------
--Q Give the type of the following function:
q1 :: Eq a => [[a]] -> a -> [[Bool]]
q1 [] _ = []
q1 ((x:xs):xss) y = [x == y] : q1 xss y
-- Q redefine it without recursion
q1 xss y = map (\(x:_) -> [x == y]) xss
-- Q Simplify:
q1b :: Bool -> Int -> String
q1b x y = show $ not x || odd y
-- | x && even y = "False"
-- | otherwise = "True"
{- Q Define a function minmax (including its type) which given a
non-empty list returns a pair of the smallest and the largest element
in the list. Your definition should use a single tail-recursive
helper function which computes the pair, and no other recursive
functions.
-}
minmax (x:xs) = mm (x,x) xs
where
mm (s,b) [] = (s,b)
mm (s,b) (y:ys) = mm (min s y, max b y) ys
-- or foldl (\(s,b) y -> (min s y, max b y)) (x,x) xs
-- Q2 ------------------------------------------------------------
{-
This question is about representing and writing a type checker for
a tiny language of Haskell-like expressions.
The subset of Haskell expressions, Hexp, has expressions of just
the following kinds: variables (identifiers) such as x, y and z,
integer literals such as 42 and -1, boolean literals True and False,
equality expressions of the form e1 == e2, and conditionals of the
form if e1 then e2 else e3, where e1, e2 and e3 stand for any Hexp
expressions. -}
-- Q Define a datatype to represent Hexpr
data Hexp = Var String | HI Integer | HB Bool | Heq Hexp Hexp
| Hif Hexp Hexp Hexp
deriving (Eq,Show)
{-
Q Give definitions for example1, and example2
which should represent the following two Hexp
expressions (one of which is badly typed!):
if x == False then 2 else 3
if 54 == x then 42 else True
-}
example1 = Hif (Heq (Var "x") (HB False)) (HI 2) (HI 3)
example2 = Hif (Heq (HI 54) (Var "x")) (HI 42) (HB True)
{-
To determine whether a given Hexp expression is type correct we need to know the type of the variables it contains. The following types can be used to represent these things:
-}
data HType = HBool | HInt deriving (Eq,Show)
-- the type of an Hexp
type TEnv = [(String,HType)]
-- a type environment
-- Q Define a function
hType :: TEnv -> Hexp -> Maybe HType
hType t e = ht e
where
ht (Var s) = lookup s t
ht (HI _) = Just HInt
ht (HB _) = Just HBool
ht (Heq e1 e2) = case (ht e1, ht e2) of
(Just t1, Just t2) | t1 == t2 -> Just HBool
_ -> Nothing
ht (Hif eb e1 e2) = case (ht eb, ht e1, ht e2) of
(Just HBool, Just t1, Just t2)
| t1 == t2 -> Just t1
_ -> Nothing
prop_1 = hType [("x",HBool)] example1 == Just HInt
prop_2 = all (==Nothing) [hType [("x",HBool)] example2,
hType [("x",HInt)] example2 ]
{- You may decide for yourself what your function does in the case
that the type environment does not have types for all variables in the
expression. -}
------------------------------------------------------------------------
-- Question 3
type Position = (Int,Int)
type Maze = (Int, [Position]) -- positions of black squares
maze :: Maze
maze = (5,[(1,2),(1,4),(1,5),(2,2),(3,2),(3,3),(3,5),(4,2),(5,4)])
type Path = [Position] -- sequence of connected whites, last to first.
path = [(5,5),(4,5),(4,4),(4,3),(5,3),(5,2),(5,1)]
------
-- Q
neighbour :: Maze -> Position -> [Position]
neighbour (d,bs) (x,y) = -- white squares adjacent to the given position
[p | p <- adjacent, nonBlack p, valid p]
where adjacent = [(x+1,y),(x-1,y),(x,y+1),(x,y-1)]
nonBlack p = p `notElem` bs
valid (a,b) = all (\z -> z > 0 && z <= d) [a,b]
-- Q
extend :: Maze -> Path -> [Path]
-- all ways to extend the path with one more white square
extend mz (p:ps) = [q:p:ps | q <- neighbour mz p, q `notElem` ps]
-- Q
allpaths :: Maze -> Position -> [Path]
allpaths mz ps =
concat $ takeWhile (not.null) $ iterate (extendAll mz) [[ps]]
extendAll :: Maze -> [Path] -> [Path]
extendAll mz = concatMap (extend mz)
-- extend mz :: Path -> [Path]
--
fromto :: Maze -> Position -> Position -> [Path]
-- all paths from start to end
fromto mz st en = [p:ps | p:ps <- allpaths mz st, p == en ]
-- filter ((== en) . head) $ allpaths mz st
-- Q 4 ------------------------------------------------------
data TestMaze = M Maze deriving (Eq,Show)
instance Arbitrary TestMaze where
arbitrary = do
i <- arbitrary
let d = 1 + abs i
bs <- listOf (square d)
return $ M (d, nub bs)
-- impractical for testing but OK otherwise!
square d = do
x <- choose (1,d)
y <- choose (1,d)
return (x,y)
-- ensuring that mazes are well formed: squares within dimention and
-- no duplicates
prop_fromto (d,bs) = not (null whites) ==> -- missed this in the lec
sort startEnd == sort ( map reverse endStart )
where
startEnd = fromto (d,bs) start end
endStart = fromto (d,bs) end start
white = [(x,y) | x <- [1..d], y <- [1..d]] \\ bs
start = head white
end = last white
-- discussed that this is not a very practical test,
-- so don't expect it to work as-is.