Enumerate Sudoku Solutions

sud.clj

(ns sud
  (:require [clojure.set :as s]
            [clojure.pprint :as pp]))

(defn possible
  "Possible values for a given position"
  [[x y] board]
  (let [horizontal (set (board x))
        vertical (reduce (fn [a c] (conj a (c y))) #{} board)
        x' (* (quot x 3) 3)
        y' (* (quot y 3) 3)
        local (reduce (fn [a r]
                        (->> (range y' (+ y' 3))
                             (map #(get-in board [r %]))
                             (into a)))
                      #{} (range x' (+ x' 3)))]
    (s/difference (set (range 1 10)) vertical horizontal local)))

(defn open
  "Get all open positions"
  [board]
  (reduce (fn [a r]
            (->> (second r)
                 (map-indexed vector)
                 (filter #(= 0 (second %)))
                 (map #(vector (first r) (first %)))
                 (into a)))
          [] (map-indexed vector board)))

(defn most-constrained
  "Get open positions and possibles sorted by the least possibles"
  [board]
  (->> board
       open
       (map #(vector % (possible % board)))
       (sort-by (comp count second))))

(defn solved? [board]
  (->> board
       (apply concat)
       (some #{0})
       (not= 0)))

(defn search [n board]
  (let [res (atom [])]
    ((fn sloop [board]
       (when (< (count @res) n)    
         (if (solved? board)
           (swap! res conj board)
           (letfn [(try-all [[[o ps]] & t]
                     (when o
                       (doseq [p ps]
                         (sloop (assoc-in board o p))
                         (try-all t))))]
             (try-all (most-constrained board))))))
     board)
    @res))

(comment

  (def empty-board (vec (repeat 8 (vec (repeat 8 0)))))
  (time (pp/pprint (search 5 empty-board)))

  (def simple-board 
    [[0 0 0  0 2 0  0 9 0]
     [0 0 0  0 6 3  0 0 8]
     [3 0 0  0 0 8  1 4 0]
     
     [0 0 0  0 4 0  8 0 7]
     [0 8 4  0 0 0  6 1 0]
     [1 0 7  0 5 0  0 0 0]
     
     [0 1 5  9 0 0  0 0 2]
     [9 0 0  4 8 0  0 0 0]
     [0 2 0  0 1 0  0 0 0]])
  (time (pp/pprint (search 1 simple-board)))

  (def hard-board
    [[0 0 5  3 0 0  0 0 0] 
     [8 0 0  0 0 0  0 2 0] 
     [0 7 0  0 1 0  5 0 0] 
     
     [4 0 0  0 0 5  3 0 0] 
     [0 1 0  0 7 0  0 0 6] 
     [0 0 3  2 0 0  0 8 0] 
     
     [0 6 0  5 0 0  0 0 9] 
     [0 0 4  0 0 0  0 3 0] 
     [0 0 0  0 0 9  7 0 0]])
  (time (pp/pprint (search 1 hard-board)))

  (def evil-board
    [[1 0 2  0 0 0  0 0 0] 
     [0 0 3  0 0 0  0 0 0] 
     [0 0 0  0 0 0  0 0 4] 
     
     [0 4 0  0 5 0  0 0 0] 
     [0 6 0  0 7 0  0 0 0] 
     [0 0 0  0 0 0  0 2 0] 
     
     [0 8 0  0 0 0  0 0 0] 
     [0 0 0  0 0 0  0 0 0] 
     [0 0 0  0 0 0  8 0 0]])
  (time (pp/pprint (search 1 evil-board)))

  (def evil-norvig
    [[0 0 0  0 0 6  0 0 0]
     [0 5 9  0 0 0  0 0 8]
     [2 0 0  0 0 8  0 0 0]
     
     [0 4 5  0 0 0  0 0 0]
     [0 0 3  0 0 0  0 0 0]
     [0 0 6  0 0 3  0 5 4]

     [0 0 0  3 2 5  0 0 6]
     [0 0 0  0 0 0  0 0 0]
     [0 0 0  0 0 0  0 0 0 ]])
  (time (pp/pprint (search 1 evil-norvig)))
  
)

neat, I'm curious how fast these are.

well, let's see how fast they are compare to the core.logic ones I'm working on :)

Unless you're using cKanren those benchmarks won't be very informative :) This kind of problem is all about all-different constraints. I recall running some on cKanren Scheme and they seemed faster than Peter Norvig's clever Python implementation.