Evolving Cellular Automata - The Code

My last post about automata was light on code, mostly because I got tired and lost some time doing the simulations inside the post in a way that worked in Firefox and Chrome.

This was as a warmup exercise for Lisp In Summer Projects, if you like Lisp - get involved!

Just after starting on it I noticed David Nolen had ported a demo of Minecraft in Javascript by @notch to clojurescript, keeping it fast using a few macros and sticking to using straight-up JS datatypes while staying as functional as possible, check it out. Particularly impressive is the output code being ~400 lines due to the Google Closure compiler.

You may want to read up on Genetic Algorithms in general first, but in short you

  • find a way to encode a particular solution to the problem as a genome
  • start with an initial population of random genomes
  • work out their ‘fitness’ (ie how well they perform some task)
  • choose the next generation by selecting and 'breeding’ them (with some mutation for novelty)
  • repeat until a good solution appears

Remember the goal is to evolve a strategy to solve the Majority Problem using a 1D cellular automata with radius 3. I opted to have the main population on the server, do the selection and breeding there but have the fitness simulations (hopefully most of the computation needed) in browsers. This meant I had to fudge the generations thing a bit: So no results are wasted the workers get a sample of the population and post back the fitnesses and the population grows until at some point I shrink it, using the same selection method (Fitness proportionate selection)

Go here and help it evolve if you have not already

On the server

Make the population an agent as a map of 100 random genomes

(def size 128)

(defn random-genome []
  (apply str (for [_ (range size)]
               (if (> (rand) 0.5)
                 "1"
                 "0"))))

(def population
  (agent (zipmap (repeatedly random-genome)
                 (take 100 (repeat 1)))))

We get results posted from within the web workers doing the simulations and update the population

(defn send-result [genome fitness]
  (send population assoc genome (Integer/parseInt fitness))
  (if (> (count @population) 300)
    (shrink-population 100))
  nil)

When the population is too big we shrink it using fitness proportional selection via the sample function

