# Test driver

import Control.Monad.State
main = flip execStateT (0,0) $do -- Triangles let t0 = Triangle 15 15 30 25 15 35 t1 = Triangle 25 15 31 (-5) 41 40 verifyF "1.01" 150$ area t0
verifyF "1.02" 235 $area t1 verify "1.03" (Triangle 26 16 32 (-4) 42 41)$ bump t1
assert  "1.04" $bumpPreservesArea t0 assert "1.05"$ bumpPreservesArea t1
-- powersOf
verify "2.01" [128,256,512,1024,2048,4096] $take 6$ drop 7 $powersOf 2 verify "2.02" [729,2187,6561,19683]$ take 4 $drop 6$ powersOf 3
verify "2.03" [1,5,25,125,625] $take 5$ powersOf 5
-- merge
verify "3.01" [2,3,7,8,10,18,24] $merge [3,7,18] [2,8,10,24] verify "3.02" [1,2,4,5,6,7,8,8,16,32]$ take 10 $merge [5..8] (powersOf 2) verify "3.03" [64,81,128,243,256,512,729,1024]$ take 8 $drop 10$ merge (powersOf 3) (powersOf 2)
where
say = liftIO . putStrLn
correct (k, n) = (k+1, n+1)
incorrect (k, n) = (k, n+1)
assert s = verify s True
verify :: (Show a, Eq a) => String -> a -> a -> StateT (Int,Int) IO ()
verify = verify' (==)
verifyF = verify' (\x y -> abs(x-y) < 0.00001)
verify' :: (Show a) => (a -> a -> Bool) -> String -> a -> a ->
StateT (Int,Int) IO ()
verify' eq tag expected actual
| eq expected actual = do
modify correct
say $" OK " ++ tag | otherwise = do modify incorrect say$ "ERR " ++ tag ++ ": expected " ++ show expected
++ " got " ++ show actual
-- End of test driver

# Type classes

In the notes, we defined types for Circle and Rectangle that were instances of this Shape class:

class Shape a where
area :: a -> Float
bump :: a -> a

Here is a definition for a triangle, in terms of the coordinates of its three vertices:

data Triangle = Triangle { ax, ay, bx, by, cx, cy :: Float }
deriving (Show, Eq)

Instantiate the Shape class for the Triangle type. To compute the area of a triangle, use the formula at http://www.mathopenref.com/coordtrianglearea.html. (Often you’ll see the area of a triangle written as $$\frac{bh}{2}$$ where $$b$$ is the length of the base and $$h$$ is the height. But that formula presumes that you know the base and height, which can be difficult to calculate from three arbitrary coordinates.

instance Shape Triangle where
area (Triangle ax ay bx by cx cy) =
abs ((ax*(by-cy) + bx*(cy-ay) + cx*(ay-by))/2)
bump (Triangle ax ay bx by cx cy) =
Triangle (ax+1) (ay+1) (bx+1) (by+1) (cx+1) (cy+1)

Just like the Monoid type class has some associated laws that instances should obey, we can define a law for Shape: the area of a shape should not be affected by bumping it to a new position! We can encode that as a generic function on any instance:

bumpPreservesArea :: Shape a => a -> Bool
bumpPreservesArea shape =
closeEnough (area shape) (area (bump shape))
where closeEnough n1 n2 = abs (n1 - n2) < 0.0001

Here are some examples:

data Circle = Circle { centerX, centerY, radius :: Float }
deriving Show
data Rectangle = Rectangle { x1, y1, x2, y2 :: Float }
deriving Show
instance Shape Circle where
area (Circle x y r) = pi * r * r
bump (Circle x y r) = Circle (x+1) (y+1) r
instance Shape Rectangle where
area (Rectangle x1 y1 x2 y2) = abs (x1 - x2) * abs (y1 - y2)
bump (Rectangle x1 y1 x2 y2) = Rectangle (x1+1) (y1+1) (x2+1) (y2+1)
λ> bumpPreservesArea (Circle 3.4 5.5 1.8)
True
λ> bumpPreservesArea (Rectangle 3 5 8 9)
True
λ> bumpPreservesArea (Triangle 0 0 1 9 2 10)
True

# Laziness

powersOf :: Num a => a -> [a]
powersOf n = map (n^) [0..]
merge :: Ord a => [a] -> [a] -> [a]
merge [] ys = ys
merge xs [] = xs
merge (x:xs) (y:ys)
| x <= y = x : merge xs (y:ys)
| otherwise = y : merge (x:xs) ys
runningSums xs = 0 : zipWith (+) xs (runningSums xs)

postorderState :: (a -> s -> (b,s)) -> Tree a -> s -> (Tree b, s)
postorderState gen Leaf s0 = (Leaf, s0)
postorderState gen (Branch value left right) s0 =
(Branch newValue newLeft newRight, s3)
where (newLeft,  s1) = postorderState gen left s0
(newRight, s2) = postorderState gen right s1
(newValue, s3) = gen value s2
prettyPrint :: Show a => String -> Tree a -> String
prettyPrint indent Leaf = indent ++ "- *\n"
prettyPrint indent (Branch v Leaf Leaf) =
indent ++ "- " ++ show v ++ "\n"
prettyPrint indent (Branch v l r) =
indent ++ "- " ++ show v ++ "\n" ++ prettyPrint tab l ++ prettyPrint tab r
where tab = indent ++ "  |"
printTree :: Show a => Tree a -> IO ()
printTree = putStrLn . prettyPrint ""
data Tree a
= Leaf
| Branch { value :: a, left, right :: Tree a }
deriving (Show)

And here’s a sample tree we used before:

sample1 :: Tree String
sample1 =
Branch "A"
(Branch "K"
(Branch "M"
Leaf
(Branch "Q" Leaf Leaf))
(Branch "P" Leaf Leaf))
Leaf
data Seed = Seed { unSeed :: Integer }
deriving (Eq, Show)
rand :: Seed -> (Integer, Seed)
rand (Seed s) = (s', Seed s')
where
s' = (s * 16807) mod 0x7FFFFFFF
withCounter :: a -> Int -> ((a, Int), Int)
withCounter value n = ((value, n), n+1)
inject :: a -> a -> (a, a)
inject value next = (next, value)