Hazard

Lindenmayer Fractals December 26, 2016

(def canvas (atom nil))

(defn coords [cmds]
  (loop [cmds cmds
         [x y :as loc] [0 0]
         dir 180
         pts [[0 0]]]
    (if (seq cmds)
      (let [[cmd & params] (first cmds)
            remaining (rest cmds)]
        (condp = cmd
          :forward (let [dist (first params)
                         radians (* dir js/Math.PI (/ 180))
                         loc' [(+ x (* dist (js/Math.sin radians)))
                               (+ y (* dist (js/Math.cos radians)))]]
                     (recur remaining loc' dir (conj pts loc')))
          :turn (recur remaining loc (- dir (first params)) pts)))
      pts)))

(def extent (juxt #(apply min %) #(apply max %)))

(defn middle [width [left right]]
  (- (/ (- width (- right left)) 2) left))

(defn draw [cmds]
  (let [canvas (js/document.getElementById @canvas)
        ctx (.getContext canvas "2d")
        w (.-width canvas)
        h (.-height canvas)
        pts (coords cmds)
        [left right] (extent (map first pts))
        [bottom top] (extent (map second pts))
        sx (middle w [left right])
        sy (middle h [bottom top])]
    (.clearRect ctx 0 0 w h)
    (set! (.-fillStyle ctx) "lightgray")
    (.beginPath ctx)
    (let [[x y] (first pts)]
      (.ellipse ctx (+ sx x) (+ sy y) 5 5 0 0 (* 2 js/Math.PI)))
    (.fill ctx)

    (set! (.-strokeStyle ctx) "black")
    (set! (.-lineWidth ctx) 2)
    (.beginPath ctx)
    (let [[x y] (first pts)]
      (.moveTo ctx (+ sx x) (+ sy y)))
    (doseq [[x y] (rest pts)]
      (.lineTo ctx (+ sx x) (+ sy y)))
    (.stroke ctx)))

(defn koch-snowflake [step rule turn-angle depth]
  (if (pos? depth)
    (let [left [[:turn (- 360 turn-angle)]]
          right [[:turn turn-angle]]
          f (koch-snowflake step :f turn-angle (dec depth))]
      (condp = rule
        :a (concat f right right f right right f)
        :f (concat f left f right right f left f)))
    [[:forward step]]))

(draw (koch-snowflake 10 :a 60 4))

Season’s greetings! Today I’m playing with turtle graphics, Lindenmayer systems, and fractals.

Turtle graphics takes its name from the physical metaphor of a turtle crawling forward, turning, crawling, and leaving a trail behind it. I’ve implemented a simple turtle graphics system using two commands:

• [:forward X] move the turtle X units in whatever direction it’s facing
• [:turn X] turns the turtle X degrees clockwise

Here’s how to draw a rectangle. The gray dot marks where the turtle started:

(draw [[:forward 75]
       [:turn 90]
       [:forward 150]
       [:turn 90]
       [:forward 75]
       [:turn 90]
       [:forward 150]])

A Lindenmayer system is a formal grammar for recursively producing some output. We’ll use L-systems to produce turtle graphics commands that draw fractals. The recursive nature of L-systems makes them well-suited to describing self-similar fractals.

One of my favorite fractals is the space-filling Hilbert curve. Here’s the definition in Clojure:

(defn hilbert [step rule depth]
  (if (pos? depth)
    (let [forward [[:forward step]]
          left [[:turn 270]]
          right [[:turn 90]]
          a (hilbert step :a (dec depth))
          b (hilbert step :b (dec depth))]
      (condp = rule
        :a (concat left b forward right a forward a right forward b left)
        :b (concat right a forward left b forward b left forward a right)))
    []))

(hilbert 10 :a 1)

The base case is quite simple:

(draw (hilbert 10 :a 1))

Recursing deeper gives more interesting results:

(draw (hilbert 10 :a 2))

(draw (hilbert 10 :a 3))

(draw (hilbert 10 :a 4))

Rather than making hard, 90° left or right turns, let’s parameterize the angle:

(defn hilbert2 [step rule turn-angle depth]
  (if (pos? depth)
    (let [forward [[:forward step]]
          left [[:turn (- 360 turn-angle)]]
          right [[:turn turn-angle]]
          a (hilbert2 step :a turn-angle (dec depth))
          b (hilbert2 step :b turn-angle (dec depth))]
      (condp = rule
        :a (concat left b forward right a forward a right forward b left)
        :b (concat right a forward left b forward b left forward a right)))
    []))

(draw (hilbert2 10 :a 85 4))

You can see the Hilbert curve beginning to unfold. Play with the angle to see how a line folds into a space-filling curve.

Here’s the definition of a Koch curve, another fun one to play with the angles on:

(defn koch-curve [step rule turn-angle depth]
  (if (pos? depth)
    (let [left [[:turn (- 360 turn-angle)]]
          right [[:turn turn-angle]]
          f (koch-curve step :f turn-angle (dec depth))]
      (condp = rule
        :a f
        :f (concat f right f left f left f right f)))
    [[:forward step]]))

(draw (koch-curve 10 :a 90 4))

A Sierpinski triangle:

(defn sierpinski [step rule turn-angle depth]
  (if (pos? depth)
    (let [left [[:turn (- 360 turn-angle)]]
          right [[:turn turn-angle]]
          f (sierpinski step :f turn-angle (dec depth))
          g (sierpinski step :g turn-angle (dec depth))]
      (condp = rule
        :a (concat f left g left g)
        :f (concat f left g right f right g left f)
        :g (concat g g)))
    [[:forward step]]))

(draw (sierpinski 10 :a 120 6))

The Dragon curve:

(defn dragon [step rule turn-angle depth]
  (if (pos? depth)
    (let [forward [[:forward step]]
          left [[:turn (- 360 turn-angle)]]
          right [[:turn turn-angle]]
          x (dragon step :x turn-angle (dec depth))
          y (dragon step :y turn-angle (dec depth))]
      (condp = rule
        :a (concat forward x)
        :x (concat x right y forward right)
        :y (concat left forward x left y)))
    []))

(draw (dragon 10 :a 90 10))

And, finally, the code behind the Koch snowflake above:

(defn koch-snowflake [step rule turn-angle depth]
  (if (pos? depth)
    (let [left [[:turn (- 360 turn-angle)]]
          right [[:turn turn-angle]]
          f (koch-snowflake step :f turn-angle (dec depth))]
      (condp = rule
        :a (concat f right right f right right f)
        :f (concat f left f right right f left f)))
    [[:forward step]]))

(draw (koch-snowflake 10 :a 60 4))