David Tran’s blog

class Area a where
  area :: a -> Float

class Perimeter p where
  perimeter :: p -> Float

class Draw d where
  draw :: d -> IO ()

data Rectangle = Rectangle Float Float

instance Area Rectangle where
  area (Rectangle w h) = w * h

instance Perimeter Rectangle where
  perimeter (Rectangle w h) = 2 * (w + h)

-- instance Draw Rectangle where ...

data Circle = Circle Float

instance Area Circle where
  area (Circle radius) = pi * radius * radius

instance Perimeter Circle where
  perimeter (Circle radius) = 2 * pi * radius

-- instance Draw Circle where ...


-- ... etc

quicksort :: Ord a => [a] -> [a]
quicksort [] = []

{-
quicksort (x:xs) = quicksort [n | n <- xs, n < x]   ++ 
                   [x]                              ++ 
                   quicksort [n | n <- xs, n >= x]
-}

quicksort (x:xs) = quicksort lesser ++ x : quicksort greater
  where
  part l g [] = (l, g)
  part l g (n:ns) = if n < x then part (n:l) g ns else part l (n:g) ns
  (lesser, greater) = part [] [] xs


-- qsort (x:xs) = qsort (filter (< x) xs) ++ [x] ++ qsort (filter (>= x) xs)


-- import Data.List
-- qsort (x:xs) = qsort less ++ [x] ++ qsort more
--   where (less, more) = partition (<x) xs


-- http://en.wikipedia.org/wiki/Quicksort
-- http://www.haskell.org/haskellwiki/Introduction 
-- http://en.literateprograms.org/Quicksort_(Haskell)

data Color = Red | Orange | Yellow | Green | Blue | Indigo | Violet
  deriving Show
--  deriving (Eq, Enum, Ord, Show)

-- Consult Prelude.hs to know about the Minimal complete definition for each class.


instance Eq Color where   -- Minimal complete definition: (==) or (/=)
  Red == Red        = True
  Orange == Orange  = True
  Yellow == Yellow  = True
  Green == Green    = True
  Blue == Blue      = True
  Indigo == Indigo  = True
  Violet == Violet  = True
  _ == _            = False


instance Ord Color where   -- Minimal complete definition: (<=) or compare
  Red    < Orange   = True
  Red    < Yellow   = True
  Red    < Green    = True
  Red    < Blue     = True
  Red    < Indigo   = True
  Red    < Violet   = True
  Orange < Yellow   = True
  Orange < Green    = True
  Orange < Blue     = True
  Orange < Indigo   = True
  Orange < Violet   = True
  Yellow < Green    = True
  Yellow < Blue     = True
  Yellow < Indigo   = True
  Yellow < Violet   = True
  Green  < Blue     = True
  Green  < Indigo   = True
  Green  < Violet   = True
  Blue   < Indigo   = True
  Blue   < Violet   = True
  Indigo < Violet   = True
  _      < _        = False

  a <= b = (a < b) || (a == b)


instance Enum Color where   -- Minimal complete definition: toEnum, fromEnum
  fromEnum Red    = 0
  fromEnum Orange = 1
  fromEnum Yellow = 2
  fromEnum Green  = 3
  fromEnum Blue   = 4
  fromEnum Indigo = 5
  fromEnum Violet = 6

  toEnum 0 = Red
  toEnum 1 = Orange
  toEnum 2 = Yellow
  toEnum 3 = Green
  toEnum 4 = Blue
  toEnum 5 = Indigo
  toEnum 6 = Violet

