Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Cellular automata - randomly picks one of: Conways Life, Semi-vote, Vichniac vote (stable & unstable) or Fredkin. Renders using _big-bang_ onto a canvas element, but could probably be written more efficiently using _core.async_ more intelligently.
(ns cellular-automata.core
(:require-macros
[cljs.core.async.macros :refer [go]]
[dommy.macros :refer [sel1 node]])
(:require
[cljs.core.async :refer [chan <! >!]]
[dommy.core :refer [insert-after!]]
[jayq.core :refer [$ hide show]]
[big-bang.core :refer [big-bang]]
[big-bang.components :refer [dropdown slider]]
[enchilada :refer [ctx canvas canvas-size]]
[cellular-automata.engine :as ca]
[monet.canvas :refer [fill-style fill-rect alpha
begin-path line-to move-to close-path fill]]))
(def colors ["red" "green" "blue" "yellow" "purple" "orange"])
(def cell-size 10)
(def block-size (dec cell-size))
(def width (/ (first (canvas-size)) cell-size))
(def height (/ (second (canvas-size)) cell-size))
(def blank {:x 0 :y 0 :w (* width cell-size) :h (* height cell-size)})
(def players {
"Conway's game-of-life" ca/conways-game-of-life
"Semi-vote" ca/semi-vote
"Fredkin" ca/fredkin
; "Circle" ca/circle
"Vichniac Vote" ca/vichniac-vote
"Vichniac Vote (unstable)" ca/unstable-vichniac-vote})
(defn trim [[x y]]
(and
(>= x 0)
(>= y 0)
(< x width)
(< y height)))
(defn random-world [probability]
(set
(for [x (range width)
y (range height)
:when (< (rand) probability)]
[x y])))
(def seven-bar
(set (map #(vector % 0) (range 7))))
(def initial-state {
:color (rand-nth colors)
:player (rand-nth (keys players))
:probability 0.5
:reset? true
:cells #{}})
(defn draw-cells [ctx cells]
(doseq [[x y] cells
:let [x (* x cell-size)
y (* y cell-size)]]
(->
ctx
(move-to x y)
(line-to x (+ y block-size))
(line-to (+ x block-size) (+ y block-size))
(line-to (+ x block-size) y)))
ctx)
(defn render [{:keys [color cells] :as world-state}]
(->
ctx
(fill-style "white")
(alpha 0.5)
(fill-rect blank)
(fill-style color)
(alpha 1.0)
(begin-path)
(draw-cells cells)
(fill)
(close-path)))
(defn reset-world [world-state]
(if (:reset? world-state)
(->
world-state
(assoc :cells (random-world (:probability world-state)))
(dissoc :reset?))
world-state))
(defn update-state [event world-state]
(let [player (partial (players (:player world-state)) trim)]
(->
world-state
(update-in [:cells] player)
(reset-world))))
(defn handle-incoming-msg [event world-state]
(->
world-state
(merge event)
(reset-world)))
(defn to-keyword> [key dest-chan]
(let [src-chan (chan 1)]
(go
(loop []
(when-let [msg (<! src-chan)]
(>! dest-chan (update-in msg [key] str))
(recur))))
src-chan))
(defn reset-world> [dest-chan]
(let [src-chan (chan 1)]
(go
(loop []
(when-let [msg (<! src-chan)]
(>! dest-chan (assoc msg :reset? true))
(recur))))
src-chan))
(defn start []
(let [updates-chan (chan 1)]
(go
(->>
(sel1 :#canvas-area)
(insert-after! (node
[:div
(dropdown
:id :color
:label-text " Color: "
:initial-value (:color initial-state)
:options (zipmap colors colors)
:send-channel (to-keyword> :color updates-chan))
(dropdown
:id :player
:label-text " Type: "
:initial-value (:player initial-state)
:options (zipmap (keys players) (keys players))
:send-channel (reset-world> (to-keyword> :player updates-chan)))
(slider
:id :probability
:label-text " Population probability: "
:initial-value (:probability initial-state)
:min-value 0.0
:max-value 1.0
:step 0.01
:send-channel (reset-world> updates-chan))]))))
(big-bang
:initial-state initial-state
:on-tick update-state
:on-receive handle-incoming-msg
:receive-channel updates-chan
:to-draw render)))
(show canvas)
(start)
(ns cellular-automata.engine)
(def neighbours
(for [i [-1 0 1]
j [-1 0 1]
:when (not= 0 i j)]
[i j]))
(def nine-block
(for [i [-1 0 1]
j [-1 0 1]]
[i j]))
(defn transform
"Transforms a point [x y] by a given offset [dx dy]"
[[x y] [dx dy]]
[(+ x dx) (+ y dy)])
(defn place [artefact position]
(mapv (partial transform position) artefact))
(defn stepper [neighbours birth? survive?]
(fn [trim-fn cells]
(set (for [[loc n] (frequencies (mapcat neighbours cells))
:when (and
(if (cells loc) (survive? n) (birth? n))
(trim-fn loc))]
loc))))
(def conways-game-of-life
(stepper #(place neighbours %) #{3} #{2 3}))
(def semi-vote
(stepper #(place neighbours %) #{3 5 6 7 8} #{4 6 7 8}))
(def vichniac-vote
(stepper #(place nine-block %) #{5 6 7 8 9} #{5 6 7 8 9}))
(def unstable-vichniac-vote
(stepper #(place nine-block %) #{4 6 7 8 9} #{4 6 7 8 9}))
(def fredkin
(stepper #(place nine-block %) #{1 3 5 7 9} #{1 3 5 7 9}))
(def circle
(stepper #(place neighbours %) #{3} #{1 2 4}))
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.