solving nonogrids http://www.brainbashers.com/nonogrids.asp

nono.clj

(ns logic.nono
  (:refer-clojure :exclude [==])
  (:use [clojure.core.logic])
  (:require [clojure.core.logic.fd :as fd]))

(def max-size 25)

(defn count-ones [marks howmany post-marks]
  (conde
   [(emptyo marks)
    (== howmany 0)
    (emptyo post-marks)]
   [(firsto marks 0)
    (== howmany 0)
    (resto marks post-marks)]
   [(firsto marks 1)
    (fresh [count-rest rest-marks]
           (fd/in count-rest (fd/interval 0 max-size))
           (fd/in howmany (fd/interval 0 max-size))
           (resto marks rest-marks)
           (count-ones rest-marks count-rest post-marks)
           (fd/eq (= howmany (+ count-rest 1))))]))

(defn nonorow [marks scores]
  (conde
   [(emptyo marks)
    (emptyo scores)]

   [(firsto marks 0)
    (fresh [rest-marks]
           (resto marks rest-marks)
           (nonorow rest-marks scores))]
   [(firsto marks 1)
    (fresh [howmany rest-marks rest-scores]
           (count-ones marks howmany rest-marks)
           (firsto scores howmany)
           (resto scores rest-scores)
           (nonorow rest-marks rest-scores))]))


(defn solve [col-constraints row-constraints]
  (let [sdnum (fd/domain 0 1)
        size (count col-constraints)
        board (lvars (* size size))
        rows (into []  (map vec (partition size board)))
        cols (apply map vector rows)

        indexed (fn [items]
                  (fn [i item]
                    [(nth items i) item]))
        rows-indexed (keep-indexed (indexed rows) row-constraints)
        cols-indexed (keep-indexed (indexed cols) col-constraints)
        all-indexed (interleave rows-indexed
                                cols-indexed)]

    (first
     (run 1 [q]
          (== q rows)
          (everyg #(fd/in % sdnum) board)
          (everyg #(apply nonorow %) all-indexed)))))

(defn printlns [lines]
  (doseq [line lines]
    (println line)))

(defn display [solution]
  (printlns (map #(apply str %) solution)))

(defn solve-p5 []
  (solve [[4] [3] [1] [2] [3]]
         [[2] [1 2] [2 1] [3] [2]]))

(defn solve-p10 []
  (solve [[2] [1 1 4] [8] [6] [5] [1] [2] [5 1] [4 3] [4 3]]
         [[4] [3 3] [3 4] [8] [4 3] [2 1] [2] [2 3] [2 2] [2 2]]))

(defn solve-p15 []
  (solve [[3 2] [1 2 1] [3 6] [4 5] [4 3 3]
          [8] [5 3] [5 3 3] [12] [5 4]
          [7 1] [4] [4] [3 3] [3 1 2]]
         [[1 1 5] [1 1 5] [3 5] [10] [9]
          [5 3] [11 1] [1 1 3 2] [5 2 1] [4 1]
          [3 2] [2 3] [3 4] [3 1 1 3 1] [1 1 1 2 1]]))

(defn solve-p25 []
  (solve
   [[4 5] [4 4 4 1] [5 6 2] [2 4 6 2 2] [2 6 2 2]
    [2 6 3] [2 13] [3 11] [9 2 1] [9 1 1 1]
    [2 7] [2 3 2] [4 2] [1 2 1 3 1] [3 2 1 3]
    [3 15] [4 4 6] [11 6] [3 4 1 2] [10 1 2]
    [11 3] [1 1 6 1 3] [6 1 8 1] [4 8 4] [3 3 11]]

   [[4 5 3 5] [4 5 3 3] [3 2 4 3] [6 3 2] [1 5 2 1]
    [4 4 1 1] [4 3 3 2] [4 3 7] [4 3 9] [1 9 1]
    [5 2 4 1] [7 1 3 1] [9 1 5 2] [7 8 1] [7 5 6]
    [7 10] [1 2 4 5] [1 2 3 3] [2 2 4 4] [2 2 3 1 3]
    [5 3 3 3 1] [4 2 1 6] [2 1 1 1 2] [3 1 2] [1 3 1 1 1 3]]))