Instantly share code, notes, and snippets.

Embed
What would you like to do?
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…
(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)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment