David Tran’s blog

Axiom 3A
For all p, any r1, r2, and r3:
(r1 `Intersect` (r2 `Union` r3)) `containsR` p
<=> (r1 `containsR` p) && ((r2 `Union` r3) `containsR` p)
<=> (r1 `containsR` p) && (r2 `containsR` p || r3 `containsR` p)
<=> (r1 `containsR` p && r2 `containsR` p) || (r1 `containsR` p && r3 `containsR` p)
<=> (r1 `Intersect` r2) `containsR` p || (r1 `Intersect` r3) `containsR` p
<=> ((r1 `Intersect` r2) `Union` (r1 `Intersect` r3)) `containsR` p
so,
r1 `Intersect` (r2 `Union` r3) <=> (r1 `Intersect` r2) `Union` (r1 `Intersect` r3)

Axiom 3B
For all p, any r1, r2, and r3:
(r1 `Union` (r2 `Intersect` r3)) `containsR` p
<=> (r1 `containsR` p) || ((r2 `Intersect` r3) `containsR` p)
<=> (r1 `containsR` p) || (r2 `containsR` p && r3 `containsR` p)
<=> (r1 `containsR` p || r2 `containsR` p) && (r1 `containsR` p || r3 `containsR` p)
<=> (r1 `Union` r2) `containsR` p && (r1 `Union` r3) `containsR` p
<=> ((r1 `Union` r2) `Intersect` (r1 `Union` r3)) `containsR` p
so,
r1 `Union` (r2 `Intersect` r3) <=> (r1 `Union` r2) `Intersect` (r1 `Union` r3)

Axiom 4A
For all p, any r:
(r `Union` Empty) `containsR` p
<=> (r `containsR` p) || (Empty `containsR` p)
<=> (r `containsR` p) || False
<=> r `containsR` p
so,
r `Union` Empty <=> r

Axiom 4B
For all p, any r:
(r `Intersect` univ) `containsR` p
<=> (r `containsR` p) && ((Complement Empty) `containsR` p)
<=> (r `containsR` p) && (not (Empty `containsR` p))
<=> (r `containsR` p) && (not False)
<=> (r `containsR` p) && True
<=> r `containsR` p
so,
r `Intersect` univ <=> r

Axiom 5A
For all p, any r:
(r `Union` Complement r) `containsR` p
<=> (r `containsR` p) || (Complement r `containsR` p)
<=> (r `containsR` p) || (not (r `containsR` p))
<=> True

and
univ `containsR` p
<=> (Complement Empty) `containsR` p
<=> not (Empty `containsR` p)
<=> not False
<=> True

so,
r `Union` Complement r <=> univ

Axiom 5B
For all p, any r:
(r `Intersect` Complement r) `containsR` p
<=> (r `containsR` p) && (Complement r `containsR` p)
<=> (r `containsR` p) && (not (r `containsR` p))
<=> False

and
Empty `containsR` p
<=> False

so,
r `Intersect` Complement r <=> Empty

{-----------------------------------------------------
 flipX:(x,y)-->(x,-y)   flipY:(x,y)-->(-x,y)

 y                                 y
 ^    * (x,y)           (-x,y) *   ^   * (x,y)
 |   / \                      / \  |  / \
 |  *---*                    *---* | *---*
 +---------> x           ----------+----------> x
 |  *---*
 |   \ /
 |    * (x,-y)
-----------------------------------------------------}

flipX :: Region -> Region
flipX = Scale (1, -1)

flipY :: Region -> Region
flipY = Scale (-1, 1)


----- data/type used in this exercise -----
data Region = Scale Vector Region
type Vector = (Float, Float)

polygon :: [Coordinate] -> Region
polygon cs =
  foldl1 Intersect $ zipWith HalfPlane cs' (tail (cycle cs'))
  where
  cs' = if isClockwiseOrder cs then reverse cs else cs
  isClockwiseOrder (p1:p2:p3:_) = p2 `isLeftOf` (p1, p3)
  isClockwiseOrder _ = False


----- a test -----
main = putStrLn $ show $ polygon [(0,0), (0,5), (5,0)]

