Following your good advice, I also update the next-cell function to
work in a lazy way instead of sorting the values of the entire board.
The full source bellow.
Next phase: GUI.
;; sudoku solver by Tach
;; with the help of Konrad
(defn print-board [board]
"Pretty print the sudoku board"
(doseq [row board] (println row)))
(defn mod3range [x]
(let [start (- x (rem x 3))]
(range start (+ 3 start))))
(defn neighbors-pos [pos]
"return a collection of neighbors positions to pos"
(remove #(= pos %)
(distinct (concat
(for [y (range 3) z (range 3)] [(get pos 0) y z]) ; row
neighbors
(for [x (range 9)] [x (get pos 1) (get pos 2)]) ; col
neighbors
(for [x (mod3range (get pos 0)) z (range 3)] [x (get pos 1)
z]))) ; square neighbors;
))
(defn neighbors-values [board pos]
"return a list of neighbor positions values"
(map #(get-in board %) (neighbors-pos pos)))
(defn valid-values [board pos]
"return a list of values which does not violate the neighbors
values. return nil if the position already have a value"
(if (zero? (get-in board pos))
(clojure.set/difference (set (range 1 10)) (neighbors-values board
pos))
(seq nil)))
(defn map-board [board f]
"execute function f on each of the position on board. function
f get the position and the board as parameters"
(for [x (range 9) y (range 3) z (range 3)]
(let [pos [x y z]]
[pos (f board pos) ]
)))
(defn next-cell [board]
"return the next potential cell to set, and the valid alternatives"
(first (for [n (range 1 10)]
(filter
#(= n (count (second %)))
(map-board board valid-values)))))
(defn complete? [board]
(not (some #(second %)
(map-board board (fn [board pos] (zero? (get-in board pos)))))))
(defn all-solutions [board]
(if (complete? board)
(list board)
(let [[pos valid-values] (next-cell board)]
(apply concat (for [v valid-values]
(all-solutions (assoc-in board pos v)))))))
(defn sudoku [board]
"solve a sudoku problem"
(first (all-solutions board)))
;;; use the solver
(def *sudoku-problem*
[[[0 0 0] [5 0 0] [0 9 1]]
[[1 0 0] [8 6 0] [0 3 2]]
[[0 0 6] [9 3 0] [0 0 0]]
[[0 0 4] [6 0 0] [0 7 3]]
[[0 5 0] [4 9 3] [0 1 0]]
[[3 6 0] [0 0 8] [9 0 0]]
[[0 0 0] [0 8 5] [3 0 0]]
[[8 3 0] [0 1 6] [0 0 5]]
[[6 7 0] [0 0 9] [0 0 0]]])
(print-board (sudoku *sudoku-problem*))
On Jan 10, 10:22 pm, Tzach <[email protected]> wrote:
> Thanks Konrad
> A very elegant solution.
> 40 years of laziness, and I finally realize what a great feature the
> lazy evaluation is ;)
>
> Tzach
>
> On Jan 9, 3:30 pm, Konrad Hinsen <[email protected]> wrote:
>
> > On Jan 9, 2009, at 13:18, Tzach wrote:
>
> > > The main functionsudokuis recursive:
> > > 1. Getting asudokuboard as an input
> > > 2. Choosing the next empty (zero) cell to test, loop on all valid
> > > values, and callsudokuwith the new board
> > > 3. When a solution (board with no zero values) is found: throw.
>
> > > (defnsudoku[board]
> > > "solve asudokuproblem"
> > > (when (complete? board)
> > > (do
> > > (println "complete")
> > > (print-board board)
> > > (throw nil)))
> > > (let [cell (next-cell board)
> > > pos (first cell)
> > > valid-values (second cell)]
> > > (when cell
> > > (doseq [v valid-values]
> > > (sudoku(assoc-in board pos v)))
> > > )))
>
> > > Although it does work, we can all agree its pretty ugly, so I would
> > > appreciate your help on the following questions:
> > > 1. How to can I return a solution via the recursive stack with out
> > > throwing an exception? I understand there is no "return-from"
> > > facility.
>
> > The return value of a function is the last expression that was
> > evaluated. Yoursudokufunction could have a structure like this:
>
> > (defnsudoku[board]
> > "solve asudokuproblem"
> > (if (complete? board)
> > board
> > (let [...]
> > ..))
>
> > The problem is then in the let branch, as it can terminate without
> > returning a valid board.
>
> > > 2. Can this function be implemented as tail recursive (using loop?
> > > recur?)
>
> > As it is, no, because you have multiple recursive calls. However, I
> > wonder what those are good for. If I understand your algorithm
> > correctly, it find all valid values for the next cell to be filled,
> > and then tries for each of them to complete the puzzle, using a
> > recursive call.
>
> > I would rewrite the solver as a function that returns a lazy sequence
> > of valid solutions:
>
> > (defn all-solutions [board]
> > (if (complete? board)
> > (list board)
> > (let [[pos valid-values] (next-cell board)]
> > (apply concat (for [v valid-values]
> > (all-solutions (assoc-in board pos v)))))))
>
> > Note that you don't have to do anything to make the sequences lazy;
> > apply and for take care of that automatically.
> > The solver then just takes the first item of that sequence:
>
> > (defnsudoku[board]
> > "solve asudokuproblem"
> > (first (all-solutions board)))
>
> > Since the sequence is lazy, the remaining solutions (if any) are
> > never computed, so this version does not do more work than your
> > original one.
>
> > Konrad.
--~--~---------~--~----~------------~-------~--~----~
You received this message because you are subscribed to the Google Groups
"Clojure" group.
To post to this group, send email to [email protected]
To unsubscribe from this group, send email to
[email protected]
For more options, visit this group at
http://groups.google.com/group/clojure?hl=en
-~----------~----~----~----~------~----~------~--~---
