07.31.07

Exercise 8.7

Posted in Uncategorized at 9:56 pm by admin

One way to do this is to handle each constructor for a Region (and a Shape for those cases) and reflect those in the x-axis, i.e.

```flipX :: Region -> Region flipX (Translate (a,b) r) = Translate (a,-b) (flipX r) flipX (Scale (a,b) r) = Scale (a,-b) (flipX r) flipX (Complement r) = Complement (flipX r) flipX (r1 `Union` r2) = (flipX r1) `Union` (flipX r2) flipX (r1 `Intersect` r2) = (flipX r1) `Intersect` (flipX r2) flipX (HalfPlane (x1,y1) (x2,y2)) = HalfPlane (x2,-y2) (x1,-y1) flipX Empty = Empty flipX (Shape s) = Shape (flipXShape s) where flipXShape (RtTriangle a b) = RtTriangle a (-b) flipXShape (Polygon vs) = Polygon (map ((x,y) -> (x,-y)) vs) flipXShape s = s```

And similarly (negating the x-coordinate) for flipY. Note that the order of points must change in HalfPlane, and should also be reversed in flipping a Polygon if we had the clockwise ordering constraint. Another way to solve this exercise is to use the Scale constructor on a Region:

```flipX :: Region -> Region flipX r = Scale (1, -1) r   flipY :: Region -> Region flipY r = Scale (-1, 1) r```

07.29.07

Exercise 8.6

Posted in Uncategorized at 11:55 pm by admin

```polygon :: [Coordinate] -> Region polygon [] = Empty polygon [x] = Empty polygon (x:xs) = halfPlanes x (xs ++ [x]) where halfPlanes x1 (x2:xs) = HalfPlane x1 x2 `Intersect` halfPlanes x2 xs halfPlanes xlast [] = Complement Empty```

Exercise 8.5

Posted in Uncategorized at 11:52 pm by admin

```data Region = ... | HalfPlane Coordinate Coordinate ...   (HalfPlane p1 p2) `containsR` p = p `isLeftOf` (p1,p2)```

Exercise 8.4

Posted in Uncategorized at 11:49 pm by admin

The simplest way to allow vertices in clockwise or anticlockwise order is to define isRightOf analogously to isLeftOf, and combine them with a boolean expression.

```isLeftOf :: Coordinate -> Ray -> Bool (px,py) `isLeftOf` ((ax,ay), (bx,by)) = let (s,t) = (px-ax, py-ay) (u,v) = (px-bx, py-by) in s * v >= t * u   isRightOf :: Coordinate -> Ray -> Bool (px,py) `isRightOf` ((ax,ay), (bx,by)) = let (s,t) = (px-ax, py-ay) (u,v) = (px-bx, py-by) in s * v <= t * u   (Polygon pts) `containsS` p = let leftOfList = map isLeftOfp (zip pts (tail pts ++ [head pts])) isLeftOfp p' = isLeftOf p p' rightOfList = map isRightOfp (zip pts (tail pts ++ [head pts])) isRightOfp p' = isRightOf p p' in and leftOfList || and rightOfList```

Exercise 8.3

Posted in Uncategorized at 11:42 pm by admin

```r1 `difference` r2 = r1 `Intersect` (Complement r2)   annulus :: Radius -> Radius -> Region annulus rinner router = Shape (circle router) `difference` Shape (circle rinner)```

Exercise 8.2

Posted in Uncategorized at 11:38 pm by admin

```area (Rectangle a b) = abs(a * b) area (RtTriangle a b) = abs(a * b) / 2 area (Ellipse r1 r2) = pi * abs(r1 * r2)   perimeter (Rectangle s1 s2) = 2 * (abs s1 + abs s2) perimeter (RtTriangle s1 s2) = abs s1 + abs s2 + sqrt(s1^2 + s2^2) perimeter (Ellipse r1 r2) | abs r1 > abs r2 = ellipsePerim (abs r1) (abs r2) | otherwise = ellipsePerim (abs r2) (abs r1) where ellipsePerim r1 r2 = let e = sqrt (r1^2 - r2^2) / r1 aux s i = nextEl e s i s = scanl aux (0.25 * e^2) [2..] test x = x > epsilon sSum = sum (takeWhile test s) in 2 * r1 * pi * (1 - sSum)```

