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.)

« Previous entries Next Page » Next Page »