Skip to content

Instantly share code, notes, and snippets.

@ericnormand
Last active May 13, 2019 16:08
Show Gist options
  • Save ericnormand/3a8bb291e0d3d5393ade01448239bc90 to your computer and use it in GitHub Desktop.
Save ericnormand/3a8bb291e0d3d5393ade01448239bc90 to your computer and use it in GitHub Desktop.

Conway's Game of Life

Conway's Game of Life is a famous cellular automaton. The rules are simple:

Cells are arranged in a square grid. A cell is either alive (black) or dead (white). Cells have eight neighbors that surround it. A dead cell comes to life if it has exactly three live neighbors. A live cell dies if it has four or more neighbors. A live cell dies if it has one or zero neighbors. All other cells continue as they are. Build this automaton.

Bonus points for allowing an infinite board.

(ns game-of-life.core
(:require [quil.core :as q]))
(defn get-neighbour-pos
"Cells have eight neighbours that surround it.
This function delivers their position."
[pos]
(map #(mapv + pos %) [[-1 0] [-1 1] [0 1] [1 1] [1 0] [1 -1] [0 -1] [-1 -1]]))
(defn get-alive-neighbours
"Delivers the alive neighbour positions on the board around pos."
[board pos]
(->>
(map #(get board %) (get-neighbour-pos pos))
(filter #(= ::alive %))))
(defn come-to-life-or-die
"Determines if the cell at position pos comes to life, dies
or remains."
[board pos]
(let [cell (get board pos ::dead)
alive-neighbours (count (get-alive-neighbours board pos))]
(cond
;; A dead cell comes to life if it has exactly three live neighbours
(and (= ::dead cell) (= 3 alive-neighbours)) ::alive
;; A live cell dies if it has four or more neighbours
(and (= ::alive cell) (>= alive-neighbours 4)) ::dead
;; A live cell dies if it has one or zero neighbours
(and (= ::alive cell) (<= alive-neighbours 1)) ::dead
;; All other cells continue as they are
:else cell)))
(defn get-all-relevant-positions
"Get all positions that may be affected by alive cells.
This includes the neighbour cells of alive cells."
[board]
(let [alive-positions (keys (filter #(= ::alive (second %)) board))
alive-positions-and-neighbour-positions (set (mapcat get-neighbour-pos alive-positions))]
alive-positions-and-neighbour-positions))
(defn game-of-life
"Cells are arranged using a map with the position as key
A cell is either alive or dead - if a position on the board is set to ::alive it is alive
dead otherwise"
[start-board iterations]
(let [board start-board]
(loop [board board i iterations boards []]
(if (<= i 0)
boards
(recur
(reduce (fn [new-board pos]
(assoc new-board pos (come-to-life-or-die board pos)))
{}
(get-all-relevant-positions board))
(dec i)
(conj boards board))))))
(defn parse-board
"Parses a board in string representation into a map
with the position as key.
Example-Board in String representation:
***
* *
* *
* *
***"
[s]
(when (seq s)
(let [lines (clojure.string/split s #"\n")
alive-or-dead-rows (map
(fn [line]
(map (fn [p] (if (= \* p)
::alive
::dead))
(seq line)))
lines)]
(loop [y 0 rows alive-or-dead-rows board {}]
(if (seq rows)
(recur
(inc y)
(rest rows)
(reduce (fn [m [x state]]
(if (= ::alive state)
(assoc m (vector x y) state)
m))
board
(map (fn [x state] (vector x state)) (range) (first rows))))
board)))))
(comment
;; This board dies after 54 iterations
(def p1 "
***
* *
* *
* *
* *
***")
(def glider "
*
* *
**")
(def small-exploder "
*
***
* *
*")
(def exploder "
* * *
* *
* *
* *
* * *")
(get-neighbour-pos [0 0])
(get-neighbour-pos [1 1])
(come-to-life-or-die {[-1 0] ::alive [-1 1] ::alive [0 1] ::alive} [0 0])
(come-to-life-or-die {[0 0] ::alive [-1 0] ::alive [-1 1] ::alive [0 1] ::alive} [0 0])
(come-to-life-or-die {[0 0] ::alive [-1 0] ::alive} [0 0])
(come-to-life-or-die {[0 0] ::alive [-1 0] ::alive [-1 1] ::alive [0 1] ::alive [1 1] ::alive} [0 0])
(parse-board p1)
(get-all-relevant-positions (parse-board p1))
(game-of-life {} 10)
(game-of-life (parse-board p1) 54)
)
;; Visualize it with Quil
(def exploder "
* * *
* *
* *
* *
* * *")
(def boards (cycle (game-of-life (parse-board exploder) 54)))
(def block 10)
(def colors {::background [255 255 255]
::dead [255 255 255]
::alive [0 0 0]})
(defn draw []
(q/with-translation [(/ (q/width) 2.5) (/ (q/height) 2.5)]
; note that we don't use draw-plot here as we need
; to draw only small part of a plot on each iteration
(let [t (q/frame-count)]
(q/background 255)
(doseq [[[x y] high] (->> boards (drop t) first)]
(when (= high ::alive)
(apply q/fill (colors high))
(apply q/stroke (colors ::dead))
(q/rect (* block x) (* block y) block block))))))
(defn setup []
(q/frame-rate 5))
(q/defsketch game-of-life-board
:size [600 600]
:setup setup
:draw draw)
(ns automata.automata)
(defn get-adjacent-cells [[x y]]
(for [dx '(-1 0 1) dy '(-1 0 1) :when (or (not= dx 0) (not= dy 0))]
[(+ x dx) (+ y dy)]))
(defn live-area-cells [cells]
"Figure out hot cells around live cells"
(let [lc (transient #{})]
(doseq [i cells]
(do (doseq [c (get-adjacent-cells i)]
(conj! lc c))
(conj! lc i)))
(persistent! lc)))
(defn next-gen [cells]
"Create next generation. Only consider cells around live cells."
(let [lac (live-area-cells cells)
ng (transient #{})]
(doseq [cell lac]
(let [live-count (->> (get-adjacent-cells cell)
(filter cells)
(count))]
(if (cells cell)
;;Cell is already alive
(when-not (or (> live-count 3) (< live-count 2))
(conj! ng cell))
(when (= live-count 3)
(conj! ng cell)))))
(persistent! ng)))
(def r-pentomino #{[0 0] [1 0] [0 1] [-1 1] [0 2]})
(def diehard #{[1 2] [2 2] [2 3] [6 3] [7 1] [7 3] [8 3]})
(def acorn #{[1 3] [2 1] [2 3] [4 2] [5 3] [6 3] [7 3]})
;; (nth (iterate next-gen r-pentomino) 50)
;; For complete file (with animation on HTML canvas), see here: https://github.com/nakiya/cellular-automata/blob/master/src/cljs/automata/automata.cljs
(defn neighbors [[x y]]
(for [dx [-1 0 1]
dy [-1 0 1]
:when (not (= 0 dx dy))]
[(+ x dx) (+ y dy)]))
(defn step [lives]
(set (for [[pos live-neighbors] (frequencies (mapcat neighbors lives))
:when (or (= 3 live-neighbors) (and (contains? lives pos)
(= 2 live-neighbors)))]
pos)))
;; Thanks to cgrand: http://clj-me.cgrand.net/2011/08/19/conways-game-of-life/
(defn genboard
"initial board of size x y, all dead/:w"
[x y]
(zipmap (for [xi (range 0 x) yi (range 0 y)] [xi yi])
(repeat :w)))
(defn livingneighborsof
"number of living neighbors of point pt on board board"
[board pt]
(let [delts (remove #{[0 0]}
(for [dx (range -1 2) dy (range -1 2)] [dx dy]))
+p (fn [[x1 y1] [x2 y2]] [(+ x1 x2) (+ y1 y2)])
neighbors (map (partial +p pt) delts)]
(count (filter #{:b} (map (partial get board) neighbors)))))
(defn fate
"Return next generation value for a point on a board.
Note: Ignores cells off the board."
[board pt]
(let [cv (get board pt)
ln (livingneighborsof board pt)]
(if (= cv :w) ; if cell is white/dead
(if (= ln 3) :b :w) ; if 3 neighbors cell lives else no change
(cond ; else cell is black/alive
(>= ln 4) :w ; dies with >= 4 living neighbors
(<= 0 ln 1) :w ; dies with 0 or 1 living neighbors
:else cv)))) ; no change
(defn step
"compute the next generation for board brd"
[brd]
(zipmap (keys brd)
(map (partial fate brd) (keys brd))))
;; create a board (10x10) and add inital live cells
(def ib (assoc (genboard 10 10) [2 3] :b [1 3] :b [2 2] :b [3 2] :b))
;; get e.g. the 20th generation
(nth (iterate step ib) 20)
(defn toggle
"Adds an element if it is not contained in the set;
removes the element if it is in the set."
[set element]
(if (contains? set element)
(disj set element)
(conj set element)))
(defn square [[x y]]
(let [x+1 (inc x)
x-1 (dec x)
y+1 (inc y)
y-1 (dec y)]
[[x y][x y+1][x y-1][x+1 y][x+1 y+1][x+1 y-1][x-1 y][x-1 y+1][x-1 y-1]]))
(defn neighbors [[x y]]
(let [x+1 (inc x)
x-1 (dec x)
y+1 (inc y)
y-1 (dec y)]
#{[x y+1][x y-1][x+1 y][x+1 y+1][x+1 y-1][x-1 y][x-1 y+1][x-1 y-1]})) ; Returns a set of a cell's neighbors
(defn live-cell?
"Returns the cell if it survives or becomes alive, else nil"
[live-cells candidate]
(let [cell-alive (live-cells candidate)
live-neighbors (count (t/intersection live-cells
(neighbors candidate)))]
(when (or (= live-neighbors 3)
(and cell-alive
(= live-neighbors 2)))
candidate)))
(defn next-generation [this-generation]
(->> this-generation
(into #{} (comp (mapcat square)
(distinct)
(filter #(live-cell? this-generation %))))))
;; Full implementation here: https://github.com/NathanSmutz/game-of-life-clojurescript
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment