Skip to content

Instantly share code, notes, and snippets.


kawpuh/solve.clj Secret

Last active July 23, 2023 20:33
Show Gist options
  • Save kawpuh/b7a842af2ca24e8a0c382b88ed1bbb62 to your computer and use it in GitHub Desktop.
Save kawpuh/b7a842af2ca24e8a0c382b88ed1bbb62 to your computer and use it in GitHub Desktop.
Sudoku Solver
(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]
(fn [result candidate-locations]
(case (count candidate-locations)
0 (reduced nil)
1 (assign result (first candidate-locations) value)
(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))]
(fn [result elim-posn]
(eliminate result elim-posn elim-value))
(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)
(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]
(fn [result elim-value]
(eliminate result posn elim-value))
(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))
(some #(try-options option-board % 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"
(searcher option-board (get-unsolved-set option-board)))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment