Sudoku Solver

solve.clj

(declare eliminate assign)

(defn col-peers [[row col]]
  (for [i (range 9)
        :when (not= col i)]
    (list row i)))

(defn row-peers [[row col]]
  (for [i (range 9)
        :when (not= row i)]
    (list i col)))

(defn box-peers [[row col]]
  (let [start-row (- row (mod row 3))
        start-col (- col (mod col 3))]
    (for [inc-i (range 3)
          inc-j (range 3)
          :let [i (+ start-row inc-i)
                j (+ start-col inc-j)]
          :when (not (and (= i row) (= j col)))]
      (list (+ start-row inc-i) (+ start-col inc-j)))))

(def peer-groups (juxt row-peers col-peers box-peers))

(defn all-peers [posn]
  (apply concat (peer-groups posn)))

(defn propagate-in
  "Check if our elimination means that a peer-group only has 1 remaining location for value"
  [option-board posn value]
  (reduce
   (fn [result candidate-locations]
     (case (count candidate-locations)
       0 (reduced nil)
       1 (assign result (first candidate-locations) value)
       result))
   option-board
   (map (partial filter #(contains? (get option-board %) value))
        (peer-groups posn))))

(defn propagate-out
  "Posn has been determined, we can remove that option from its peers"
  [option-board posn]
  (let [elim-value (first (get option-board posn))]
    (reduce
     (fn [result elim-posn]
       (eliminate result elim-posn elim-value))
     option-board
     (all-peers posn))))

(defn eliminate
  "Remove elim-value from position and propagate consequences
  expected to be called from a reduce, and may return value wrapped in reduced"
  [option-board posn elim-value]
  (if-not (contains? (get option-board posn) elim-value)
    option-board
    (let [result (update option-board posn #(disj % elim-value))]
      (case (count (get result posn))
        0 (reduced nil)
        1 (-> result (propagate-out posn) (propagate-in posn elim-value))
        (propagate-in result posn elim-value)))))

(defn assign
  "Eliminate all other values associated with posn"
  [option-board posn value]
  (reduce
   (fn [result elim-value]
     (eliminate result posn elim-value))
   option-board
   (disj (get option-board posn) value)))

(declare searcher)

(defn try-options [option-board posn unsolved-set]
  (some #(some-> option-board (assign posn %) (searcher (disj unsolved-set posn)))
        (get option-board posn)))

(defn searcher
  [option-board unsolved-set]
  (if (= 0 (count unsolved-set))
    option-board
    (some #(try-options option-board % unsolved-set)
          unsolved-set)))

(defn get-unsolved-set [option-board]
  (->> option-board (filter #(> (count (val %)) 1)) (map key) set))

(defn search
  "option-board is a map of {'(row col) #{options}}
  e.g. in a blank board options would all be 1-9"
  [option-board]
  (searcher option-board (get-unsolved-set option-board)))