sudoku.clj

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

(defn get-square [rows x y]
  (for [x (range x (+ x 3))
        y (range y (+ y 3))]
    (get-in rows [x y])))

(defn init [vars hints]
  (if (seq vars)
    (let [hint (first hints)]
      (all
        (if-not (zero? hint)
          (== (first vars) hint)
          succeed)
        (init (next vars) (next hints))))
    succeed))

(defn sudokufd [hints]
  (let [vars (repeatedly (* 9 9 9) lvar)
        rows (->> vars (partition 9) (map vec) (into []))
        cols (vec (mapcat #(map vec (partition 9 %))
                          (apply map vector rows)))
        depths (vec (mapcat #(apply map vector %)
                            (partition 9 cols)))
        sqs  (apply concat
              (for [x (range 0 9 3)
                    y (range 0 9 3)
                    z (range 0 9)]
                [(get-square rows (+ x (* 9 z)) y)
                 (get-square cols (+ x (* 9 z)) y)
                 (get-square depths (+ x (* 9 z)) y)]))]
    (run* [q]
      (== q vars)
      (everyg #(fd/in % (fd/domain 1 2 3 4 5 6 7 8 9)) vars)
      (init vars hints)
      (everyg fd/distinct rows)
      (everyg fd/distinct depths)
      (everyg fd/distinct cols)
      (everyg fd/distinct sqs))))

(def board
  [[[7 0 0 0 8 0 0 0 9]
    [0 0 9 0 4 0 5 0 0]
    [0 0 0 0 0 0 0 0 0]
    [9 0 0 0 0 0 0 0 1]
    [0 0 3 0 1 0 8 0 0]
    [1 0 0 0 0 0 0 0 6]
    [0 0 0 0 0 0 0 0 0]
    [0 0 6 0 2 0 7 0 0]
    [2 0 0 0 3 0 0 0 5]]
   [[0 0 3 0 0 0 8 0 0]
    [0 7 0 6 0 8 0 3 0]
    [0 0 6 0 0 0 7 0 0]
    [0 0 0 0 0 0 0 0 0]
    [0 9 0 0 0 0 0 2 0]
    [0 0 0 0 0 0 0 0 0]
    [0 0 9 0 0 0 5 0 0]
    [0 3 0 1 0 9 0 4 0]
    [0 0 1 0 0 0 3 0 0]]
   [[0 0 0 0 3 0 0 0 0]
    [3 0 0 7 0 1 0 0 6]
    [4 1 7 0 0 0 2 9 3]
    [0 0 0 1 0 9 0 0 0]
    [0 0 0 0 0 0 0 0 0]
    [0 0 0 6 0 3 0 0 0]
    [1 6 4 0 0 0 9 3 7]
    [9 0 0 3 0 4 0 0 1]
    [0 0 0 0 1 0 0 0 0]]
   [[0 8 0 0 0 0 0 9 0]
    [0 0 0 0 8 0 0 0 0]
    [1 0 5 0 9 0 4 0 2]
    [0 0 0 0 0 0 0 0 0]
    [0 1 0 3 0 4 0 5 0]
    [0 0 0 0 0 0 0 0 0]
    [6 0 1 0 3 0 8 0 9]
    [0 0 0 0 4 0 0 0 0]
    [0 3 0 0 0 0 0 4 0]]
   [[5 1 0 0 0 0 0 4 8]
    [6 4 8 0 0 0 3 2 9]
    [0 0 0 0 0 0 0 0 0]
    [0 0 0 0 9 0 0 0 0]
    [0 0 0 8 0 5 0 0 0]
    [0 0 0 0 3 0 0 0 0]
    [0 0 0 0 0 0 0 0 0]
    [1 2 4 0 0 0 9 8 7]
    [9 8 0 0 0 0 0 5 3]]
   [[0 3 0 0 0 0 0 5 0]
    [0 0 0 0 3 0 0 0 0]
    [8 0 4 0 5 0 9 0 7]
    [0 0 0 0 0 0 0 0 0]
    [0 8 0 1 0 9 0 4 0]
    [0 0 0 0 0 0 0 0 0]
    [2 0 8 0 1 0 3 0 5]
    [0 0 0 0 9 0 0 0 0]
    [0 1 0 0 0 0 0 9 0]]
   [[0 0 0 0 5 0 0 0 0]
    [9 0 0 3 0 4 0 0 1]
    [2 5 3 0 0 0 8 6 4]
    [0 0 0 4 0 6 0 0 0]
    [0 0 0 0 0 0 0 0 0]
    [0 0 0 8 0 5 0 0 0]
    [5 3 7 0 0 0 2 4 8]
    [6 0 0 5 0 2 0 0 9]
    [0 0 0 0 4 0 0 0 0]]
   [[0 0 9 0 0 0 5 0 0]
    [0 3 0 1 0 9 0 4 0]
    [0 0 1 0 0 0 3 0 0]
    [0 0 0 0 0 0 0 0 0]
    [0 2 0 0 0 0 0 3 0]
    [0 0 0 0 0 0 0 0 0]
    [0 0 6 0 0 0 7 0 0]
    [0 9 0 4 0 7 0 6 0]
    [0 0 5 0 0 0 4 0 0]]
   [[3 0 0 0 9 0 0 0 6]
    [0 0 7 0 6 0 2 0 0]
    [0 0 0 0 0 0 0 0 0]
    [2 0 0 0 0 0 0 0 9]
    [0 0 9 0 4 0 5 0 0]
    [5 0 0 0 0 0 0 0 8]
    [0 0 0 0 0 0 0 0 0]
    [0 0 3 0 1 0 8 0 0]
    [1 0 0 0 5 0 0 0 7]]])

(comment
  "Generally takes 3-10ms on my machine"
  (sudokufd (flatten board))
;; => ((7 4 1 5 8 6 3 2 9 8 6 9 2 4 3 5 1 7 5 3 2 1 7 9 6 4 8 9 8 7 3 6 4 2 5 1 6 5 3 9 1 2 8 7 4 1 2 4 7 5 8 9 3 6 3 7 5 6 9 1 4 8 2 4 1 6 8 2 5 7 9 3 2 9 8 4 3 7 1 6 5 2 5 3 9 1 7 8 6 4 1 7 4 6 5 8 9 3 2 9 8 6 3 2 4 7 5 1 4 1 2 8 7 5 6 9 3 7 9 8 4 3 6 1 2 5 3 6 5 2 9 1 4 8 7 8 2 9 7 4 3 5 1 6 5 3 7 1 6 9 2 4 8 6 4 1 5 8 2 3 7 9 6 9 8 4 3 2 1 7 5 3 2 5 7 9 1 4 8 6 4 1 7 8 6 5 2 9 3 5 3 6 1 2 9 7 4 8 2 4 1 5 8 7 3 6 9 8 7 9 6 4 3 5 1 2 1 6 4 2 5 8 9 3 7 9 8 2 3 7 4 6 5 1 7 5 3 9 1 6 8 2 4 4 8 7 1 2 5 6 9 3 2 9 3 4 8 6 1 7 5 1 6 5 7 9 3 4 8 2 3 2 4 6 5 8 9 1 7 9 1 6 3 7 4 2 5 8 7 5 8 9 1 2 3 6 4 6 4 1 5 3 7 8 2 9 8 7 9 2 4 1 5 3 6 5 3 2 8 6 9 7 4 1 5 1 2 3 6 9 7 4 8 6 4 8 5 1 7 3 2 9 3 7 9 2 4 8 5 1 6 8 6 5 7 9 1 4 3 2 4 3 7 8 2 5 6 9 1 2 9 1 4 3 6 8 7 5 7 5 3 9 8 2 1 6 4 1 2 4 6 5 3 9 8 7 9 8 6 1 7 4 2 5 3 9 3 6 8 7 4 2 5 1 7 5 1 9 3 2 8 6 4 8 2 4 6 5 1 9 3 7 1 7 9 2 4 3 5 8 6 5 8 2 1 6 9 7 4 3 6 4 3 5 8 7 1 2 9 2 9 8 4 1 6 3 7 5 3 6 5 7 9 8 4 1 2 4 1 7 3 2 5 6 9 8 1 7 4 6 5 8 9 3 2 9 8 6 3 2 4 7 5 1 2 5 3 9 1 7 8 6 4 7 9 8 4 3 6 1 2 5 3 6 5 2 9 1 4 8 7 4 1 2 8 7 5 6 9 3 5 3 7 1 6 9 2 4 8 6 4 1 5 8 2 3 7 9 8 2 9 7 4 3 5 1 6 8 6 9 2 4 3 5 1 7 5 3 2 1 7 9 6 4 8 7 4 1 5 8 6 3 2 9 6 5 3 9 1 2 8 7 4 1 2 4 7 5 8 9 3 6 9 8 7 3 6 4 2 5 1 4 1 6 8 2 5 7 9 3 2 9 8 4 3 7 1 6 5 3 7 5 6 9 1 4 8 2 3 2 5 7 9 1 4 8 6 4 1 7 8 6 5 2 9 3 6 9 8 4 3 2 1 7 5 2 4 1 5 8 7 3 6 9 8 7 9 6 4 3 5 1 2 5 3 6 1 2 9 7 4 8 9 8 2 3 7 4 6 5 1 7 5 3 9 1 6 8 2 4 1 6 4 2 5 8 9 3 7))
)