Skip to content

Instantly share code, notes, and snippets.

@rm-hull
Last active August 29, 2015 14:06
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save rm-hull/b64358129b5aaa8627c0 to your computer and use it in GitHub Desktop.
Save rm-hull/b64358129b5aaa8627c0 to your computer and use it in GitHub Desktop.
If you draw a pentagon, then plot the midpoints of each of its five sides and extend a line perpendicular to each of these points, you can connect the end of these lines to make another pentagon. In doing this, the remaining area of the shape also ends up being subdivided into further pentagons, meaning that within each pentagon are six subpenta…
(ns big-bang.examples.sutcliffe-pentagon
(:require
[jayq.core :refer [show]]
[cljs.core.async :as async]
[dommy.core :refer [insert-after!]]
[big-bang.core :refer [big-bang]]
[big-bang.components :refer [slider]]
[enchilada :refer [ctx canvas value-of]]
[monet.canvas :refer [begin-path move-to line-to close-path
clear-rect fill fill-style circle
stroke-join stroke-width stroke-style stroke
translate rotate save restore]])
(:require-macros
[dommy.macros :refer [sel1 node]]))
(defn box [content]
[:span {:style "width: 250px;
display: inline-block;
border: 1px solid lightgrey;
margin-right: 5px;
margin-bottom: 5px;
padding-left: 5px;
border-radius: 3px;
background: whitesmoke;"} content])
(defn radians [degrees]
(/ (* (double degrees) Math/PI) 180.0))
(defn average [m n]
(/ (+ m n) 2))
(defn calc-mid-points [ops]
(let [n (count ops)
midpoint (fn [[ax ay] [bx by]] [(average ax bx) (average ay by)])]
(vec
(for [i (range n)]
(midpoint
(nth ops i)
(nth ops (mod (inc i) n)))))))
(defn calc-proj-point [strut-factor]
(fn [[mpx mpy] [opx opy]]
[ (+ mpx (* (- opx mpx) strut-factor))
(+ mpy (* (- opy mpy) strut-factor))]))
(defn calc-strut-points [projection-fn sides mps ops]
(let [n (count mps)]
(vec
(for [i (range n)]
(projection-fn
(nth mps i)
(nth ops (mod (+ i sides -2) n)))))))
(defn branch [projection-fn level sides ops]
(let [mps (calc-mid-points ops)
pps (calc-strut-points projection-fn sides mps ops)
ret {:outer-points ops :level level}
n (count ops)]
(if (zero? level)
ret
(assoc
ret
:branches
(cons
(branch projection-fn (dec level) sides pps)
(for [k (range n)
:let [next-k (mod (+ k (dec sides)) n)
new-points [(nth ops k) (nth mps k) (nth pps k) (nth pps next-k) (nth mps next-k)]]]
(branch projection-fn (dec level) sides new-points)))))))
(defn root [size strut-factor max-level sides angle]
(let [pt (fn [f i] (* size (f (radians i))))
step (/ (double angle) (double sides))
ops (mapv #(vector (pt Math/cos %) (pt Math/sin %)) (range 0 360 step))
pfn (calc-proj-point strut-factor)]
(branch pfn max-level sides ops)))
(defn draw [ctx {:keys [level outer-points branches]}]
(->
ctx
(begin-path)
(stroke-width level)
(move-to (ffirst outer-points) (fnext outer-points)))
(doseq [[x y] outer-points]
(line-to ctx x y))
(->
ctx
(close-path)
(stroke)
(fill))
(doseq [b branches]
(draw ctx b))
ctx)
(defn initial-state [angle sides strut max-level radius]
{ :strut strut
:sides sides
:angle angle
:max-level max-level
:radius radius})
(defn handle-incoming [event world-state]
(merge world-state event))
(defn render [{:keys [angle sides strut max-level radius] :as world-state}]
(let [sutcliffe-pentagon (root radius strut max-level sides angle)]
(->
ctx
(clear-rect {:x 0 :y 0 :w 800 :h 600})
(save)
(translate 400 300)
(fill-style "rgba(229,125,141,0.2)")
(stroke-style :black)
(stroke-join :miter)
(draw sutcliffe-pentagon)
(restore))))
(let [chan (async/chan)
initial-state (initial-state
(js/parseInt (value-of :angle 360.0))
(js/parseInt (value-of :sides 5))
(js/parseFloat (value-of :strut 0.271))
(js/parseInt (value-of :levels 4))
(js/parseInt (value-of :radius 280)))]
(show canvas)
(->>
(sel1 :#canvas-area)
(insert-after!
(node
[:div
(box (slider
:id :sides
:label-text "Sides:"
:min-value 3
:max-value 16
:initial-value (initial-state :sides)
:send-channel chan))
(box (slider
:id :angle
:label-text "Angle:"
:min-value 1
:max-value 1024
:initial-value (initial-state :angle)
:send-channel chan))
(box (slider
:id :strut
:label-text "Strut:"
:min-value -2.0
:max-value 1.0
:step 0.01
:initial-value (initial-state :strut)
:send-channel chan))])))
(big-bang
:initial-state initial-state
:on-receive handle-incoming
:receive-channel chan
:to-draw render))

Matt Peason, author of Generative Art say in his book (ch.8):

In 2008 I went to a meeting of the Computer Arts Society (CAS) in London, an organization that was (remarkably, for a body devoted to computing) celebrating its fortieth anniversary with that event. There, I heard a short talk by the society’s initiator and first chairman, the artist and mathematician Alan Sutcliffe. Through this talk, he introduced me to a marvellous shape, which I have since mentally dubbed the Sutcliffe Pentagon.

To be clear, I’ve spoken to Alan about this, and he isn’t entirely over the moon with me using this name. He has been insistent that, even though he thought it up, he doesn’t believe the shape was his invention. He cites Kenneth Stephenson’s work on circle packing as preceding him, in which Stephenson himself credits earlier work by Floyd, Cannon, and Parry. But I have since reviewed this trail of influence, and, although Sutcliffe’s predecessors do describe a dissected pentagon, none of them take the idea half as far as he did. And even if they had, it wouldn’t change the way the Sutcliffe Pentagon was burned into my brain that particular evening.

Buy the book, it is excellent.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment