Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Game of life projectified (fix #7), todo: a hex run target

  • Loading branch information...
commit 7521bcfb52cdf7e598bca3c4e7860d795a67992c 1 parent 3eef018
@cgrand cgrand authored
View
6 ch03-game-of-life/project.clj
@@ -0,0 +1,6 @@
+(defproject game-of-life "1.0.0-SNAPSHOT"
+ :description "A generic life-like automaton by Emerick, Carper, and Grand."
+ :url "http://github.com/clojurebook/ClojureProgramming"
+ :dependencies [[org.clojure/clojure "1.3.0"]]
+ :profiles {:1.4 {:dependencies [[org.clojure/clojure "1.4.0-beta6"]]}}
+ :run-aliases {:rect com.clojurebook.collections.life/rect-demo})
View
175 ch03-game-of-life/src/com/clojurebook/collections/life.clj
@@ -0,0 +1,175 @@
+(ns com.clojurebook.collections.life)
+
+(defn empty-board
+ "Creates a rectangular empty board of the specified width
+ and height."
+ [w h]
+ (vec (repeat w (vec (repeat h nil)))))
+
+
+(defn populate
+ "Turns :on each of the cells specified as [y, x] coordinates."
+ [board living-cells]
+ (reduce (fn [board coordinates]
+ (assoc-in board coordinates :on))
+ board
+ living-cells))
+
+(def glider (populate (empty-board 6 6) #{[2 0] [2 1] [2 2] [1 2] [0 1]}))
+
+(defn neighbours
+ [[x y]]
+ (for [dx [-1 0 1] dy [-1 0 1] :when (not= 0 dx dy)]
+ [(+ dx x) (+ dy y)]))
+
+(defn count-neighbours
+ [board loc]
+ (count (filter #(get-in board %) (neighbours loc))))
+
+(defn indexed-step
+ "Yields the next state of the board, using indices to determine neighbors,
+ liveness, etc."
+ [board]
+ (let [w (count board)
+ h (count (first board))]
+ (loop [new-board board x 0 y 0]
+ (cond
+ (>= x w) new-board
+ (>= y h) (recur new-board (inc x) 0)
+ :else
+ (let [new-liveness
+ (case (count-neighbours board [x y])
+ 2 (get-in board [x y])
+ 3 :on
+ nil)]
+ (recur (assoc-in new-board [x y] new-liveness) x (inc y)))))))
+
+
+(defn indexed-step2
+ [board]
+ (let [w (count board)
+ h (count (first board))]
+ (reduce
+ (fn [new-board x]
+ (reduce
+ (fn [new-board y]
+ (let [new-liveness
+ (case (count-neighbours board [x y])
+ 2 (get-in board [x y])
+ 3 :on
+ nil)]
+ (assoc-in new-board [x y] new-liveness)))
+ new-board (range h)))
+ board (range w))))
+
+
+(defn indexed-step3
+ [board]
+ (let [w (count board)
+ h (count (first board))]
+ (reduce
+ (fn [new-board [x y]]
+ (let [new-liveness
+ (case (count-neighbours board [x y])
+ 2 (get-in board [x y])
+ 3 :on
+ nil)]
+ (assoc-in new-board [x y] new-liveness)))
+ board (for [x (range h) y (range w)] [x y]))))
+
+
+(defn window
+ "Returns a lazy sequence of 3-item windows centered
+ around each item of coll, padded as necessary with
+ pad or nil."
+ ([coll] (window nil coll))
+ ([pad coll]
+ (partition 3 1 (concat [pad] coll [pad]))))
+
+(defn cell-block
+ "Creates a sequences of 3x3 windows from a triple of 3 sequences."
+ [[left mid right]]
+ (window (map vector left mid right)))
+
+(defn liveness
+ "Returns the liveness (nil or :on) of the center cell for
+ the next step."
+ [block]
+ (let [[_ [_ center _] _] block]
+ (case (- (count (filter #{:on} (apply concat block)))
+ (if (= :on center) 1 0))
+ 2 center
+ 3 :on
+ nil)))
+
+(defn- step-row
+ "Yields the next state of the center row."
+ [rows-triple]
+ (vec (map liveness (cell-block rows-triple))))
+
+(defn index-free-step
+ "Yields the next state of the board."
+ [board]
+ (vec (map step-row (window (repeat nil) board))))
+
+(defn step
+ "Yields the next state of the world"
+ [cells]
+ (set (for [[loc n] (frequencies (mapcat neighbours cells))
+ :when (or (= n 3) (and (= n 2) (cells loc)))]
+ loc)))
+
+(defn stepper
+ "Returns a step function for Life-like cell automata.
+ neighbours takes a location and return a sequential collection
+ of locations. survive? and birth? are predicates on the number
+ of living neighbours."
+ [neighbours birth? survive?]
+ (fn [cells]
+ (set (for [[loc n] (frequencies (mapcat neighbours cells))
+ :when (if (cells loc) (survive? n) (birth? n))]
+ loc))))
+
+(defn hex-neighbours
+ [[x y]]
+ (for [dx [-1 0 1] dy (if (zero? dx) [-2 2] [-1 1])]
+ [(+ dx x) (+ dy y)]))
+
+(def hex-step (stepper hex-neighbours #{2} #{3 4}))
+
+(defn rect-stepper
+ "Returns a step function for standard game of life on a (bounded) rectangular
+ board of specified size."
+ [w h]
+ (stepper #(filter (fn [[i j]] (and (< -1 i w) (< -1 j h)))
+ (neighbours %)) #{2 3} #{3}))
+
+(defn draw
+ [w h step cells]
+ (let [state (atom cells)
+ run (atom true)
+ listener (proxy [java.awt.event.WindowAdapter] []
+ (windowClosing [_] (reset! run false)))
+ pane
+ (doto (proxy [javax.swing.JPanel] []
+ (paintComponent [^java.awt.Graphics g]
+ (let [g (doto ^java.awt.Graphics2D (.create g)
+ (.setColor java.awt.Color/BLACK)
+ (.fillRect 0 0 (* w 10) (* h 10))
+ (.setColor java.awt.Color/WHITE))]
+ (doseq [[x y] @state]
+ (.fillRect g (inc (* 10 x)) (inc (* 10 y)) 8 8)))))
+ (.setPreferredSize (java.awt.Dimension. (* 10 w) (* 10 h))))]
+ (doto (javax.swing.JFrame. "Quad Life")
+ (.setContentPane pane)
+ (.addWindowListener listener)
+ .pack
+ (.setVisible true))
+ (future (while @run
+ (Thread/sleep 80)
+ (swap! state step)
+ (.repaint pane)))))
+
+(defn rect-demo []
+ (draw 30 30 (rect-stepper 30 30)
+ #{[15 15] [15 17] [16 16] [15 16]}))
Please sign in to comment.
Something went wrong with that request. Please try again.