{-  
  Redefine the two methods below to make sure 
  something like [Red ..], [Indigo, Green ..] just works
  as we deriving (Enum).
-}

  enumFrom x = map toEnum [ fromEnum x .. 6]

  enumFromThen x y =
    let x' = fromEnum x
        y' = fromEnum y
        z' = if (x' > y')
             then 0
             else if (x' < y')
                  then 6
                  else x'
    in  map toEnum [x', y' .. z']

class Eq a where
  (==), (/=) :: a -> a -> Bool
  x /= y   = not (x == y)
  x == y   = not (x /= y)

data Tree a = Leaf a | Branch (Tree a) (Tree a)

instance Eq a => Eq (Tree a) where
  Leaf a == Leaf b               = a == b
  Branch l1 r1 == Branch l2 r2   = l1 == l2 && r1 == r2
  _ == _                         = False

(A) Prove that the instance of Tree in the class Eq satisfies the laws of its class.

Law #1:  (x/=y) = not (x==y)
Since we do not redefine the operator (/=), it takes its default method, which defined just like the law to prove.

Law #2:  (x==y) && (y==z)  ====>  (x==z)
(x == y):
 Leaf xa == Leaf ya            = xa == ya
 Branch xl xr == Branch yl yr  = xl == yl && xr == yr
 _ == _                        = False

(y == z):
 Leaf ya == Leaf za            = ya == za
 Branch yl yr == Branch zl zr  = yl == zl && yr == zr
 _ == _                        = False

so (x == z):
  Leaf xa == Leaf za ====>  (xa == ya) && (ya == za) ====> (xa == za) ====> True
  Branch xl xr == Branch zl zr  ====> xl == yl && xr == yr && yl == zl && yr == zr
                                ====> xl == zl && xr == zr
                                ====> True
  _ == _  = False =====> True

(B) Also prove that the modified instance of Tree in
    the class Ord satisfies the laws of its class.

Skip ... (maybe come back later to do it)

#!/usr/bin/env ruby -w
#--------------------------------------------------------------------#
#                                                                    #
#  Program   : lsystem.rb                                            #
#  Object    : L-system (Lindenmayer system) class.  ( Fractal )     #
#  Author    : David Tran                                            #
#  Version   : 2007-06-19                                            #
#  Blog      : http://davidtran.doublegifts.com/blog/?p=83           #
#              http://davidtran.doublegifts.com/blog/?p=82           #
#  Reference : http://en.wikipedia.org/wiki/L-system                 #
#                                                                    #
#--------------------------------------------------------------------#
class Lsystem   #  D0L-system; deterministic context-free L-system
  attr_reader :start, :rules

  def initialize(start, rules)
    @start = start
    @rules = rules
    @production = start
  end

  def next
    @production.gsub!(/./) { |c| (r = @rules[c]) ? r : c }
  end
end


if __FILE__ == $0
  require 'RMagick'

  def fractal_gif(name, width, height, iterations, lsystem, &render)
    imageList = Magick::ImageList.new
    iterations.times do |i|
      image = Magick::Image.new(width, height)
      image.delay = 100
      production = (i==0) ? lsystem.start : lsystem.next
      puts "iteration ##{i}\n#{i < 4 ? production : '...'}"
      render[Magick::Draw.new, i, production].draw(image)
      imageList << image
    end
    imageList.write(name + '.gif')
  end

  def fractal_jpg(name, width, height, iterations, lsystem, &render)
    production = lsystem.start
    (iterations - 1).times { production = lsystem.next }
    image = Magick::Image.new(width, height)
    render[Magick::Draw.new, iterations - 1, production].draw(image)
    image.write(name + '.jpg')
  end

  puts "lsys_koch_curve.gif ..."
  fractal_gif('lsys_koch_curve', 400, 150, 8,
    Lsystem.new('F', 'F' => 'F+F--F+F')
  ) do |draw, iteration, prod|
      draw.translate(0, 140)
      size = 400.0 / (3 ** iteration)
      prod.split(//).each do |c|
        case c
          when 'F' : draw.line(0, 0, size, 0).translate(size, 0)
          when '+' : draw.rotate(-60)
          when '-' : draw.rotate(60)
        end
      end
      draw
    end

  puts "lsys_sierpinski_triangle.gif ..."
  fractal_gif(
    'lsys_sierpinski_triangle', 350, 600, 9,
    Lsystem.new('A', 'A' => 'B-A-B', 'B' => 'A+B+A')
  ) do |draw, iteration, prod|
      draw.translate(0, 300).stroke('blue')
      size = 350.0 / (2 ** iteration)
      prod.split(//).each do |c|
        case c
          when 'A','B' : draw.line(0, 0, size, 0).translate(size, 0)
          when '+' : draw.rotate(-60)
          when '-' : draw.rotate(60)
        end
      end
      draw
    end


  fractal_plant_render = proc do |draw, iteration, prod|
    draw.stroke('green').text(25, 470, "Created by David Tran")
    draw.rotate(-90).translate(-490, 250)
    size = 3
    prod.split(//).each do |c|
      case c
        when 'F' : draw.line(0, 0, size, 0).translate(size, 0)
        when '+' : draw.rotate(-25)
        when '-' : draw.rotate(25)
        when '[' : draw.push
        when ']' : draw.pop
      end
    end
    draw
  end

  puts "lsys_fractal_plant.gif ..."
  fractal_gif('lsys_fractal_plant', 400, 500, 7,
    Lsystem.new('X', 'X' => 'F-[[X]+X]+F[+FX]-X', 'F' => 'FF'),
    &fractal_plant_render)

  puts "lsys_fractal_plant.jpg ..."
  fractal_jpg('lsys_fractal_plant', 400, 500, 7,
    Lsystem.new('X', 'X' => 'F-[[X]+X]+F[+FX]-X', 'F' => 'FF'),
    &fractal_plant_render)

end

#!/usr/bin/env ruby -w
#---------------------------------------------------------------------#
#                                                                     #
#  Program   : ifs.rb                                                 #
#  Object    : Iterated Function System class.  ( Fractal -- IFS )    #
#  Author    : David Tran                                             #
#  Version   : 2007-06-18                                             #
#  Blog      : http://davidtran.doublegifts.com/blog/?p=82            #
#              http://davidtran.doublegifts.com/blog/?p=48            #
#              http://davidtran.doublegifts.com/blog/?p=25            #
#  Reference : http://en.wikipedia.org/wiki/Iterated_function_system  #
#              http://en.wikipedia.org/wiki/Sierpinski_gasket         #
#              http://www.sewanee.edu/Physics/PHYSICS123/IFS.html     #
#              http://www.alpheccar.org/en/posts/show/69              #
#                                                                     #
#---------------------------------------------------------------------#
class IFS
  #
  #  Each rule is an array of [w, a, b, c, d, e, f] where
  #  X' = aX + bY + e
  #  Y' = cX + dY + f
  #  and w is weight (probability) for the rule.
  #  
  def initialize(rules, start_point=[0.0, 0.0])
    @point = start_point
    @rules = rules

    # change weight to range
    @rules.inject(0.0) do |weight_begin, r|
      weight_end = weight_begin + r[0]
      r[0] = weight_begin ... weight_end
      weight_end
    end
  end

  def get_next_points(nb)
    (1..nb).inject([]) { |pts, _| pts << get_next_point }
  end

  def get_next_point
    w, a, b, c, d, e, f = get_rule
    x, y = @point
    @point = [ a*x + b*y + e, c*x + d*y + f ]
  end

  def get_rule
    loop do
      random = rand
      @rules.each { |r| return r if r[0].include?(random) }
    end
  end
end


if __FILE__ == $0
  require 'RMagick'

  def fractal_gif(name, width, height, color, imgs, pts_per_img, rules, transform)
    ifs = IFS.new(rules)
    imageList = Magick::ImageList.new
    image = Magick::Image.new(width, height)
    image.delay = 30
    imageList << image
    imgs.times do
      image = image.copy
      pts_per_img.times do
        x, y = transform[*ifs.get_next_point]
        image.pixel_color(x, y, color)
      end
      imageList << image
    end
    imageList.write(name + ".gif")
  end

  def fractal_jpg(name, width, height, color, points, rules, transform)
    ifs = IFS.new(rules)
    image = Magick::Image.new(width, height)
    points.times do
      x, y = transform[*ifs.get_next_point]
      image.pixel_color(x, y, color)
    end
    image.write(name + ".jpg")
  end

  puts "ifs_fern.jpg ..."
  fractal_jpg('ifs_fern', 300, 500, 'green', 70000,
              [ [0.01,  0.00,  0.00,  0.00, 0.16, 0, 0.00],
                [0.08,  0.20, -0.26,  0.23, 0.22, 0, 1.60],
                [0.08, -0.15,  0.28,  0.26, 0.24, 0, 0.44],
                [0.74,  0.75,  0.04, -0.04, 0.85, 0, 1.60]
              ],
              proc { |x, y| [x * 40 + 150, 450 - y * 40] }
             )

  puts "ifs_fern.gif ..."
  fractal_gif('ifs_fern', 300, 350, 'green', 50, 1000,
              # -5 <= x <= 5  and  0 <= y <= 10
              [ [0.01,  0.00,  0.00,  0.00, 0.16, 0, 0.00],
                [0.07,  0.20, -0.26,  0.23, 0.22, 0, 1.60],
                [0.07, -0.15,  0.28,  0.26, 0.24, 0, 0.44],
                [0.85,  0.85,  0.04, -0.04, 0.85, 0, 1.60]
              ],
              proc { |x, y| [x * 30 + 150, 325 - y * 30] }
             )

  puts "ifs_koch_curve.gif ..."
  fractal_gif('ifs_koch_curve', 400, 135, 'black', 50, 200,
              [ [0.25, 0.333,  0.000,  0.000, 0.333, 0.000, 0.000],
                [0.25, 0.167, -0.287,  0.287, 0.167, 0.333, 0.000],
                [0.25, 0.167,  0.287, -0.287, 0.167, 0.500, 0.287],
                [0.25, 0.333,  0.000,  0.000, 0.333, 0.667, 0.000]
              ],
              proc { |x, y| [x*400, 130 - y*400] }
             )

  puts "ifs_sierpinski_triangle.gif ..."
  fractal_gif('ifs_sierpinski_triangle', 400, 300, 'magenta', 50, 1000,
              [ [0.33, 0.5, 0, 0, 0.5, 0.0, 0.0],
                [0.33, 0.5, 0, 0, 0.5, 0.5, 0.5],
                [0.33, 0.5, 0, 0, 0.5, 1.0, 0.0]
              ],
              proc { |x, y| [x*200, 250 - y*200] }
             )

  puts "ifs_sierpinski_carpet.gif ..."
  fractal_gif('ifs_sierpinski_carpet', 200, 200, 'blue', 50, 500,
              [ [0.125, 0.333, 0, 0, 0.333, 0.000, 0.000],
                [0.125, 0.333, 0, 0, 0.333, 0.333, 0.000],
                [0.125, 0.333, 0, 0, 0.333, 0.666, 0.000],
                [0.125, 0.333, 0, 0, 0.333, 0.000, 0.333],
                [0.125, 0.333, 0, 0, 0.333, 0.000, 0.666],
                [0.125, 0.333, 0, 0, 0.333, 0.333, 0.666],
                [0.125, 0.333, 0, 0, 0.333, 0.666, 0.333],
                [0.125, 0.333, 0, 0, 0.333, 0.666, 0.666],
              ],
              proc { |x, y| [x*200, y*200] }
             )
end

(^!) :: Integer -> Integer -> Integer
x ^! n | n < 0     = error "negative exponent"
       | otherwise = f x n
  where
  f x n | n == 0    = 1
        | even n    = even_f x n
        | otherwise = x * even_f x (n-1)
    where
    even_f x n = f (x * x) (n `quot` 2)

A function f is strict if  f ⊥ = ⊥

(1)
reverse :: [a] -> [a] is strict
reverse ⊥ = ⊥

  Easy to test, just try:
  reverse (head []) ==> error

(2)
simple :: Integer -> Integer -> Integer
simple x y z = x * (y + z)
simple is strict on all arguments.
simple ⊥ y z = simple x ⊥ z = simple x y ⊥ = ⊥
( because (*) and (+) are strict )

  simple (head [] :: Integer) 2 3 ==> error
  simple 1 (head [] :: Integer) 3 ==> error
  simple 1 2 (head [] :: Integer) ==> error

(3)
map :: (a -> b) -> [a] -> [b]
map is strict only on second argument.

  map id (head []) ==> error
  map (head []) [] ==> []

(4)
tail :: [a] -> [a]
tail is a strict function.
tail ⊥ = ⊥

  tail (head []) ==> error

(5)
area :: Shape -> Float
Base on the definition of area function (page#29),
area is a strict function.
area ⊥ = ⊥

(6)
regionToGRegion :: Region -> G.Region  -- page#119
regionToGRegion r = regToGReg (0,0) (1,1) r
and
regToGReg :: Vector -> Vector -> Region -> G.Region
and
base on the definition of regToGReg page#120
if region is ⊥ the result will be ⊥.
pattern matching will fail for ⊥ case.

  regionToGRegion ⊥ = ⊥

(7)
(&&) :: Bool -> Bool -> Bool
False && x   = False  -- Prelude's definition
True  && x   = x

Base on its definition, (&&) is strict only on first argument.
  ⊥ && x = ⊥
  False    && ⊥ = False

(8)
(True &&) :: Bool -> Bool
is a strict function.
  (True &&) ⊥ = ⊥

(9)
(False &&) :: Bool -> Bool
is not a strict function.
  (False &&) ⊥ = False

(10)
ifFun :: Bool -> a -> a -> a
ifFun pred cons alt = if pred then cons else alt
ifFun is strict function on all arguments.

  ifFun (head [] :: Bool) 1 2 ==> error
  ifFun True (head []) 2 ==> error
  ifFun False 1 (head []) ==> error

Just prove one, maybe later back to prove others.

Prove: For all finite nonnegative m and n such that n >= m:
drop m . take n = take (n - m) . drop m

(a) base step: m = 0
(drop 0 . take n) xs = drop 0 (take n xs) = take n xs
(take (n-0) . drop 0) xs = take n (drop 0 xs) = take n xs
==> Proven.

(b) induction hypothesis: Assume that (drop m . take n) xs = (take (n-m) . drop m) xs

(drop (m+1) . take n) xs
= drop (m+1) (take n xs)
= drop (1+m) (take n xs) -- commutative of (+)
= (drop 1 . drop m) (take n xs)) -- property of drop m . drop n = drop (m+n)
= drop 1 ( drop m (take n xs))
= drop 1 ((drop m . take n) xs)
= drop 1 ((take (n-m) . drop m) xs) -- induction hypothesis assumption
= drop 1 (take (n-m) (drop m xs))
= (drop 1 . take (n-m)) (drop m xs)
= (take (n-m-1) . drop 1) (drop m xs) -- property of take m . drop n = drop n . take (m+n)
= take (n-(m+1)) (drop 1 (drop m xs))
= take (n-(m+1)) ((drop 1 . drop m) xs)
= take (n-(m+1)) (drop(1+m) xs) -- property of drop m . drop n = drop (m+n)
= (take (n-(m+1)) . drop (m+1)) xs -- commutative of (+)
==> Proven.