
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