----- data/type used in this exercise -----
data Region = HalfPlane Coordinate Coordinate
            | Region `Intersect` Region
  deriving Show
type Coordinate = (Float, Float)
type Ray = (Coordinate, Coordinate)

----- reuse the isLeftOf function -----
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

My solution for the Ruby Quiz (#125) Fractals.
(posted on Ruby-talk mailing list here.)

#---------------------------------------------------------------------#
#                                                                     #
#  Program   : Fractals (Ruby Quiz #125)                              #
#  Author    : David Tran                                             #
#  Date      : 2007-05-30                                             #
#  Blog      : http://davidtran.doublegifts.com/blog/?p=48            #
#  Reference : http://mathworld.wolfram.com/PerpendicularVector.html  #
#  Note      : Using vector calculation to compute each level's       #
#              points. The first level line can be in any direction.  #
#                                                                     #
#---------------------------------------------------------------------#
require 'enumerator'
require 'RMagick'

LEVEL_0 = [[0, 0], [350, 200]]

def next_level(polylines)
  polylines.enum_cons(2).inject([polylines.first]) do |array, (p1, p2)|
    x1, y1 = p1
    x2, y2 = p2
    a = (x2 - x1) / 3.0
    b = (y2 - y1) / 3.0
    array << [x1+a, y1+b] << [x1+a-b, y1+b+a] <<
      [x1+2*a-b, y1+2*b+a] << [x1+2*a, y1+2*b] << p2
  end
end

exit unless __FILE__ == $0
imageList = Magick::ImageList.new
level = LEVEL_0
(ARGV[0].to_i + 1).times do |i|
  level = next_level(level) if i > 0
  image = Magick::Image.new(400, 300)
  image.delay = 100
  draw = Magick::Draw.new
  draw.fill_opacity(0)
  draw.stroke('black')
  draw.polyline(*level)
  draw.text(300,100,"level #{i}")
  draw.draw(image)
  imageList << image
end
imageList.write(File.basename($0) + ".gif")

data Region = HalfPlane Coordinate Coordinate
type Coordinate = (Float, Float)

containsR :: Region -> Coordinate -> Bool
HalfPlane p1 p2 `containsR` p = p `isLeftOf` (p1, p2)

----- reuse the isLeftOf function -----
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

type Ray = (Coordinate, Coordinate)

{-
          p                   __\
        _ * _         (s,t) = ap
        /| |\
       /     \                __\
      /       \       (u,v) = bp
   a *-------->* b
                __\
   p is left of ab  ==> z scale of cross-product (s,t) x (u,v) is positive.
-}
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

{-       p2                                    ___\    p1 *       _* p3
       _ *         clockwise ==> p2 is left of p1p3        \      /|
       /| \                                                 \    /
      /    \    anti-clockwise ==> p2 is on the right       _\| /
     /     _\|                                                 *
 p1 *        * p3                                              p2
-}
(Polygon pts) `containsS` p
  = and leftOfList
  where leftOfList = map isLeftOfp antiClockwiseRays
        isLeftOfp p' = isLeftOf p p'
        rays pts' = zip pts' (tail pts' ++ [head pts'])
        isClockwiseOrder (p1:p2:p3:_) = p2 `isLeftOf` (p1, p3)
        isClockwiseOrder _ = False
        antiClockwiseRays = if isClockwiseOrder pts
                            then rays (reverse pts)
                            else rays pts

----- list of type/data used in this exercise -----
type Coordinate = (Float, Float)
type Ray = (Coordinate, Coordinate)
data Shape = Polygon [Vertex]
type Vertex = (Float, Float)

----- a test -----
polygon1 = Polygon [(-1,-1), (-1,1), (1,1), (1,-1)] -- clockwise order
polygon2 = Polygon [(-1,-1), (1,-1), (1,1), (-1,1)] -- counter-clockwise order

main = do
  putStrLn $ show $ polygon1 `containsS` (0,0)
  putStrLn $ show $ polygon2 `containsS` (0,0)

annulus :: Radius -> Radius -> Region
annulus inR outR = Shape (circle outR) `difference` Shape (circle inR)
  where r1 `difference` r2 = r1 `Intersect` (Complement r2)

