Sudoku Solver

The program:

(defun print-sudoku (sudoku)
  (loop for y from 0 below 9
        finally (terpri)
        do (loop for x from 0 below 9 finally (terpri) do
                 (format t "~A" (aref sudoku y x)))) )

(defun digits-in-region (sudoku x y)
  (loop
   with x0 = (* 3 (truncate x 3))
   with y0 = (* 3 (truncate y 3))
   with x1 = (+ x0 2)
   with y1 = (+ y0 2)
   for x from x0 to x1
   append (loop for y from y0 to y1
                for digit = (aref sudoku y x)
                when (/= digit 0) collect digit)))

(defun digits-in-row (sudoku y)
  (loop for x from 0 below 9
        for digit = (aref sudoku y x)
        when (/= digit 0) collect digit))

(defun digits-in-column (sudoku x)
  (loop for y from 0 below 9
        for digit = (aref sudoku y x)
        when (/= digit 0) collect digit))

(defun create-missing (list)
  (loop for i from 1 to 9
        with result = '()
        finally (return result) do
        (unless (find i list) (push i result))))

(defun possible-digits (sudoku x y)
  (create-missing
   (union
    (digits-in-region sudoku x y)
    (union (digits-in-row sudoku y)
           (digits-in-column sudoku x)))))

(defun solve-next (sudoku x y)
  (when (= 9 (incf x))
    (when (= 9 (incf y))
      (print-sudoku sudoku)
      (return-from solve-next))
    (setf x 0))
  (if (/= 0 (aref sudoku y x))
      (solve-next sudoku x y)
    (let ((possible-digits (possible-digits sudoku x y)))
      (when possible-digits
        (dolist (digit possible-digits)
          (setf (aref sudoku y x) digit)
          (solve-next sudoku x y)
          (setf (aref sudoku y x) 0))))))

(defun solve (sudoku)
  (solve-next (make-array '(9 9) :initial-contents sudoku) -1 0))

Use it like this (write "0" for empty fields) :

(time (solve '((0 0 2 3 0 0 7 0 0) 
               (0 0 4 0 0 9 0 0 0) 
               (6 0 0 0 0 0 0 5 0) 
               (0 7 0 0 0 2 0 6 0) 
               (0 0 3 7 0 0 4 0 0) 
               (0 1 0 0 0 0 0 2 0) 
               (0 3 0 0 0 0 0 0 9) 
               (0 0 0 4 0 0 6 0 0) 
               (0 0 5 0 0 8 2 0 0))))
Timing the evaluation of SOLVE
182356794
354279816
697814352
479582163
263791485
518643927
836127549
921435678
745968231

user time    =      0.359
system time  =      0.000
Elapsed time =   0:00:00
Allocation   = 1872 bytes standard / 8132025 bytes conses
0 Page faults
Calls to %EVAL    34

20. Februar 2006, Frank Buß