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 |