A Hilbert space-filling curve is a fractal first discovered by German mathematician David Hilbert in 1891. It is commonly used in mapping applications because they give a mapping between 1D and 2D space that fairly well preserves locality. Michelle Brush gave an excellent talk at Strangeloop 2014 entitled _Practical Fractals in Space_ (https://w…

hilbert-curve.cljs

(ns enchilada.hilbert-curve
  (:require
    [big-bang.core :refer [big-bang]]
    [big-bang.events.browser :refer [offset-coords]]
    [jayq.core :refer [show attr css]]
    [enchilada :refer [ctx canvas]]
    [inkspot.color-chart :as color-chart]
    [monet.canvas :refer [begin-path move-to line-to
                          fill-rect fill-style
                          clear-rect stroke stroke-style stroke-width
                          save restore translate scale]]))

(defn rotate [n x y rx ry]
  (cond
    (pos? ry)  [x y]
    (zero? rx) [y x]
    :else      [(- n 1 y) (- n 1 x)]))

(defn hilbert [n x y]
  (loop [s (quot n 2)
         d 0
         x x
         y y]
    (if (zero? s)
      d
      (let [rx (if (pos? (bit-and x s)) 3 0)
            ry (if (pos? (bit-and y s)) 1 0)
            [a b] (rotate s x y rx ry)]
        (recur
          (quot s 2)
          (+ d (* s s (bit-xor rx ry)))
          a
          b)))))

(defn curve [n]
  (sort-by :d
    (for [j (range n)
          i (range n)]
      {:x i :y j :d (hilbert n i j)})))

(defn initial-state [n]
  {:colors (vec (color-chart/spectrum 4096))
   :hilbert-curve (curve n)
   :translate 10
   :scale 9
   :n n
   :d 0})

(defn handle-mousemove [event {:keys [n scale translate] :as world-state}]
  (let [[x y] (map #(quot (- % translate) scale) (offset-coords event))]
    (if (and (<= 0 x n) (<= 0 y n))
      (assoc world-state :d (hilbert n x y) :x x :y y)
      world-state)) )

(defn draw-curve [ctx curve colors d']
  (doseq [{:keys [x y d]} curve
          :let [dist (Math/abs (- d' d))]]
    (->
      ctx
      (stroke-style (colors dist))
      (line-to x y)
      (stroke)
      (begin-path)
      (move-to x y)))
  ctx)

(defn render [{:keys [d x y hilbert-curve colors] :as world-state}]
  (->
    ctx
    (save)
    (fill-style :#444)
    (fill-rect {:x 0 :y 0 :w 800 :h 600})
    (begin-path)
    (translate (world-state :translate) (world-state :translate))
    (scale (world-state :scale) (world-state :scale))
    (stroke-width 0.2)
    (begin-path)
    (draw-curve hilbert-curve colors d)
    (restore)))

(->
  canvas
  (attr :width 586)
  (attr :height 586)
  (css :cursor "cell")
  show)

(big-bang
  :event-target canvas
  :initial-state (initial-state 64)
  :on-mousemove handle-mousemove
  :to-draw render)