Skip to content

Instantly share code, notes, and snippets.

@edw edw/hilbert-7.svg
Last active Aug 12, 2016

What would you like to do?
Hilbert Curves
Sorry, something went wrong. Reload?
Sorry, we cannot display this file.
Sorry, this file is invalid so it cannot be displayed.
;; curve-or-what-the-labyrinth-really-looked-like/
(def hilbert-rules {:L [:+ :R :F :- :L :F :L :- :F :R :+]
:R [:- :L :F :+ :R :F :R :+ :F :L :-]})
(defn produce-steps [rules start-steps iters]
(loop [steps start-steps
i iters]
(if (zero? i)
(filter #{:- :+ :F} steps)
(recur (flatten (for [sym steps] (sym rules sym)))
(dec i)))))
(defn turn-left [heading] (get {:N :W :W :S :S :E :E :N} heading))
(defn turn-right [heading] (get {:N :E :E :S :S :W :W :N} heading))
(defn heading-x [heading] (get {:N 0 :E 1 :S 0 :W -1} heading))
(defn heading-y [heading] (get {:N 1 :E 0 :S -1 :W 0} heading))
(defn steps->verts [steps]
(loop [ops (list [0 0]) x 0 y 0 heading :N steps steps]
(if (not (seq steps))
(reverse ops)
(let [step (first steps)]
(cond (= step :+)
(recur ops x y (turn-right heading) (rest steps))
(= step :-)
(recur ops x y (turn-left heading) (rest steps))
(= step :F)
(let [new-x (+ x (heading-x heading))
new-y (+ y (heading-y heading))]
(recur (cons [new-x new-y] ops)
new-x new-y
heading (rest steps)))
(throw (Exception. (format "Unknown step: %s" step))))))))
(defn verts-min-pt [verts]
[(reduce min (Double/POSITIVE_INFINITY) (map first verts))
(reduce min (Double/POSITIVE_INFINITY) (map second verts))])
(defn verts-max-pt [verts]
[(reduce max (Double/NEGATIVE_INFINITY) (map first verts))
(reduce max (Double/NEGATIVE_INFINITY) (map second verts))])
(defn verts-scale [verts scale]
(map (fn [[x y]] [(* scale x) (* scale y)]) verts))
(defn verts-offset [verts x-delta y-delta]
(map (fn [[x y]] [(+ x x-delta) (+ y y-delta)]) verts))
(defn svg-tag [width height content]
(let [ns "xmlns=\"\">"]
(format "<svg height=\"%f\" width=\"%f\"\n %s\n %s</svg>"
width height ns content)))
(defn verts->points-string [verts]
(->> verts
(map (fn [[x y]] (format "%f,%f" (double x) (double y))))
(clojure.string/join " ")))
(defn verts->svg [verts style]
(let [[width height] (verts-max-pt verts)
[min-x min-y] (verts-min-pt verts)
width (double (+ width min-x))
height (double (+ height min-y))]
(svg-tag width height
(format "<polyline\n points=\"%s\"\n style=\"%s\" />\n"
(verts->points-string verts) style))))
(defn open-in-browser [s prefix suffix]
(let [f ( prefix suffix)
path (.getCanonicalPath f)]
(.deleteOnExit f)
(spit f s)
(printf "Opening \"%s\" in Safari" path)
( "open" "-b" "" path)))
(defn open-in-app [s prefix suffix]
(let [f ( prefix suffix)
path (.getCanonicalPath f)]
(.deleteOnExit f)
(spit f s)
(printf "Opening \"%s\" in default app" path)
( "open" path)))
(-> (produce-steps hilbert-rules '(:L) 7)
(verts-scale 4.0)
(verts-offset 5 5)
(verts->svg "fill:none; stroke: black; stroke-width: 0.5;")
(open-in-app "hilbert" ".svg"))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.