-- area (RtTriangle s1 s2) = s1 * s2 / 2
area (RtTriangle s1 s2) = abs (s1 * s2 / 2)

-- perimeter (RtTriangle s1 s2) = s1 + s2 + sqrt (s1 ^ 2 + s2 ^ 2)
perimeter (RtTriangle s1 s2) = abs s1 + abs s2 + sqrt (s1 ^ 2 + s2 ^ 2)

-- data Shape = RtTriangle Float Float

{-
Book's question: on section 8.2.2

How should we encode the meaning of a shape in Haskell?
It would seems foolhardy to try to build the entire set,
or list, of all of its points. (Why?)

Because there are infinity of points due to density of Real number.
(Ex. 0.0, 0.1, 0.01, 0.001, 0.0001, …. )
-}

import Shape

fiveCircles' = circlesRegion `Intersect` rectangleRegion
  where
  ps = [0, 2 ..] ++ [-2, -4 ..]
  circleShape = Shape (circle 1)
  circleShapes = map (flip Translate circleShape) [(x,y) | x <- ps, y <- ps]
  circlesRegion = foldl Union Empty circleShapes
  rectangleRegion = Translate (4, 0) (Shape $ rectangle 10 2)

circlesRegion' = foldl Union Empty (map circleR1At circleCenters)
  where
  spiral = concat $ map (replicate 2) [1..]
  directions = cycle [(2, 0), (0, 2), (-2, 0), (0, -2)]
  circleCenters = scanl (\(x,y) (dx,dy) -> (x+dx, y+dy)) (0,0) $
                  concat $ zipWith replicate spiral directions
  circleR1At v = Translate v (Shape (circle 1))

{-
fiveCircles' is theory correct but practically impossible to achieve.
All cycles in 2D plan (for axe negative infinite to positive infinite)
are almost impossible to test "Intersect". 
(Especially the way we implement the "intersect")

circlesRegion' is just for fun, it defines all cycles from origin and spiral to infinite.
-}

data Region
  = Shape Shape
  | Translate Vector Region
  | Scale Vector Region
  | Complement Region
  | Region `Union` Region
  | Region `Intersect` Region
  | Empty
  deriving Show

type Vector = (Float, Float)

infixr 5 `Union`
infixr 6 `Intersect`

data Expr
  =  C Float
  |  Expr :+ Expr
  |  Expr :- Expr
  |  Expr :* Expr
  |  Expr :/ Expr
  |  Let Var Expr Expr
  |  V Var

type Var = String
type VarList = [(Var, Float)]

evaluate :: Expr -> Float
evaluate = eval []

eval :: VarList -> Expr -> Float
eval vars (C x) = x
eval vars (e1 :+ e2) = eval vars e1 + eval vars e2
eval vars (e1 :- e2) = eval vars e1 - eval vars e2
eval vars (e1 :* e2) = eval vars e1 * eval vars e2
eval vars (e1 :/ e2) = eval vars e1 / eval vars e2
eval vars (V var)    = getVariable vars var
eval vars (Let var e1 e2) = eval vars' e2
  where vars' = setVariable vars var (eval vars e1)

getVariable :: VarList -> Var -> Float
getVariable [] varName = error ("Undefine variable: " ++ varName)
getVariable ((name,value):vs) varName
  | name == varName  = value
  | otherwise        = getVariable vs varName

setVariable :: VarList -> Var -> Float -> VarList
setVariable vars varName varValue = (varName, varValue) : vars

----- some tests -----

result1 = evaluate (Let "x" (C 5) (V "x" :+ V "x"))

{- 
  The way definied getVariable/setVariable will respect variable's scope!
  Let's try something more complex to see it:

  let x=10 in x+(let x=(x*2) in (let y=4 in y-x)*2) ===> -22.0
-}

result2 = evaluate
  (
    Let "x" (C 10)
      ( V "x" :+
          Let "x" (V "x" :* (C 2))
             ((Let "y" (C 4) (V "y" :- V "x")) :* (C 2))
      )
  )

main = do
  putStrLn $ show $ result1
  putStrLn $ show $ result2
  putStrLn $ show $ evaluate ( V "y" )  -- error