The definitions dealing with other kinds of Shape need not be changed.

Exercise 8.1

Posted in Uncategorized at 11:24 pm by admin

```oneCircle = Shape (Ellipse 1 1) manyCircles' = [Translate (x,y) oneCircle | x <- centers, y <- centers] where centers = [0, 2 ..] ++ [-2, -4 ..] manyCirclesRegion = foldl Union Empty manyCircles' rectRegion = Translate (4,0) (Shape (Rectangle 10 2)) fiveCircles' = rectRegion `Intersect` manyCirclesRegion```

This is technically correct, but the problem here lies with the inability to lazy evaluate Intersect in a matter similar to take. I’m not sure this could easily be made to work: we would need to define Intersect differently and probably also impose an ordering constraint on Region composition. Even then, I think we still have an ordering problem with the positive-and-negative-infinite list evaluation, whereby a bounded Region and an infinite Region (e.g. a semi-infinite halfplane) would be incompatible (although I could be wrong about this depending on how Haskell’s lazy evaluation works exactly).

07.28.07

Exercise 7.5

Posted in Uncategorized at 9:59 pm by admin

```data Expr = C Float | V String | Expr :+ Expr | Expr :- Expr | Expr :* Expr | Expr :/ Expr | Let String Expr Expr deriving Show   evaluate :: Expr -> [(String, Float)] -> Float evaluate (C x) _ = x evaluate (V x) vars = lookup x vars where lookup i [] = error "Unbound variable" lookup i ((a,b):vars) = if i == a then b else lookup i vars evaluate (e1 :+ e2) vars = (evaluate e1 vars) + (evaluate e2 vars) evaluate (e1 :- e2) vars = (evaluate e1 vars) - (evaluate e2 vars) evaluate (e1 :* e2) vars = (evaluate e1 vars) * (evaluate e2 vars) evaluate (e1 :/ e2) vars = (evaluate e1 vars) / (evaluate e2 vars) evaluate (Let s e1 e2) vars = let es = evaluate e1 vars in evaluate e2 ((s, es):vars)```

Exercise 7.4

Posted in Uncategorized at 9:56 pm by admin

It’s not clear what the action of zip should be on trees with data only at the leaves: if the two trees are mismatched, what should the zipped tree look like? So it is easier to define zipWith on an InternalTree, and of course to define zip in terms of zipWith.

```zipWithInternalTree :: (a -> b -> c) -> InternalTree a -> InternalTree b -> InternalTree c zipWithInternalTree f ILeaf _ = ILeaf zipWithInternalTree f _ ILeaf = ILeaf zipWithInternalTree f (IBranch a x y) (IBranch b i j) = IBranch (f a b) x' y' where x' = (zipWithInternalTree f x i) y' = (zipWithInternalTree f y j)   zipInternalTree :: InternalTree a -> InternalTree b -> InternalTree (a,b) zipInternalTree x y = zipWithInternalTree (,) x y```

Exercise 7.3

Posted in Uncategorized at 9:48 pm by admin

```foldrTree :: (a -> b -> b) -> b -> InternalTree a -> b foldrTree f z ILeaf = z foldrTree f z (IBranch a x y) = foldrTree f (f a (foldrTree f z y)) x   foldlTree :: (a -> b -> a) -> a -> InternalTree b -> a foldlTree f z ILeaf = z foldlTree f z (IBranch a x y) = foldlTree f (f (foldlTree f z x) a) y   repeatTree :: a -> InternalTree a repeatTree a = t where t = (IBranch a (t) (t))```

repeatTree is apparently magic: the base case constructor (ILeaf) is not specified. But the takeTree and takeTreeWhile functions work with repeatTree as expected.

(Technical error 14 applies to this exercise.)