The magazine of the Melbourne PC User Group Solving Sudoku Ken Holmes |
|
Ken Holmes has written another of his fantastic programs —this time he shows us how to solve the popular game Sudoku |
Are you feeling out of the mainstream because you haven't taken to Sudoku with
enthusiasm? Well, l have tried only a couple. There may be more sophisticated
approaches, but the obvious way would seem to be to try to see the weak spots
and concentrate on, say, a row, using a soft pencil to jot, in each cell, the
possible values which don't clash with the set values in that cell's row, column
or 3 x 3 square. Then, hopefully, you will see that some value appears only in
one cell of the row and it can therefore be boldly written in. Now, switching to
the column through that cell or the 3 x 3 square, repeat the process. I imagine
it would get progressively easier as the cells fill up but I haven't gone that
far, since I consider there are more exciting things to do in life.
However, the opportunity to write a program to solve it was irresistible. I
would not, for a moment, suggest using the program to solve the daily puzzle
(that would be pointless), but it might be useful to the composers to check that
there was only one solution. I imagine they may have such a program already.
This is an obvious case for a recursive procedure. Such a procedure uses a
single piece of code which can call up another copy of the same code, within
itself, and wait for it to do its job and return, to then go out of existence.
The second copy can also call up a third copy and so on. In this program, for
example, there are 81 copies running simultaneously when it reaches the final
cell, ie. one for each cell. In the meantime, it will have run up numerous dead
ends and backed out, creating and deleting numerous copies of the procedure.
The Program
We use Visual Basic 6 since many use it and it is similar in commands,
punctuation and structure to the DOS-based Basics such as QuickBasic. It is not
the Visual Basic 2005 Express, as distributed on the March, 2006, monthly DVD;
that is object-oriented and markedly dissimilar.
As may be seen in the code and in the screen captures, there is some initial
housekeeping with a "Draw Grid" Menu to draw the grids, one for the
original puzzle and one for the working solution. There are two arrays, cvorig
(x, y) for the puzzle and c (x, y) for the working grid. Clicking the "Enter
Puzzle" Menu enables the mouse to alternately select a cell and then allot it a
value; the value is entered in both grids. Figure 1 shows a puzzle fully
entered, with the "Select Cell" invitation showing; it is ignored if ready to
solve.
Clicking the "Solve Puzzle" Menu initiates the recurse() Sub for the top/ left
cell (column 1, row 1). Unless its value has already been allotted, each value
from 1 to 9 will be checked to see if it clashes with the same value in the row
or column or 3 x 3 square. When a valid value is found it is allotted and
recurse() is called for column 2, row 1, with recurse(1, 1) remaining in
existence. This process continues down the grid; if no valid value is found for
the next cell, the recurse() ends and it reverts to the previous cell for a
fresh try. The location travels down and up the grid with many, many
unsuccessful forays until it manages to reach the bottom right cell. Bingo! A
solution. A message Box pops up to advise this and the solution is displayed in
the solution grid. In Figure 2 the Message Box shows that it is the first
solution, found after 6852 recursions taking 550 milliseconds.
|
|
|
There may be more than one solution, so clicking away the Message Box lets it
back off up the grid, exploring the untried values in all the other cells. Each
time it reaches the final cell we have another solution and we count them.
Eventually, it will get back to the first cell and when it has done that enough
times to exhaust all the initial possibilities for that cell, recurse(1, 1) will
finish [in mnusolvepuzzle()] and a Message Box will advise the total number of
solutions. We also have a counter in recurse() so that we can record the total
number of times that a recursion is opened; also, each Message Box gives elapsed
time. In Figure 3 we see there is still only one solution after 14,287 recusions
taking 5460 milliseconds. These features will be useful when solving the
five-grid Sudoku, as discussed later.
Investigations
Now that we have the donkey work available to solve a Sudoku, in a second or so
after it is entered, we can explore some interesting areas.
When it finally returns to cell(1, 1), the solution grid will be back in its
original state ie. identical to the puzzle grid (Figure 3). We can modify it and
solve it again. Presumably, all published Sudokus have a single solution but,
for example, I took one and solved it; then I deleted clue values, separately
one at a time, and determined the number of solutions. The results were 38, 10,
43, 213, 45, 21 and 2. This is enough to give the general picture. Next, I
filled in an extra clue in the puzzle. Using the value for the cell from the
solution, there was still one solution, as you would expect since it is the same
solution. Entering a different number, which, of course, must not conflict with
other clues in its row, column or 3 x 3 square, there was no solution – again as
you would expect. The cut-off is sharp. Counting the number of clues in ten Sudokus gave seven at 28, one at 26, one at 29 and one at 30; so this is not a
reliable indicator for a single solution.
The Five-Grid Sudoku
These have a central Sudoku with another at each corner, sharing a common 3 x 3
square. We are told they need to be solved together, implying that they are
interdependent and can't be solved one at a time. Our program proves useful in
solving these. For a start we can count the number of solutions for each of the
five, as a stand-alone; for example, in one case we found that the central
Sudoku had 2 solutions and the corners 1, 1, 12 and 50. The obvious next step was to solve a single-solution
corner one, giving, in this case, six extra clues in the 3 x 3 square common
with the central one and, thus, giving it a single-solution. In turn, this
ensured that the others were solvable. When solving manually you do not, of
course, know which is the single-solution one.
|
|
The initial numbers of clues were 29 for the centre and 26, 25, 26 and 26 for
the corners; the total recursions were 5041 for the centre and 1360, 5101, 18356
and 132715 respectively for the corners. There is here a vague correlation of
the number of recursions with the number of solutions but not with the number of
clues.
Another five-gridder gave more interesting results. The central one had only 21
clues and gave 37934 solutions after 13,230,000 recursions! Obviously the extra
blank spaces rapidly multiply the optional pathways to try. The corner ones had
24, 24, 24 and 24 clues and gave 127, 348, 294 and 1 solutions after 114,771,
46,929, 2,714,683 and 1,257,533 recursions respectively. Thankfully, the
single-solution gave the starting point to solve it all. But there seems to be
little correlation; obviously it depends very much on the particular pattern of
numbers in each puzzle.
I assume it might be possible to encounter a five-gridder with no
single-solution element. In that case it would be a simple modification to the
program to put in extra Message Box pauses to allow copying more solutions for
the starting Sudoku.
Conclusion
Although a computer program adopts a straight-forward trial-and-error approach
it gets a complete, reliable result and with alacrity. Most single Sudokus are
solved in a second or less. The 13,230,000 recursions mentioned above took about
16 minutes; again, the program could be changed to end after, say, 10 solutions.
Listing 1 [ Download text version here ] Visual Basic Code to Solve Sudoku PuzzlesOption Explicit: DefInt A-Z 'All integers except where specified Dim cvorig(1 To 9, 1 To 9), c(1 To 9, 1 To 9) 'Original and ... Dim i, j, x, y, xp, yp, mx, my '... working values. Dim entering, solno!, cnt!, Start!, TTime As Long Private Sub mnuexit_Click() End End Sub Private Sub mnudrawgrid_Click() 'Draw both grids For i = 1000 To 5500 Step 500 'Vertical lines For j = 1000 To 5500 Step 500 'Horizontal lines Line (1000, j)-(5500, j) 'Puzzle grid Line (i, 1000)-(i, 5500) Line (7000, j)-(11500, j) 'Solution grid Line (i + 6000, 1000)-(i + 6000, 5500) Next: Next 'Now for doubled lines For i = 1020 To 5520 Step 1500 'Vertical lines For j = 1020 To 5520 Step 1500 'Horizontal lines Line (1000, j)-(5500, j) 'Puzzle grid Line (i, 1000)-(i, 5500) Line (7000, j)-(11500, j) 'Solution grid Line (i + 6000, 1000)-(i + 6000, 5500) Next: Next 'Draw cell values grid For i = 500 To 5500 Step 500 'Vertical lines For j = 6500 To 7000 Step 500 'Horizontal lines Line (i, 6500)-(i, 7000) Line (500, j)-(5500, j) Next: Next For i = 0 To 9 'Enter values in grid CurrentX = 600 + i * 500: CurrentY = 6600: Print Str(i) Next 'Now print grid titles CurrentX = 2000: CurrentY = 100: Print "ORIGINAL PUZZLE" CurrentX = 8500: CurrentY = 100: Print "SOLUTION" CurrentX = 2400: CurrentY = 5600: Print "CELL VALUES" End Sub Public Sub PrintCell(xc, yc, v, grid) 'grid=0 for puzzle cell Dim xp, yp 'grid=1 for solution cell xp = xc * 500 + 600 + grid * 6000: yp = yc * 500 + 600 Line (xp, yp)-Step(220, 250), &H80000005, BF 'Blank & print value CurrentX = xp: CurrentY = yp: If v > 0 Then Print Str(v) End Sub 'Note. Don't print zero Public Sub Message() TTime = (Timer - Start) * 1000 'convert to millisecs (Long Integer) MsgBox "Solution " + Str(solno) + Chr(13) + Chr(10) + "Recursions " + Str(cnt) + Chr(13) + Chr(10) + "Time " + Str(TTime) 'Note. MsgBox must be all on one line End Sub Private Sub mnuenterp_Click() entering = 1 'enables entering of puzzle CurrentX = 2400: CurrentY = 600: Print "SELECT CELL" End Sub Private Sub Form_MouseDown(Button%, Shift%, x!, y!) 'Mouse is only used for menues, entering puzzle and message boxes. If entering = 1 Then 'Selecting cell by clicking in "Puzzle" area If x > 1000 And x < 5500 And y > 1000 And y < 5500 Then mx = x \ 500 - 1: my = y \ 500 - 1: entering = 2 'Cell identified CurrentX = 2400: CurrentY = 6100: Print "ALLOT VALUE" Line (2400, 600)-(4200, 900), &H80000005, BF 'Blanks "SELECT CELL" End If 'Next mouse click must be to allot value. ElseIf entering = 2 Then 'Allotting value by clicking in "Allot" area If x > 500 And x < 5500 And y > 6500 And y < 7000 Then cvorig(mx, my) = x \ 500 - 1: c(mx, my) = cvorig(mx, my) Call PrintCell(mx, my, cvorig(mx, my), 0) 'Print in Puzzle grid Call PrintCell(mx, my, c(mx, my), 1) 'Print in Solution grid entering = 1: CurrentX = 2400: CurrentY = 600: Print "SELECT CELL" Line (2400, 6100)-(4200, 6400), &H80000005, BF 'Blank "ALLOT VALUE" End If 'Next mouse click must be to select cell (or start solving). End If End Sub Private Sub mnusolvepuzzle_Click() 'Initiate solution Line (2400, 600)-(4200, 900), &H80000005, BF 'Delete instructions Line (2400, 6100)-(4200, 6400), &H80000005, BF: entering = 0 CurrentX = 8600: CurrentY = 600: Print "SOLVING": solno = 0: cnt = 0 Start = Timer Call recurse(1, 1) 'start the recursion at cell(1, 1) Call Message End Sub Public Sub recurse(cx%, cy%) 'Recursive procedure. Called for 'each of 81 cells in turn. If meets dead end, Sub ends and it reverts 'to previous Sub to try another value there. Solution is when cell '(9,9) reached and OK. First solution printed (Usually only 'one) and, if allowed to continue, it ends back at cell(1, 1), having 'exhausted all paths and with puzzle in original presentation. Dim nx%, ny%, try%, k%, l%, sx%, sy% Dim valid As Boolean cnt = cnt + 1 'Count number of recursions opened nx = cx + 1: ny = cy 'Determine next cell along row. If nx = 10 Then 'If at end of row, ... nx = 1: ny = ny + 1 '... move to start of next row. End If 'See later, ny = 10 will finish. If cvorig(cx, cy) > 0 Then 'Bypass if value fixed by puzzle If ny < 10 Then 'Provided not on last cell, ... Call recurse(nx, ny) '... move to next cell Else 'If on last cell, ... solno = solno + 1 If solno = 1 Then Call Message 'For first solution only End If 'Solution found Else 'Value NOT set in puzzle (ie. =0) For try = 1 To 9 'Check all possible values valid = True: c(cx, cy) = 0 'Assume number valid and then ... For k = 1 To 9 '... check if clashes with rules If try = c(k, cy) Then valid = False 'check along row for clashes If valid = False Then Exit For Next If valid = False Then GoTo done 'Already false so bypass next checks For k = 1 To 9 If try = c(cx, k) Then valid = False'Check down column for clashes If valid = False Then Exit For Next If valid = False Then GoTo done 'Find top/left cell of 3 X 3 square sx = ((cx - 1) \ 3) * 3 + 1: sy = ((cy - 1) \ 3) * 3 + 1 For k = 0 To 2: For l = 0 To 2 'Check in small square for clashes If try = c(sx + k, sy + l) Then valid = False If valid = False Then Exit For 'get out of inner loop Next If valid = False Then Exit For 'get out of outer loop Next done: 'Check completed. Now, if number valid, ... If valid = True Then '...go on to next cell. If NOT test next 'try'. c(cx, cy) = try 'Put into array Call PrintCell(cx, cy, try, 1) 'Print in Solution grid If ny < 10 Then 'Not reached final cell Call recurse(nx, ny) 'Move to next cell Else 'Reached final cell. Solution found solno = solno + 1 'Increment solution count If solno = 1 Then Call Message 'For first solution only End If End If Next End If 'If recurse() reaches here, there are no further values to try, 'we need to restore original value. Sub will end and it will 'revert to the previous cell which will try further possibilities. c(cx, cy) = cvorig(cx, cy) 'Restore original value and Call PrintCell(cx, cy, cvorig(cx, cy), 1) 'Print in Solution grid End Sub |
Reprinted from the May 2006 issue of PC Update, the magazine of Melbourne PC
User Group, Australia
