Wishful Coding

(ns pepijndevos.lifeclj
  (:refer-clojure :exclude [==])
  (:use clojure.core.logic)
  (:gen-class))

;; A helper to get the neighbouring cells.
;; Clips to zero.
(defn get-neighbours [rows x y]
  (for [dx (range -1 2)
        dy (range -1 2)
        :when (not (= dx dy 0))]
    (get-in rows [(+ x dx) (+ y dy)] 0)))

;; Produces binary vectors of a certain number of bits.
;; This is used to generate all neighbour combinations.
(defn bitrange [n]
  (sort-by #(apply + %)
           (for [i (range (bit-shift-left 1 n))]
             (vec (map #(bit-and 1 (bit-shift-right i %)) (range n))))))

;; Encode the game of life rules as a 256 element conde.
;; Depending on the number of ones in a vector,
;; the corresponding rule is generated
;; that equates the pattern to the neigbours
;; and the appropriate next state.
;;
;; This can be asked simply what the next state is for
;; given neighbours and current state.
;; OR you could drive it backwards any way you like.
(defn lifegoals [neigh self next]
  (or*
   (for [adj (bitrange 8)
         :let [n (apply + adj)]]
     (cond
       (or (< n 2) (> n 3)) (all (== next 0) (== neigh adj))
       (= n 3)              (all (== next 1) (== neigh adj))
       :else             (all (== next self) (== neigh adj))))))

;; Relate two grids to each other according to the above rules.
;; Applies lifegoals to every cell and its neighbours.
;; in the forwards direction executes one life step,
;; in the backwards direction generates grids
;; that would produce the next step.
(defn stepo [size vars next]
  (let [rows (->> vars (partition size) (map vec) (into []))
        neig (for [x (range size)
                   y (range size)]
               (get-neighbours rows x y))]
    (everyg #(apply lifegoals %) (map vector neig vars next))))

;; Make a grid of unbound variables.
(defn grid [size] (repeatedly (* size size) lvar))

;; Simply execute a life step on the state.
(defn fwdlife [size state]
  (let [vars (grid size)
        next (grid size)]
    (run 1 [q]
         (== q next)
         (== vars state)
         (stepo size vars next))))

;; Produce three backward steps on state.
(defn revlife [size state]
  (let [start (grid size)
        s1 (grid size)
        s2 (grid size)
        end (grid size)]
    (run 1 [q]
          (== q [start s1 s2 end])
          (== end state)
          (stepo size s2 end)
          (stepo size s1 s2)
          (stepo size start s1)
         )))

;; Nicely print the board.
(defn printlife [size grids]
  (doseq [g grids]
    (doseq [row (->> g (partition size) (map vec) (into []))]
      (doseq [t row]
        (print t ""))
      (print "\n"))
    (print "\n")))

;; Test with a glider.
(defn -main [& args]
  (->> [0 0 0 0 0 0
        0 0 0 0 0 0
        0 0 0 1 1 0
        0 0 1 1 0 0
        0 0 0 0 1 0
        0 0 0 0 0 0]
       (revlife 6)
       first
       (printlife 6)))