import Shape -- Sets as Characteristic functions type Set a = a -> Bool even2 :: Int -> Bool even2 x = (x `mod` 2) == 0 x `union2` y = \ z -> x z || y z x `intersect2` y = \ z -> x z && y z complement2 x = \ z -> not (x z) -- A Region is either: data Region = Shape Shape -- primitive shape | Translate Vector Region -- translated region | Scale Vector Region -- scaled region | Complement Region -- inverse of region | Region `Union` Region -- union of regions | Region `Intersect` Region -- intersection of regions | Empty deriving Show type Vector = (Float, Float) type Ray = (Vector,Vector) isLeftOf :: Vertex -> 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 containsS :: Shape -> Vertex -> Bool (Rectangle s1 s2) `containsS` (x,y) = let t1 = s1/2 t2 = s2/2 in -t1<=x && x<=t1 && -t2<=y && y<=t2 (Ellipse r1 r2) `containsS` (x,y) = (x/r1)^2 + (y/r2)^2 <= 1 (Polygon pts) `containsS` p = let shiftpts = tail pts ++ [head pts] leftOfList = map isLeftOfp(zip pts shiftpts) isLeftOfp p' = isLeftOf p p' in foldr (&&) True leftOfList (RtTriangle s1 s2) `containsS` p = (Polygon [(0,0),(s1,0),(0,s2)]) `containsS` p containsR :: Region -> Vertex -> Bool (Shape s) `containsR` p = s `containsS` p (Translate (u,v) r) `containsR` (x,y) = r `containsR` (x-u,y-v) (Scale (u,v) r) `containsR` (x,y) = r `containsR` (x/u,y/v) (Complement r) `containsR` p = not (r `containsR` p) (r1 `Union` r2) `containsR` p = r1 `containsR` p || r2 `containsR` p (r1 `Intersect` r2) `containsR` p = r1 `containsR` p && r2 `containsR` p Empty `containsR` p = False --- More on Higher Order Functions simple :: Float -> Float -> Float -> Float simple n a b = n * (a+b) multSumByFiveA a b = simple 5 a b multSumByFiveB = simple 5 listSum1, listProd1 :: [Integer] -> Integer listSum1 xs = foldr (+) 0 xs listProd1 xs = foldr (*) 1 xs listSum2, listProd2 :: [Integer] -> Integer listSum2 = foldr (+) 0 listProd2 = foldr (*) 1 and1, or1 :: [Bool] -> Bool and1 xs = foldr (&&) True xs or1 xs = foldr (||) False xs and2, or2 :: [Bool] -> Bool and2 = foldr (&&) True or2 = foldr (||) False reverse1 xs = foldl revOp [] xs where revOp acc x = x : acc revOp1 acc x = flip (:) acc x revOp2 = flip (:) reverse2 xs = foldl (flip (:)) [] xs reverse3 = foldl (flip (:)) [] squareArea (x,y) = x * y sumList = listSum1 totalSquareArea1 sides = sumList (map squareArea sides) totalSquareArea2 sides = (sumList . (map squareArea)) sides totalSquareArea3 = sumList . map squareArea --