(defn shrink-population [n]
  (send
    population
    (fn [population]
      (let [total (reduce + (vals population))]
        (reduce (fn [acc next]
                  (assoc acc next (population next)))
                {}
                (take n (repeatedly #(sample population total))))))))

We breed 2 genomes by choosing a split point, taking the left of one genome and the right of the other, then mutating them

(defn breed [g1 g2]
  (let [split-point (Math/floor (rand 128))]
    (apply str (map mutate (concat (take split-point g1)
                                   (drop split-point g2))))))

(defn mutate [c]
  (if (< (rand) 0.001)
    (if (= c \0) \1 \0)
    c))

In order to do fitness proportional sampling, we need to workout the sum of the fitness in the population, then choose a random number less than it, then reduce along the population adding till the number is exceeded.

(defn get-sample [n]
  (let [population @population
        total (reduce + (vals population))]
    (doall (for [_ (range n)]
             (breed (sample population total)
                    (sample population total))))))

(defn take-until-sum
  ([map total] (take-until-sum map total 0))
  ([map total so-far]
     (let [current-fitness (second (first map))]
       (if (< (+ so-far current-fitness) total)
         (recur (rest map) total (+ so-far current-fitness))
         (ffirst map)))))

(defn sample [population total]
  (let [position (rand total)]
    (take-until-sum population position)))

That (plus a bit of compojure glue) is all there is!

On the client side

Drawing

I started with Davids macros, they allow for local vars and a tight for loop without pulling in any of the core sequence or datastructure code from clojurescript and should perform quickly

(defmacro forloop [[init test step] & body]
  `(loop [~@init]
     (when ~test
       ~@body
       (recur ~step))))

(defmacro local
  ([]
    `(make-array 1))
  ([x]
    `(cljs.core/array ~x)))

(defmacro >> [x v]
  `(aset ~x 0 ~v))

(defmacro << [x]
  `(aget ~x 0))

The core drawing functions look like this

(def line_colour "#cdcdcd")
(def background "#eee")
(def liveColor "#666")
(def deadColor "#eee")
(def padding 0)
(def cells 100)
(def p 0.5)

(defn fill_sq [x y colour cell_size context]
  (set! (.-fillStyle context) colour)
  (set! (.-strokeStyle context) colour)
  (.fillRect context
             (+ (* x cell_size) padding)
             (+ (* y cell_size) padding)
             cell_size
             cell_size)
  (.strokeRect context
               (+ (* x cell_size) padding)
               (+ (* y cell_size) padding)
               cell_size
               cell_size))

(defn new-canvas [width height]
  (let [canvas  (.createElement js/document "canvas")]
    (set! (.-width canvas) width)
    (set! (.-height canvas) width)
    canvas))

(defn alive [x y cell_size context]
  (fill_sq x y liveColor cell_size context))

(defn dead [x y cell_size context]
  (fill_sq x y deadColor cell_size context))

(defn draw-grid [canvas-id grid]
  (let [board (.getElementById js/document canvas-id)
        context (.getContext board "2d")
        width (.-width board)
        height (.-height board)
        temp-canvas (new-canvas width height)
        temp-context (.getContext temp-canvas "2d")
        cell_size (/ (- width (* 2 padding))
                     cells)]
    (forloop [(y 0) (< y cells) (inc y)]
             (forloop [(x 0) (< x cells) (inc x)]
                      (if (aget (aget grid y) x)
                        (alive x y cell_size temp-context)
                        (dead x y cell_size temp-context))))
    (.drawImage context temp-canvas 0 0)))

Using David’s forloop and an off-screen canvas to make it faster. A further speedup would be to draw all the alive then all the dead cells as per HTML5 Rocks - Avoid State Change

Simulations

Basic functions to setup a starting position, figure out if a sim was successful (ie if the majority were alive/dead at the start, at the end all where) and to wrap the cells (so position 101 is mapped to 0 etc)

(def cells 101)

(defn count-live [row]
  (let [count (local 0)]
    (forloop [(i 0) (< i (.-length row)) (inc i)]
             (if (aget row i)
               (>> count (inc (<< count)))))
    (<< count)))

(defn success? [grid]
  (let [l (.-length grid)
        first (aget grid 0)
        last (aget grid (dec l))
        first-count (count-live first)
        last-count (count-live last)]
    (if (< first-count (/ l 2))
      (= 0 last-count)
      (= l last-count))))

(defn random-grid [p]
  (let [result (make-array cells)]
    (forloop [(i 0) (< i cells) (inc i)]
             (aset result i (> p (rand))))
    result))

(defn normalise [n]
  (if (< n 0)
    (+ n cells)
    (rem n cells)))

A function to get a strategy (lookup table) from a genome, we use a base 2 system that is isomorphic to the Wolfram Number discussed in the last post. Hopefully you can see it gets the 7 cells in the neighbourhood then uses powers of 2 to lookup a unique element in the genome based on it.

(defn strategy-from-genome [genome]
  (fn [pos grid]
    (let [l3 (aget grid (normalise (- pos 3)))
          l2 (aget grid (normalise (- pos 2)))
          l1 (aget grid (normalise (- pos 1)))
          c  (aget grid pos)
          r1 (aget grid (normalise (+ pos 1)))
          r2 (aget grid (normalise (+ pos 2)))
          r3 (aget grid (normalise (+ pos 3)))
          idx (+ (* 64 l3)
                 (* 32 l2)
                 (* 16 l1)
                 (* 8 c)
                 (* 4 r1)
                 (* 2 r2)
                 (* 1 r3))]
      (= "1" (aget genome idx)))))

Implementing the Gács, Kurdyumov, and Levin algorithm (I eventually just hard coded it), remember the rule was

If a cell is 0, its next state is formed as the majority among the values of itself, its immediate neighbour to the left, and its neighbor three spaces to the left. If, on the other hand, a cell is 1, its next state is formed symmetrically, as the majority among the values of itself, its immediate neighbor to the right, and its neighbor three spaces to the right.

(def gkl
  (let [g (make-array 128)]
    (doseq [l3 [0 1]
            l2 [0 1]
            l1 [0 1]
            c [0 1]
            r1 [0 1]
            r2 [0 1]
            r3 [0 1]]
      (aset g
            (+ (* 64 l3)
               (* 32 l2)
               (* 16 l1)
               (* 8 c)
               (* 4 r1)
               (* 2 r2)
               (* 1 r3))

            (if (= c 1)
              (>= (+ c r1 r3) 2)
              (>= (+ c l1 l3) 2)
              )))
    g))

(def gkl "00000000010111110000000001011111000000000101111100000000010111110000000001011111111111110101111100000000010111111111111101011111")

For the run-sim function I again use JS arrays and Davids forloop

(defn run-sim
  ([strategy]
     (run-sim strategy (rand)))
  ([strategy p]
     (let [result (make-array cells)
           init (random-grid p)
           ]
       (aset result 0 init)
       (forloop [(i 1) (< i cells) (inc i)]
                (aset result i (step (aget result (dec i)) strategy)))
       result)))

(defn step [grid alive?]
  (let [next (make-array cells)]
    (forloop [(x 0) (< x cells) (inc x)]
             (if (alive? x grid)
               (aset next x true)
               (aset next x false)))
    next))

(defn fitness [genome]
  (let [strategy (strategy-from-genome genome)]
    (count (filter success? (take 100 (repeatedly #(run-sim strategy)))))))

I didnt use the forloop for the fitness function as it ran 100x as fast as one sim so I did not think it worth trying to optimise. If I wanted to just use for loops I would just write JS.

I fixated a little while trying to make the worker code as small as David’s Minecraft but in the end decided against it. Here is the worker code.

(defn log [message]
  (js/postMessage message))

(log "Inside worker")

(defn process-sample [sample]
  (doseq [genome sample]
    (let [fitness (sim/fitness genome)]
      (POST (+ "/results/" "/" genome "/" fitness) "")))
  (js/setTimeout run 0))

(defn run []
  (GET "/sample" (fn [sample]
                   (let [response (.parse js/JSON sample)
                         sample (.-sample response)
                         ]
                     (process-sample sample)
                     ))))

(run)

And finally a few helper fns

(defn GET [url callback]
  (let [request-obj (js/XMLHttpRequest.)]
    (.open request-obj "GET" url true)

    (set! (.-onreadystatechange request-obj)
          (fn []
            (if (and (= (.-readyState request-obj) 4)
                     (= (.-status request-obj) 200))
              (callback (.-responseText request-obj)))))
    (.send request-obj)
    ))

(defn POST [url data]
  (let [request-obj (js/XMLHttpRequest.)]
    (.open request-obj "POST" url true)
    (.send request-obj data)
    ))

(defn  now []
  (.getTime (js/Date.)))

(defn puts [& message]
  (.log js/console (string/join " " message)))

(defn log [object]
  (.log js/console object))

GET and POST do what you would expect. I’m tempted to neaten it up and wrap it as a lib with implementations for the browser and Node.js as this is one thing that stopped me being able to immediately compile a CLI version. I probably should have used Google Closure for the AJAX calls but figured old browsers are too slow and would not have web workers anyhow.

Code is at github, let me know anything you need me to clarify or correct.