Solving Sudoku Puzzles in Common Lisp

Discussion

Sudoku puzzles are usually 9x9 matrices with some of the cells initialized with positive numbers from 1 to 9. The object is to fill in the remaining cells so all numbers 1 to 9 are present in each row, column and 3x3 major subsquare. In general, these kinds of puzzles can be of any size square matrix whose sides are are k*k for integer k.

I first worked out this algorithm in 2007. I wrote a generalized solver that would solve any puzzles k^2 by k^2 in size, for integer k. The algorithm walks the solution tree of possibilities recursively, always picking one of the higher probability guesses at each branch, which generally speeds up the search time tremendously.

Then I ran across , "Solving Sudoku in Matlab," in the Matlab Newsletter, January 2010. Curious to test the mettle of my algorithm against his, I was chagrined to discover mine actually didn't converge on his "difficult" problem (see Figure 1) at all. It revealed a curious bug (thanks alot, Cleve!), which caused me to rethink my algorithm and come up with an even faster one. This is my new code.

Environment

There are no dependencies other than two trivial macros I use all the time from a graham package: (WHEN-BIND and IF-BIND); both can be found in ANSI Common Lisp¹

The code

The code itself can be downloaded here.

The heart of it is the following two functions:

  (defun get-guess-cell (state)
    "Returns the coordinates (row col) of (one of) the cells with the
    least non-singular number of values in it. "
    (let (coords vals)
      (with-matrix (r c state coords)
        (unless (singleton-p state r c)
          (when (or (null vals)
                    (> vals (length (aref (puzzle-matrix state) r c))))
            (setf vals (length (aref (puzzle-matrix state) r c))
                  coords (list r c))
            (when (= 2 vals)
              (return-from get-guess-cell (list r c))))))))
  
  (defun sudoku (state)
    "The recursive tree walker - returns NULL if blind alley or state if
      reaches a solution."
    (let ((stable-state (update-cells state)))
      (cond ((null stable-state)          ; blind alley
             NIL)
            ((solved-p stable-state)      ; we're done
             stable-state)
            (t                            ; make a guess
             (destructuring-bind (row col) (get-guess-cell stable-state)
              (dolist (val (aref (puzzle-matrix stable-state) row col) NIL)
                (let ((new-state (copy-singleton-puzzle stable-state))) 
                  (setf (aref (puzzle-matrix new-state) row col) (list val))
                  (graham:when-bind (ret-state (sudoku new-state))
                    (return-from sudoku ret-state)))))))))

The second is the recursion which always starts by calling UPDATE-CELLS, a function which goes through the puzzle filling in any singletons (cells which have only one possible number). The first function searches through the list of non-singleton cells and finds the first with only two possibilities. Guessing one of these will have the highest probability of success. Once all the two-guess cells are gone, there are typically very few unsolved cells left, so it is probably not worth the overhead of sorting machinery (I have only partially quantified this). The speed up of stopping at the first pair though is tremendous.

Figure 1. Cleve's example sudoku problem which required 19,422 steps for his algorithm to solve.

(1) ANSI Common Lisp by Paul Graham

The "Sudoku Challenge"

Here is the solution to Cleve's problem above. I didn't take the time to write graphic output like his — this pretty-printer will have to do. But algorithm only took 631 trial guesses to solve it, instead of 19,422 steps that his took. I don't know how long his took in time - he didn't say. I'm guessing it wasn't as fast as 0.219 seconds either.

Initial state:
 (  2     3     4  )
 (6               3)
 (    4       5    )
 (      8   6      )
 (8       1       6)
 (      7   5      )
 (    7       6    )
 (4               8)
 (  3     4     2  )
Evaluation took:
  0.219 seconds of real time
  0.224014 seconds of total run time (0.224014 user, 0.000000 system)
  102.28% CPU
  702,784,496 processor cycles
  12,760,240 bytes consed

Solution:
 (9 2 5 6 3 1 8 4 7)
 (6 1 8 5 7 4 2 9 3)
 (3 7 4 9 8 2 5 6 1)
 (7 4 9 8 2 6 1 3 5)
 (8 5 2 4 1 3 9 7 6)
 (1 6 3 7 9 5 4 8 2)
 (2 8 7 3 5 9 6 1 4)
 (4 9 1 2 6 7 3 5 8)
 (5 3 6 1 4 8 7 2 9)
