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ß