CCL.clj

core.clj

(ns flood-fill.core
  (:require [clojure.pprint]))

(defn reload [] (use 'flood-fill.core :reload-all))

(defn log [o] (do (clojure.pprint/pprint o) o))

(def DATA {:size 100
           :data (mapv (fn [& _] (rand-int 2)) (range (* 100 100)))})

(defn rows
  ([one]
    (rows (:size one) (:data one)))
  ([n d]
    (let [n (if (number? n) n (:size n))
          d (if (vector? d) d (:data d))]
      (partition n d))))

(def contiguous (partial partition-by identity))

(defn region [start data]
  [start (first data) (count data)])
 
(defn regioner [acc i]
  (conj acc
        (region
          (+ (or (first (last acc)) 0)
             (or (last (last acc)) 0))
          i)))

(defn reign [] (gensym "region_"))

(defn tag-regions [row]
  (vec (pmap #(vector (reign) %) row)))

(defn region-split [row]
  (->> row
       contiguous
       (reduce regioner [])
       tag-regions
       vec))

(defn regionize [d]
  (vec (pmap region-split (rows d))))

(defn contact [a b]
  (let [sa (first a)
        ea (+ (first a) (last a) -1)
        sb (first b)
        eb (+ (first b) (last b) -1)]
    (when-not (or (and (< sa sb)
                       (< ea sb))
                  (and (> sa eb)
                       (> ea eb)))
      true)))

(defn self-map [m]
  (loop [o nil
         i m]
    (if-not (= o i)
      (recur i
        (apply merge
          (->> i
               (map #(hash-map
                       (key %)
                       (or (i (val %))
                           (val %)))))))
      i)))

(defn regions [d]
  (loop [r (regionize d)]
    (let [changes
          (->> (map (fn [row nrow]
                      (map (fn [region]
                             (map (fn [oregion] {(first region) (first oregion)})
                                  (filter
                                    #(and (not (= (first %) (first region)))
                                          (= (second (second %))
                                             (second (second region)))
                                          (contact (second region) (second %)))
                                    row)))
                           nrow))
                    r (rest r))
               flatten
               (apply merge)
               self-map)]
      (if-not (empty? changes)
        (recur 
          (mapv
            (fn [row]
              (mapv
                (fn [region]
                  [(or (changes (first region)) (first region)) (second region)])
                row))
            r))
        r))))

(defn region-of [reg-map x y]
  (-> reg-map
      (nth y)
      (->> (some #(when
                    (and (<= (first (second %)) x)
                         (> (+ (first (second %)) (last (second %))) x))
                    %)))
      first))

(defn region-area*
  ([reg-map rname]
   (->> reg-map
        (apply concat)
        (map first)
        (filter #(= rname %))
        count))
  ([reg-map x y] (region-area* reg-map (region-of reg-map x y))))

(def region-area (memoize region-area*))