Last active
December 19, 2015 04:18
-
-
Save orb/5895918 to your computer and use it in GitHub Desktop.
solving nonogrids http://www.brainbashers.com/nonogrids.asp
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(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]])) | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment