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

AltStyle によって変換されたページ (->オリジナル) /