Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
;;; The Life code is based on an idea by Paul Blair and Michael Nicholaides @nicholaides
(ns life
(:use [clojure.contrib.combinatorics :only (cartesian-product)])
(:use [clojure.set])
)
;;; Test stuff that's here because I haven't written the mocking package yet.
(defmacro know [& forms])
(defmacro fact [& forms])
(defmacro example [& forms])
(defn pending-impl [names]
(let [declarations (map (fn [name] `(defn ~name [& args#] (println '~name "is unimplemented.")))
names)]
`(do ~@declarations)))
(defmacro pending [& names] (pending-impl names))
(defn in-any-order [expected actual]
(and (= (count expected) (count actual))
(= (set expected) (set actual))))
(defn truthy [x] x)
(defn falsey [x] (not x))
(pending add-border-to)
(declare living?) ;; Stupid need for forward declarations.
(defn make-location
([x y] [x y])
([xy] xy)
)
(defn x [location] (first location))
(defn y [location] (second location))
(defn have-locations [expected-pairs actual]
(in-any-order (map make-location expected-pairs)
actual))
(defn neighbors [center]
(let [product (cartesian-product [-1 0 1] [-1 0 1])
meaningful-values (remove #{ [0 0] } product)
shifter (fn [ [x-shift y-shift] ] (make-location (+ (x center) x-shift)
(+ (y center) y-shift)))]
(map shifter meaningful-values))
)
(know "that neighbors are constructed from locations alone"
(neighbors (make-location [3 88])) => (have-locations
[2 89] [3 89] [4 89]
[2 88] [4 88]
[2 87] [3 87] [4 87])
)
(defn living-neighbor-count [location]
(count (filter living? (neighbors location)))
)
(know "how living neighbors are counted"
(living-neighbor-count ...center...) => 1
(provided
(neighbors ...center...) => [ ...living-location... ...dead-location... ]
(living? ...living-location...) => true
(living? ...dead-location...) => false)
)
(defn dead-in-next-generation? [location]
(condp = (living-neighbor-count location)
3 false
2 (not (living? location))
true)
)
(know "rules that determine the life or death of a location in the sucessor generation"
(dead-in-next-generation? ...location...) => truthy
(provided "underpopulation"
(living? ...location...) => true
(living-neighbor-count ...location...) =from=> [0, 1])
(or "overpopulation"
(living? ...location...) => true
(living-neighbor-count ...location...) =from=> [4 ,,, 8])
(or "not enough locations to bring to life"
(living? ...location...) => false
(living-neighbor-count ...location...) =from=> [0,,,2]) ;
(or "too many locations to bring to life"
(living? ...location...) => false
(living-neighbor-count ...location...) =from=> [4,,,8]) ;
(dead-in-next-generation? ...location...) => falsey
(provided
(living? ...location...) => true
(living-neighbor-count ...location...) =from=> [2, 3])
(or
(living? ...location...) => false
(living-neighbor-count ...location...) => 3)
)
(defn add-border-to [locations]
(distinct (concat locations
(mapcat neighbors locations))))
(know "add-border-to adds inputs adjacent to its input"
(add-border-to [ ...location...]) => (in-any-order [...location...
...neighbor1... neighbor2...])
(provided
(neighbors ...location...) => [...neighbor1... ...neighbor2...])
"a location that borders two input locations only appears once"
(add-border-to [ ...one... ...other...]) => (in-any-order
[...one... ...between... ...other...])
(provided
(neighbors ...one...) => [...between...]
(neighbors ...other...) => [...between...])
)
(defmacro using-cell-oracles-from [locations-form & rest]
`(let [data# (set ~locations-form)]
(binding [living? (fn [location#] (data# location#))]
(let [result# (do ~@rest)]
(if (seq? result#) (doall result#) result#))))
)
(know "that an oracle about living? can be created"
(using-cell-oracles-from [...location ...]
(living? ...location...)) => truthy
(using-cell-oracles-from [...location ...]
(living? ...somewhere-else...)) => falsey
)
(defn next-world [only-living-locations]
(using-cell-oracles-from only-living-locations
(remove dead-in-next-generation?
(add-border-to only-living-locations)))
)
(def *horizontal-blinker* [ [0,1] [1,1], [2,1] ] )
(def *vertical-blinker* [ [1,2]
[1,1]
[1,0] ])
(example "of blinkers blinking"
(next-world *horizontal-blinker*) => (in-any-order *vertical-blinker*)
(next-world *vertical-blinker*) => (in-any-order *horizontal-blinker*)
)
(println "Horizontal blinker turns into...")
(println (next-world *horizontal-blinker*))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment