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 <tzach.livya...@gmail.com> 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 <konrad.hin...@laposte.net> 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 clojure@googlegroups.com
To unsubscribe from this group, send email to 
clojure+unsubscr...@googlegroups.com
For more options, visit this group at 
http://groups.google.com/group/clojure?hl=en
-~----------~----~----~----~------~----~------~--~---

Reply via email to