functional conway game of life using sets

conway.clj

#!/usr/bin/env boot
"Clojure KISS implementation of Conway's game of life

Ported from https://gist.github.com/lourkeur/95799b35e2d3aac54cdd0e4a7c8d2037 (Python)
Patterns from http://conwaylife.com/wiki"

(set-env! :dependencies #(conj % '[org.clojure/clojure "1.9.0"]))

(require '[clojure.spec.alpha :as spec])
(use 'clojure.test)

; data structures
(spec/def ::cell (spec/tuple integer? integer?))
(spec/def ::grid (spec/coll-of ::cell :kind set?))

(when *load-tests*
  (set-env! :dependencies #(conj % '[org.clojure/test.check "0.9.0"]))
  (require '[clojure.spec.test.alpha :as t]))

(defn neighbours [[x y]]
  (let [x-1 (dec x), x+1 (inc x)
        y-1 (dec y), y+1 (inc y)]
    [[x-1 y-1] [x-1 y] [x-1 y+1]
     [x   y-1]         [x   y+1]
     [x+1 y-1] [x+1 y] [x+1 y+1]]))

(defn tick [grid]
  (->>
    (mapcat neighbours grid)
    frequencies
    (keep
      (fn [[c x]]
        (case x
          2 (if (contains? grid c) c)
          3 c
          nil)))
    (into #{})))

(when *load-tests*
  (defn- distance [c1 c2]  ; L-infinity distance
    (->> (map - c1 c2) (map #(if (neg? %) (- %) %)) (apply max)))

  (spec/fdef neighbours
             :args (spec/cat :c ::cell)
             :ret (spec/* ::cell)
             :fn (fn [{{c :c} :args ret :ret}]
                   (->> ret (map #(distance % c)) (every? #{1}))))
  (spec/fdef tick
             :args (spec/cat :grid ::grid)
             ret ::grid)

  (deftest- check-neighbours
    (is (->> (t/check `neighbours)
             (every? #(-> % :clojure.spec.test.check/ret :result true?)))))


  (deftest- basic-tasks
    "some cheap basic non-exhaustive correctness tests"
    (t/instrument `(neighbours tick))
    (def block #{[0 0] [0 1] [1 0] [1 1]})
    (assert (= (tick block) block))

    (def blinker1 #{[1 0] [1 1] [1 2]})
    (def blinker2 #{[0 1] [1 1] [2 1]})
    (assert (= (tick blinker1) blinker2))
    (assert (= (tick blinker2) blinker1))

    (def glider1 #{[0 0] [1 1] [1 2] [2 1] [2 0]})
    (def glider3 #{[1 0] [2 1] [2 2] [3 1] [1 2]})
    (assert (= (tick (tick glider1)) glider3))))


"simple RLE parser

Not accounted for: the usual ! terminator for RLE-encoded patterns on the internet.
"
(defn rle-parse [input]
  (let [input (re-seq #"(\d+)?(b|o)(\$)?" input)
        st0 {:x 0 :y 0}
        f (fn [{:keys [x y]} [_ rep t $]]
            (let [rep (if rep (Long/parseLong rep) 1)]
              (cond-> (if $
                        {:x 0, :y (inc y)}
                        {:x (+ x rep), :y y})
                (= t "o") (assoc :output
                                 (for [i (range rep)]
                                   [(+ x i) y])))))]
    (->> (reductions f st0 input) (mapcat :output) (into #{}))))


(def acorn (rle-parse "bo5b$3bo3b$2o2b3o"))
(def diehard (rle-parse "6bob$2o6b$bo3b3o"))
(def glider (rle-parse "bo$2bo$3o"))
(def gosper-glider-gun (rle-parse "24bo$22bobo$12b2o6b2o12b2o$11bo3bo4b2o12b2o$2o8bo5bo3b2o$2o8bo3bob2o4bobo$10bo5bo7bo$11bo3bo$12b2o"))
(def herschel (rle-parse "o$3o$obo$2bo"))
(def lay (rle-parse "obo$2bo$4bo$4bobo$4bob2o$6bo"))
(def lay (rle-parse "2o2bo$o2bo$o2b2o$2bo$ob3o"))
(def line (rle-parse "8ob5o3b3o6b7ob5o"))
(def lwss (rle-parse "bo2bo$o4b$o3bo$4o"))
(def mess (rle-parse "3bo$3bobo$3b2o$o$b2o$2o"))
(def r-pentomino (rle-parse "b2o$2ob$bo"))
(def toad (rle-parse "b3o$3o"))


(set-env! :dependencies #(conj % '[clojure-lanterna "0.9.7"]))
(require '[lanterna.screen :as s])

; A character represents two cells on top of each other.
; This maps [top-cell-alive? bottom-cell-alive?] to how it can be displayed.
(def draw-charmap
  {[false false] \space
   [true false] \u2580
   [false true] \u2584
   [true true] \u2588})

(defn draw [scr grid]
  (s/clear scr)
  (let [[X Y] (s/get-size scr)
        yhalf (/ Y 2)
        xhalf (/ X 2)]
    (doseq [i (range Y)
            j (range X)
            :let [y (-> i (- yhalf) (* 2))
                  x (-> j (- xhalf))]]
      (s/put-string scr j i
                    (str (draw-charmap [(contains? grid [x y]) (contains? grid [x (inc y)])]))))))

(defn -main []
  (let [now #(System/currentTimeMillis) ; time unit: ms
        scr (s/get-screen)]
    (s/in-screen scr
      (dorun
        (map
          (fn [grid inst]
            (draw scr grid)
            (Thread/sleep (-> inst (- (now)) (max 0)))
            (s/redraw scr))
          (iterate tick acorn)
          (iterate #(+ % 200) (now)))))))


(defn frame [grid]
  (let [f (fn [st [x y]]
            (->> st
                 (merge-with max {:max-x x, :max-y y})
                 (merge-with min {:min-x x, :min-y y})))]
    (if (empty? grid)
      {:min-x 0, :min-y 0, :max-x 0, :max-y 0}
      (reduce f {} grid))))

(defn rle-unparse [grid]
  (let [{:keys [min-x min-y max-x max-y]} (frame grid)
        f (fn [{:keys [v n]} v']
            (if (not= v v')
              {:output (if v (if (= n 1) (str v) (str n v)))
               :n 1, :v v'}
              {:n (inc n), :v v}))]
    (->> (for [y (range min-y (+ max-y 1))]
           (->> (for [x (range min-x (+ max-x 2))]
                  (if (contains? grid [x y]) \o \b))
                (reductions f {})
                (mapcat :output)))
         (interpose "$")
         (apply concat)
         (apply str))))

(assert (= (rle-unparse #{}) ""))
(assert (= (rle-unparse gosper-glider-gun) "24bo$22bobo$12b2o6b2o12b2o$11bo3bo4b2o12b2o$2o8bo5bo3b2o$2o8bo3bob2o4bobo$10bo5bo7bo$11bo3bo$12b2o"))