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/05e64fa45aea27755240 to your computer and use it in GitHub Desktop.
Save rm-hull/05e64fa45aea27755240 to your computer and use it in GitHub Desktop.
First studied by Edward Lorenz in 1963, the Lorenz attractor is a system of ordinary differential equations, which for certain parameter values and initial conditions, exhibits chaotic behaviour.
(ns big-bang.examples.lorenz-attractor
(:require
[cljs.core.async :as async]
[dommy.core :refer [insert-after!]]
[enchilada :refer [ctx canvas canvas-size value-of]]
[jayq.core :refer [show]]
[monet.canvas :refer [fill-style fill-rect circle translate
stroke-width stroke-cap stroke-style stroke
move-to line-to begin-path]]
[big-bang.core :refer [big-bang]]
[big-bang.components :refer [slider]]
[inkspot.color-chart :as cc])
(:require-macros
[dommy.macros :refer [sel1 node]]))
(def dimensions
(let [[width height] (canvas-size)]
{:x (quot width -2) :y 0 :w width :h (- height)}))
(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 lorenz-system [σ ρ β dt]
(letfn [(seq0 [x y z]
(lazy-seq
(cons
[x y z]
(let [dx (* σ (- y x))
dy (- (* x (- ρ z)) y)
dz (- (* x y) (* β z))]
(seq0
(+ x (* dx dt))
(+ y (* dy dt))
(+ z (* dz dt)))))))]
seq0))
(defn init-system [{:keys [start-posn sigma rho beta dt] :as world-state}]
(let [system (lorenz-system sigma rho beta dt)]
(assoc world-state :values (apply system start-posn))))
(def initial-state
(init-system
{:t 0
:dt 0.005
:ctx ctx
:color-chart (vec (take 200 (rand-nth
[(cc/spectrum 200)
(cc/cube-helix 240)
(cc/heatmap 240)])))
:persistence 98
:scale 12
:clear? false
:start-posn (repeatedly 3 #(rand 10))
:projection [] ; TODO
:sigma (value-of :sigma 10)
:rho (value-of :rho 28)
:beta (value-of :beta (double (/ 8 3)))}))
(defn incoming [event world-state]
(init-system (merge world-state event {:clear? true})))
(defn tock [event world-state]
(->
world-state
(update-in [:t] inc)
(update-in [:values] next)
(assoc :clear? false)))
(defn draw-point! [ctx t scale [xa ya za] [xb yb zb] projection color-chart]
(->
ctx
(begin-path)
(stroke-style (nth color-chart (mod (/ t 100) 200)))
(move-to (* scale xa) (* scale za -1))
(line-to (* scale xb) (* scale zb -1))
(stroke)))
(defn render [{:keys [clear? values ctx scale t projection persistence color-chart] :as world-state}]
(let [color (if clear?
:white
(str "rgba(255,255,255," (double (/ (- 100 persistence) 100)) ")"))]
(->
ctx
(stroke-width 2)
(stroke-cap :round)
(fill-style color)
(fill-rect dimensions)
(draw-point! t scale (first values) (second values) projection color-chart))))
(let [chan (async/chan)]
(show canvas)
(translate ctx (quot (dimensions :w) 2) (- (dimensions :h)))
(->>
(sel1 :#canvas-area)
(insert-after! (node
[:div
[:div
(box (slider
:id :persistence
:label-text "Persistence:"
:min-value 0
:max-value 100
:initial-value (initial-state :persistence)
:send-channel chan))]
[:div
(box (slider
:id :sigma
:label-text "σ"
:min-value 1
:max-value 30
:step 1
:initial-value (initial-state :sigma)
:send-channel chan))
(box (slider
:id :rho
:label-text "ρ"
:min-value 1
:max-value 30
:initial-value (initial-state :rho)
:send-channel chan))
(box (slider
:id :beta
:label-text "β"
:min-value 1
:max-value 30
:step 0.02
:initial-value (initial-state :beta)
:send-channel chan))]])))
(big-bang
:initial-state initial-state
:receive-channel chan
:on-receive incoming
:on-tick tock
:to-draw render))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment