gistfile1.clj

;;; 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]
  (= (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)
)



(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*) => *vertical-blinker*
    (next-world *vertical-blinker*) => *horizontal-blinker*
)

(println (next-world *horizontal-blinker*))