KS+AZ: Nonograms dojo

nonograms.clj

(ns nonograms.core
  (:require [mikera.image.core :as img]
            [mikera.image.colours :as col]))

(def foo (img/load-image-resource "100px-Greek_lc_lamda_thin.png"))

(def w (img/width foo))
(def h (img/height foo))

(def n 20)
(def m 20)

(def cell-width (Math/round ^Double (/ w n)))
(def cell-height (Math/round ^Double (/ h m)))
(def cell-pixels (* cell-width cell-height))

(defn black? [image i j]
  (let [blacks-count
  (count
    (for [x (range (* i cell-width) (* (inc i) cell-width))
                          y (range (* j cell-height) (* (inc j) cell-height))
                          :when (not (zero? (img/get-pixel image x y)))]
                      [x y]))]
    (> (double (/ blacks-count cell-pixels)) 0.5)))

(defn transpose [m]
  (apply mapv vector m))

(def straight
  (partition n
           (for [i (range n)
                 j (range m)]
             (black? foo j i))))

(def transposed
  (transpose straight))

(->> straight
     (map (fn [row]
            (map #(if % "*" " ") row)))
     (run! println))

(defn count-by [pred xs]
  (->> xs
       (filter pred)
       count))

(defn japanize [matrix]
  (reduce (fn [acc row]
            (conj acc
                  (->> row
                       (partition-by identity)
                       (map #(count-by true? %))
                       (filter (complement zero?)))))
          []
          matrix))

(println (japanize straight))
(println (japanize transposed))

output.txt

(                                       )
(      * * * *                          )
(    * * * * * *                        )
(  * *       * * *                      )
(  *           * *                      )
(                * *                    )
(                * *                    )
(                  *                    )
(                * * *                  )
(              * * * *                  )
(              * * * *                  )
(            * * * * * *                )
(          * * * *   * *                )
(        * * * *       * *              )
(        * * *         * *              )
(      * * * *           *              )
(    * * * *             * *           *)
(  * * * *               * * * *     * *)
(  * * * *                 * * * * * *  )
(                              * * *    )
[() (4) (6) (2 3) (1 2) (2) (2) (1) (3) (4) (4) (6) (4 2) (4 2) (3 2) (4 1) (4 2 1) (4 4 2) (4 6) (3)]
[() (2 2) (2 3) (2 4) (2 6) (2 5) (3 5) (3 5) (4 5) (7) (5) (4) (5) (3) (2) (3) (2) (2) (2) (2)]