631 trials were needed.

Other Examples

Here are several more puzzles that I obtained off the internet along with my solutions:

Initial state:
 (5 3     7        )
 (6     1 9 5      )
 (  9           6  )
 (8       6       3)
 (4     8         1)
 (7       2       6)
 (  6         2    )
 (      4 1 9     5)
 (              7 9)
Evaluation took:
  0.002 seconds of real time
  0.000000 seconds of total run time (0.000000 user, 0.000000 system)
  0.00% CPU
  7,488,752 processor cycles
  134,592 bytes consed

Solution:
 (5 3 4 6 7 2 1 9 8)
 (6 8 7 1 9 5 4 3 2)
 (2 9 1 3 4 8 5 6 7)
 (8 2 9 5 6 1 7 4 3)
 (4 5 6 8 3 7 9 2 1)
 (7 1 3 9 2 4 8 5 6)
 (9 6 8 7 5 3 2 1 4)
 (3 7 2 4 1 9 6 8 5)
 (1 4 5 2 8 6 3 7 9)
9 trials were needed.

Initial state:
 (  3     7     9  )
 (4     1   3     8)
 (    8       3    )
 (  6   4       5  )
 (5       3       6)
 (  4       6   7  )
 (    1       6    )
 (6     2   9     1)
 (  7     8     4  )
Evaluation took:
  0.028 seconds of real time
  0.028002 seconds of total run time (0.028002 user, 0.000000 system)
  100.00% CPU
  88,543,254 processor cycles
  1,591,520 bytes consed

Solution:
 (1 3 6 8 7 5 2 9 4)
 (4 9 7 1 2 3 5 6 8)
 (2 5 8 9 6 4 3 1 7)
 (7 6 3 4 1 2 8 5 9)
 (5 1 9 7 3 8 4 2 6)
 (8 4 2 5 9 6 1 7 3)
 (9 2 1 3 4 7 6 8 5)
 (6 8 4 2 5 9 7 3 1)
 (3 7 5 6 8 1 9 4 2)
75 trials were needed.

Initial state:
 (      9 3     7  )
 (    1       9    )
 (    8       4    )
 (7     6 1     8  )
 (  2           4  )
 (  9     5 7     6)
 (    9       2    )
 (    5       8    )
 (  3     2 1      )
Evaluation took:
  0.001 seconds of real time
  0.004000 seconds of total run time (0.004000 user, 0.000000 system)
  400.00% CPU
  3,499,224 processor cycles
  61,072 bytes consed

Solution:
 (5 4 2 9 3 8 6 7 1)
 (3 7 1 2 4 6 9 5 8)
 (9 6 8 1 7 5 4 3 2)
 (7 5 4 6 1 2 3 8 9)
 (1 2 6 3 8 9 7 4 5)
 (8 9 3 4 5 7 1 2 6)
 (4 8 9 5 6 3 2 1 7)
 (2 1 5 7 9 4 8 6 3)
 (6 3 7 8 2 1 5 9 4)
4 trials were needed.

The last one was supposed to be "hard".

Initial state:
 (6     8   5      )
 (    1       8    )
 (  2     4     3  )
 (  6       7     2)
 (    2       3    )
 (4     9       7  )
 (  9     3     1  )
 (    3       6    )
 (      6   8     3)
Evaluation took:
  0.153 seconds of real time
  0.152010 seconds of total run time (0.152010 user, 0.000000 system)
  99.35% CPU
  490,135,224 processor cycles
  8,705,008 bytes consed

Solution:
 (6 3 7 8 9 5 4 2 1)
 (9 4 1 3 7 2 8 6 5)
 (8 2 5 1 4 6 9 3 7)
 (3 6 9 5 8 7 1 4 2)
 (7 5 2 4 6 1 3 8 9)
 (4 1 8 9 2 3 5 7 6)
 (5 9 6 2 3 4 7 1 8)
 (2 8 3 7 1 9 6 5 4)
 (1 7 4 6 5 8 2 9 3)
408 trials were needed.