puyo.clj

(ns puyo
  (:require [clojure.test :refer (with-test run-tests are)]
            [clojure.set :refer (union)]
            [clojure.string :as string]))

(with-test
  (defn- fall-one [b s]
    (let [h (count b)]
      (->> (reverse b)
        (apply map vector)
        (map (fn [c]
               (->> (partition-all 2 1 c)
                 (remove (fn [[p q]] (and (= p s) (not= q s))))
                 (map first)
                 (#(take h (concat % (repeat s)))))))
        (apply map vector)
        reverse
        vec)))

  (are [b s a] (= (fall-one b s) a)
    [[:A :s :s :D] [:A :B :s :s] [:s :s :C :s]] :s
      [[:s :s :s :s] [:A :s :s :D] [:A :B :C :s]]
    [[:A :s :C :s] [:s :D :A :D] [:B :C :s :s]] :s
      [[:s :s :s :s] [:A :D :C :s] [:B :C :A :D]]))

(with-test
  (defn- connect
  "Separate sets of sets 'ss' into two group,
  by if it has one or more elements equals to one of 'ev' or not.
  And take the union of the former and conj 'e' to it,
  and conj it to the latter."
  [ev ss e]
  (let [hn (group-by (fn [s] (some (fn [e] (some #(= e %) s)) ev)) ss)
        h (hn true)
        n (set (hn nil))]
    (conj n (conj (apply union h) e))))

  (are [ev ss e nss] (= (connect ev ss e) nss)
    [:a] #{#{:a :b} #{:c} #{:d :e :f}} :g #{#{:a :b :g} #{:c} #{:d :e :f}}
    [:c] #{#{:a :b} #{:c} #{:d :e :f}} :g #{#{:a :b} #{:c :g} #{:d :e :f}}
    [:d] #{#{:a :b} #{:c} #{:d :e :f}} :g #{#{:a :b} #{:c} #{:d :e :f :g}}
    [:e] #{#{:a :b} #{:c} #{:d :e :f}} :g #{#{:a :b} #{:c} #{:d :e :f :g}}
    [:a :b] #{#{:a :b} #{:c} #{:d :e :f}} :g #{#{:a :b :g} #{:c} #{:d :e :f}}
    [:a :c] #{#{:a :b} #{:c} #{:d :e :f}} :g #{#{:a :b :c :g} #{:d :e :f}}
    [:a :d] #{#{:a :b} #{:c} #{:d :e :f}} :g #{#{:a :b :d :e :f :g} #{:c}}
    [:c :d] #{#{:a :b} #{:c} #{:d :e :f}} :g #{#{:a :b} #{:c :d :e :f :g}}
    [:d :e] #{#{:a :b} #{:c} #{:d :e :f}} :g #{#{:a :b} #{:c} #{:d :e :f :g}}
    [] #{#{:a :b} #{:c} #{:d :e :f}} :g #{#{:a :b} #{:c} #{:d :e :f} #{:g}}
    [] #{} :g #{#{:g}}))

(with-test
  (defn- grouped-indices [b]
    (let [h (count b)
          w (count (first b))]
      (reduce
        (fn [a [y x :as yx]]
          (let [c (get-in b yx)
                uyx [(dec y) x]
                u (get-in b uyx)
                lyx [y (dec x)]
                l (get-in b lyx)]
            (cond (= c u l) (connect [uyx lyx] a yx)
                  (= c u)   (connect [uyx] a yx)
                  (= c l)   (connect [lyx] a yx)
                  :else     (connect [] a yx))))
        #{}
        (for [y (range h) x (range w)] [y x]))))

  (are [b g] (= (grouped-indices b) g)
    [[:A :s :A :A] [:A :A :C :C] [:C :B :B :B]]
      #{#{[0 0] [1 0] [1 1]}    ; :A
        #{[0 1]}                ; :s
        #{[0 2] [0 3]}          ; :A
        #{[1 2] [1 3]}          ; :C
        #{[2 0]}                ; :C
        #{[2 1] [2 2] [2 3]}})) ; :B

(with-test
  (defn- erase [b s n]
    (->> (grouped-indices b)
      (remove #(= (get-in b (first %)) s))
      (filter #(< n (count %)))
      (apply union)
      (reduce #(assoc-in %1 %2 s) (mapv vec b))))

  (are [b s n a] (= (erase b s n) a)
    [[:A :s :s :s] [:A :s :A :A] [:A :A :C :B] [:C :B :B :B]] :s 3
      [[:s :s :s :s] [:s :s :A :A] [:s :s :C :s] [:C :s :s :s]]
    [[:A :A :s :D] [:s :A :A :D] [:C :C :C :C] [:F :F :F :D]] :s 3
      [[:s :s :s :D] [:s :s :s :D] [:s :s :s :s] [:F :F :F :D]]))

(with-test
  (defn- step
  "fall or erase"
  [b s n]
  (let [c (fall-one b s)]
    (if (not= c b) c (erase b s n))))

  (are [b s n r] (= (step b s n) r)
    [[:A :s :s :D] [:A :B :s :s] [:s :s :C :s]] :s 3
      [[:s :s :s :s] [:A :s :s :D] [:A :B :C :s]]
    [[:A :s :C :s] [:s :D :A :D] [:B :C :s :s]] :s 3
      [[:s :s :s :s] [:A :D :C :s] [:B :C :A :D]]
    [[:A :s :s :s] [:A :s :A :A] [:A :A :C :B] [:C :B :B :B]] :s 3
      [[:s :s :s :s] [:s :s :A :A] [:s :s :C :s] [:C :s :s :s]]
    [[:A :A :s :D] [:s :A :A :D] [:C :C :C :C] [:F :F :F :D]] :s 3
      [[:s :s :s :D] [:s :s :s :D] [:s :s :s :s] [:F :F :F :D]]))

(defn- bprint [b]
  (print "\033[0;0H") ; move (0,0)
  (dorun
    (map (fn [l]
           (println
             (apply str
               (map #({\R "\033[0;31mR\033[0m"
                       \G "\033[0;32mG\033[0m"
                       \B "\033[0;34mB\033[0m"
                       \Y "\033[0;33mY\033[0m"}
                      % %)
                    l))))
         b)))

(defn- stage [b w]
  (print "\033[2J") ; clear
  (loop [b b]
    (bprint b)
    (Thread/sleep w)
    (let [a (mapv #(apply str %) (step (mapv vec b) \space 3))]
      (if (not= a b)
          (recur a)))))

(defn from-file
  ([f w] (stage (string/split (slurp f) #"\n") w))
  ([f] (from-file f 500)))

(if-let [f (first *command-line-args*)]
  (from-file f))

seq19.dat

 YGYRR
R YGYG
GYGYRR
RYGYRG
YGYRYG
GYRYRG
YGYRYR
YGYRYR
YRRGRG
RYGYGG
GRYGYR
GRYGYR
GRYGYR