Create a gist now

Instantly share code, notes, and snippets.

@orb /nono.clj
Last active Dec 19, 2015

What would you like to do?
(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