dependencies

org.clojure/clojure

1.4.0

(this space intentionally left almost blank)

namespaces

automata

automata

(ns automata
  (:require [clojure.browser.repl :as repl]
            [goog.dom :as dom]
            [goog.dom.classes :as cls]
            [goog.events :as ev]))

(repl/connect "http://localhost:9000/repl")

The width and height of the canvas.

TODO retreive canvas size from the document

The size of each cell in pixels.

The size of the gap between cells, in pixels.

The gap between the start of one cell, and the start of the next.

(def CANVAS-SIZE  300)
(def CELL-SIZE  5)
(def CELL-GAP  1)
(def CELL-INTERVAL  (+ CELL-SIZE CELL-GAP))

The number of cells in a column on the canvas.

The number of cells on the left hand side of a row on the canvas.

(def V-CELLS  (int (/ CANVAS-SIZE 6)))
(def LHS-CELLS  (int (/ CANVAS-SIZE 12)))
(def RHS-CELLS  (inc LHS-CELLS))

The graphics element from the canvas.

(def CANVAS 
  (-> (dom/getElement "canvas")
      (.getContext "2d")))

A vector of possible inputs for the evolution of a cell.

(def ALL-INPUTS 
  [[1 1 1] [1 1 0] [1 0 1] [1 0 0] [0 1 1] [0 1 0] [0 0 1] [0 0 0]])

Creates a rule number from the given set of binary inputs.

(defn decode-rule
  [live-or-dead]
  (js/parseInt (apply str live-or-dead) 2))

Given a rule number, creates a sequence of live or dead values for the next generation of cells.

(defn encode-rule
  [rule]
  (map #(bit-and rule %) [128 64 32 16 8 4 2 1]))

Sets the color of the canvas

(defn black 
  []
  (set! (.-fillStyle CANVAS) "rgb(0,0,0)"))

Clears the entire canvas.

(defn clear-canvas
  []
  (.clearRect CANVAS 0 0 CANVAS-SIZE CANVAS-SIZE))

When fill is true, draws a single cell on the canvas, otherwise leaves it blank. The input coordinates are given in terms of cells, and converted here into pixel coordinates.

(defn draw-cell
  [[x y] fill]
  (when fill
    (let [xpos (+ (- (/ CANVAS-SIZE 2) CELL-INTERVAL) (* CELL-INTERVAL x))
          ypos (* CELL-INTERVAL y)]
      (.fillRect CANVAS xpos ypos CELL-SIZE CELL-SIZE))))

A row in the automata is represented by a vector of two infinite sequences. The first sequence is the cells from the center out to the left, and the second is the cells from the center out to the right. A 0 indicates a non-live (white) cell, and a 1 indicates a live (black cell).

Returns a row with one cell live in the center.

(defn middle-cell
  []
  [(repeat 0) (lazy-seq (cons 1 (repeat 0)))])

Returns a row with no cells live.

(defn white-row
  []
  [(repeat 0) (repeat 0)])

Returns a row with all cells live.

(defn black-row
  []
  [(repeat 1) (repeat 1)])

Returns a random row.

(defn rand-row
  []
  [(repeatedly #(rand-nth [0 1])) (repeatedly #(rand-nth [0 1]))])

Takes a rule and three input cells, and produces the value for the outptut cell. A rule is represented by a map from all possible inputs to the output.

(defn evolve-cell
  [rule input]
  (rule input))

Computes one evolution of the left hand side of the automata.

(defn evolve-lhs
  [rule lhs rhs]
  (map (comp (partial evolve-cell rule) reverse) (partition 3 1 (cons (first rhs) lhs))))

Computes one evolution of the right hand side of the automata.

(defn evolve-rhs
  [rule lhs rhs]
  (map (partial evolve-cell rule) (partition 3 1 (cons (first lhs) rhs))))

Computes one evolution of the automata.

(defn evolve-seq
  [rule [lhs rhs]]
  [(evolve-lhs rule lhs rhs)
   (evolve-rhs rule lhs rhs)])

Returns the cell x-coordinates for a finite sequence of cells on the left hand side of the automata.

(defn xcoords-lhs
  [cells]
  (let [end (- (inc (count cells)))]
    (range -1 end -1)))

Returns the cell x-coordinates for a finite sequence of cells on the right hand side of the automata.

(defn xcoords-rhs
  [cells]
  (range 0 (count cells)))

Given a row number, and a finite sequence of cells, draws the cells on one half of the automata. Also requires a function to produce the cell x-coordinates.

(defn draw-half
  [row half coord-fn]
  (doseq [cell (map (fn [x c] [[x row] (= 1 c)]) (coord-fn half) half)]
    (apply draw-cell cell)))

Given a row number, and a finite sequence of cells, draws the cells on the left hand side of the automata.

(defn draw-lhs
  [row lhs]
  (draw-half row lhs xcoords-lhs))

Given a row number, and a finite sequence of cells, draws the cells on the right hand side of the automata.

(defn draw-rhs
  [row rhs]
  (draw-half row rhs xcoords-rhs))

Draws the given row on the canvas, where a row is represented by two (possibly infinite) sequences of cells.

(defn draw-sequence
  [row [lhs rhs]]
  (draw-lhs row (take LHS-CELLS lhs))
  (draw-rhs row (take RHS-CELLS rhs)))

Draws multiple rows of the automata starting with the given start row, evolving using the given rule.

(defn draw-automata
  [rule row-zero]
  (doseq [[r s] (map vector
                     (range)
                     (take V-CELLS (iterate (partial evolve-seq rule) row-zero)))]
    (draw-sequence r s)))

Holds the current starting row, set whenever the user selects a new row type.

(def start-row
  (atom (middle-cell)))

(defn swap-alive-dead
  [cb dead]
  (apply cls/addRemove cb (if dead ["alive" "dead"] ["dead" "alive"])))

Gets all the dom elements for the checkboxes on the page.

(defn get-checks
  []
  (map #(dom/getElement (str "cb-" %)) (range 0 8)))

Called when the user enters a rule number. Parses the number into the correct configuration of check boxes to represent the rule.

(defn set-checks-values
  [rule]
  (doseq [[c cb] (map vector (encode-rule rule) (get-checks))]
    (swap-alive-dead cb (= 0 c))))

Returns 1 if the element is checked, 0 otherwise.

(defn check-to-bit
  [check]
  (if (cls/has check "alive") 1 0))

Returns a rule number decoded from the current state of the input elements on the page.

(defn checks-value
  []
  (decode-rule (map check-to-bit (get-checks))))

Returns a rule represented as a map from inputs to outputs.

(defn checks-to-rule
  [checks]
  (zipmap ALL-INPUTS (map check-to-bit checks)))

Called when the user presses the draw button. Draws the automata on the canvas.

(defn draw-onclick
  []
  (clear-canvas)
  (draw-automata (checks-to-rule (get-checks)) @start-row))

Called when the user presses one of the output cells on the rule specifier.

(defn check-onclick
  [cell rule-no]
  (swap-alive-dead cell (cls/has cell "alive"))
  (set! (.-value rule-no) (checks-value)))

A map from the names of the row types (as entered by the user) to the actual row type functions.

(def row-types
  {"middle-cell" middle-cell
   "white-row" white-row
   "black-row" black-row
   "rand-row" rand-row})

Returns a row based on the given row type string. Returns an all white row if the row type is unrecognised

(defn get-row
  [row-type]
  (if (row-types row-type)
    ((row-types row-type))
    (white-row)))

Clears the canvas and draws the first row.

(defn draw-first-row
  []
  (clear-canvas)
  (black)
  (draw-sequence 0 @start-row))

Set all the event handlers for the controls on the page.
rule-no is a text field where the user can enter a rule number.
draw is a button which draws the automata on the canvas.
start is a select box where the user can choose the type of start row.
cb<1-8> are checks for picking the output for individual inputs.

(let [rule-no (dom/getElement "rule-no")
      draw (dom/getElement "draw")
      start (dom/getElement "start")]
  
  (doseq [i (range 0 8)]
    (let [check (dom/getElement (str "cb-" i))]
      (ev/listen check
                 ev/EventType.CLICK
                 #(check-onclick check rule-no))))

  (ev/listen draw ev/EventType.CLICK draw-onclick)

  (ev/listen rule-no
             ev/EventType.KEYUP
             #(set-checks-values (js/parseInt (.-value rule-no))))

  (ev/listen start
             ev/EventType.CHANGE
             #(let [new-start-row (get-row (.-value start))]
                (reset! start-row new-start-row)
                (draw-first-row))))

(defn draw-rules [start]
  (when (> start -1)
    (.clearRect CANVAS 0 0 CANVAS-SIZE CANVAS-SIZE)
    (set-checks-values start)
    (draw-automata start (rand-row))
    (js/setTimeout #(draw-rules (dec start)) 3000)))

Andrew's Automata

1.0-SNAPSHOT

dependencies

namespaces

automata