puyo.clj

;; ぷよぷよ19連鎖の問題(http://okajima.air-nifty.com/b/2011/01/2011-ffac.html)を
;; 解くClojureプログラム

(use '[clojure.contrib.io :only (read-lines)]
     '[clojure.string :only (join)])

(defn value-at [field y x]
  (get-in field [x y]))

(defn nrows [field]
  (count (field 0)))

(defn ncols [field]
  (count field))

(defn entire-block
  ([pos field]
   (entire-block pos field #{}))
  ([[y x :as pos] field visited]
   (reduce (fn [visited* pos*]
             (if (visited* pos*)
               visited*
               (into visited* (entire-block pos* field visited*))))
           (conj visited pos)
           (for [[dy dx] [[0 -1] [1 0] [0 1]]
                 :let [[y* x* :as pos*] [(+ y dy) (+ x dx)]]
                 :when (and (not (visited pos*))
                            (= (value-at field y x)
                               (value-at field y* x*)))]
             pos*))))

(defn all-blocks [field]
  (let [blocks (atom [])]
    (doseq [y (range (nrows field))
            x (range (ncols field))
            :let [pos [y x]]
            :when (and (not= (value-at field y x) \space)
                       (not (some #(% pos) @blocks)))
            :let [block (entire-block pos field)]
            :when (>= (count block) 4)]
      (swap! blocks conj block))
    @blocks))

(defn remove-blocks [field blocks]
  (let [to-be-removed (reduce into blocks)]
    (vec (map (fn [col] (vec (sort (fn [x y] (= x \space)) col)))
              (for [x (range (ncols field))]
                (for [y (range (nrows field))]
                  (if (to-be-removed [y x])
                    \space
                    (value-at field y x))))))))

(defn steps [field]
  (lazy-seq
    (cons field
          (let [blocks (all-blocks field)]
            (if-not (empty? blocks)
              (steps (remove-blocks field blocks)))))))

(defn print-field [field]
  (let [trans (apply map list field)
        color #(str "\033[" (or ({\R 41, \G 44, \Y "1;43"} %) 0) "m" %)
        hline (join (repeat (+ (ncols field) 2) "-"))
        lines `(~hline
                ~@(map #(join `("|" ~@(map color %) "\033[0m|")) trans)
                ~hline)]
    (println (join \newline lines))))

(defn solve [field]
  (doseq [step (steps field)]
    (print-field step)
    (newline)))

(solve (vec (apply map vector (read-lines *in*))))