Kinda like Norvig's sudoku thing I guess?

sudoku.clj

(ns sudoku.core)
(def empty-board (vec (repeat 9 (vec (repeat 9 0)))))

(def four-by-four
  [[0 1  3 2]
   [2 3  1 0]
   [1 0  2 3]
   [3 2  0 1]])

(def solved-board
  [[3 9 5  6 1 8  2 7 4]
   [1 6 4  9 7 2  3 5 8]
   [2 8 7  5 3 4  6 1 9]

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

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

(def hard-board
  [[8 5 0  0 0 2  4 0 0]
   [7 2 0  0 0 0  0 0 9]
   [0 0 4  0 0 0  0 0 0]

   [0 0 0  1 0 7  0 0 2]
   [3 0 5  0 0 0  9 0 0]
   [0 4 0  0 0 0  0 0 0]

   [0 0 0  0 8 0  0 7 0]
   [0 1 7  0 0 0  0 0 0]
   [0 0 0  0 3 6  0 4 0]])

(def evil-board
  [[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]])

;; stolen from http://jkkramer.com/sudoku.html
(defn- reduce-true
  "Like reduce but short-circuits upon logical false"
  ([f coll] (reduce-true f (first coll) (rest coll)))
  ([f acc coll]
    (when acc
      (loop [acc acc
             coll coll]
        (if (empty? coll)
          acc
          (when-let [acc (f acc (first coll))]
            (recur acc (rest coll))))))))

(defn ->blks
  [[rowcount colcount :as dimensions] [x y :as coords]]
  (let [r (Math/round (Math/sqrt rowcount))
        c (Math/round (Math/sqrt colcount))
        x' (* (quot x r) r)
        y' (* (quot y c) c)]
    (for [x'' (range x' (+ x' r))
          y'' (range y' (+ y' c))]
      [x'' y''])))

(defn peers
  [[rowcount colcount :as dimensions] [x y :as coords]]
  (let [rows (for [i (range rowcount) :when (not= i y)] [x i])
        cols (for [i (range colcount) :when (not= i x)] [i y])
        blks (remove (partial = [x y]) (->blks dimensions coords))]
    (set (concat rows cols blks))))

(def peers9 (memoize (partial peers [9 9])))
(def peers4 (memoize (partial peers [4 4])))

(defn domain
  [coords board]
    (->> (peers9 coords)
         (map #(get-in board %))
         (reduce (fn [dom v]
                   (remove #(= v %) dom)) (range 1 10))))

(defn domain-map
  [board]
  (into {}
    (for [i (range 9)
          j (range 9)]
      [[i j] (domain [i j] board)])))

(defn most-constrained
  [d-map]
  (->> d-map
       (filter (comp (partial < 1) count second))
       (sort-by (comp count second))
       first))

(defn solved?
  [d-map]
  (->> d-map
       (map (comp count second))
       (every? (partial = 1))))

(defn d-map->board
  [d-map]
  (->> (for [i (range 9)
             j (range 9)]
         (first (d-map [i j])))
       (partition 9)
       (map vec)
       vec))

(def almost-solved-board
  [[3 9 5  6 1 8  2 7 4]
   [1 6 4  9 7 2  3 5 8]
   [2 8 7  5 3 4  6 1 9]

   [5 3 6  8 4 1  9 2 7]
   [7 1 0  3 2 5  8 4 6]
   [8 4 0  7 6 0  5 3 0]

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

(declare eliminate assign)
(defn eliminate
  [d-map target v]
  (let [domain (d-map target)]
    (if (contains? (set domain) v)
      (let [domain (remove (partial = v) domain)]
        (condp = (count domain)
          0 nil
          1 (assign d-map target (first domain))
          (assoc d-map target domain)))
      d-map)))

(defn assign
  [d-map target v]
  (let [d-map (assoc d-map target (list v))
        peers (peers9 target)]
    (reduce-true #(eliminate %1 %2 v) d-map peers)))

(defn search'
  [d-map]
  (when d-map
    (cond
      (solved? d-map) (d-map->board d-map)
      :else (let [[target possibles] (most-constrained d-map)]
              (some #(search' (assign d-map target %)) possibles)))))
(defn search
  [board]
  (search' (domain-map board)))

(defn -main []
  (search empty-board))