Lorenz Attractor

(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))