Last active
August 29, 2015 14:06
-
-
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.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(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