This popular Japanese number puzzle has just one easy rule:
In every Row, every Column and every 3x3 sub-grid, all the numbers from 1 to 9 should appear, but only once in each row, column and sub-grid.
+------+-------+------+
| 0 0 0 | 7 0 0 | 4 0 0 |
| 0 3 0 | 0 9 0 | 0 2 0 |
| 4 0 0 | 0 0 5 | 0 0 0 |
+------+-------+------+
| 0 0 8 | 0 0 0 | 0 0 5 |
| 0 9 0 | 0 3 0 | 0 7 0 |
| 6 0 0 | 0 0 0 | 3 0 0 |
+------+-------+------+
| 0 0 0 | 4 0 0 | 0 0 6 |
| 0 7 0 | 0 2 0 | 0 9 0 |
| 0 0 5 | 0 0 8 | 0 0 0 |
+------+-------+------+
Replace the 0's with the digits required to satisfy the rule.
(In reply to
re(2): Haley's Comet vrs. Penny's Loafer: And the winner is.... by Charlie)
I changed my program to continue searching after finding a solution. It finishes in 1.03 seconds. (+/- .03 seconds).
To make sure it was really searching for all solutions, I changed the first 7 in the puzzle (1st row, 4th number) to a 0, creating many more possible solutions. Result: 82 solutions found in 10.094 seconds. Changing the 7 to a 0 causes most of the searches to go much deeper before they run into a dead end, accounting for the longer time. I'd be interested to hear how your guys' programs do with this change--especially if you get the same number of solutions. My revised program listing follows.
A response to pcbouhid: The great thing about this puzzle is that it's not only interesting in its own right, but it has spawned some of us to look at computer solution algrothims to puzzles of this kind. When a puzzle triggers lots of serendipitous discussion...I like it even better. To me that's the real fun of this web site.
Module Module1
Dim board As Integer(,) = { _
{0, 0, 0, 7, 0, 0, 4, 0, 0}, _
{0, 3, 0, 0, 9, 0, 0, 2, 0}, _
{4, 0, 0, 0, 0, 5, 0, 0, 0}, _
{0, 0, 8, 0, 0, 0, 0, 0, 5}, _
{0, 9, 0, 0, 3, 0, 0, 7, 0}, _
{6, 0, 0, 0, 0, 0, 3, 0, 0}, _
{0, 0, 0, 4, 0, 0, 0, 0, 6}, _
{0, 7, 0, 0, 2, 0, 0, 9, 0}, _
{0, 0, 5, 0, 0, 8, 0, 0, 0} _
}
Dim solutionCount As Integer
Sub Main()
Dim i As Integer, j As Integer
Dim startTime As DateTime = Now
test(0, 0)
Dim endTime As DateTime = Now
Dim timeDiff As Decimal = endTime.Minute * 60 + endTime.Second + CDec(endTime.Millisecond / 1000) _
- startTime.Minute * 60 - startTime.Second - CDec(startTime.Millisecond / 1000)
Console.WriteLine(timeDiff & " seconds elapsed.")
Console.ReadLine()
End Sub
Sub test(ByVal x As Integer, ByVal y As Integer)
If board(x, y) = 0 Then
For n As Integer = 1 To 9
board(x, y) = n
'Is this unique in this column?
For m As Integer = 0 To 8
If m <> y And board(x, m) = n Then
board(x, y) = 0
Exit For
End If
Next
If board(x, y) <> 0 Then
'Is this unique in this row?
For m As Integer = 0 To 8
If m <> x And board(m, y) = n Then
board(x, y) = 0
Exit For
End If
Next
If board(x, y) <> 0 Then
'Is this unique in this subgrid?
Dim xmin As Integer = Int(x / 3) * 3 'returns 0,3, or 6
Dim ymin As Integer = Int(y / 3) * 3
For xx As Integer = xmin To xmin + 2
For yy As Integer = ymin To ymin + 2
If board(xx, yy) = n And (xx <> x Or yy <> y) Then
board(x, y) = 0
Exit For
End If
Next
If board(x, y) = 0 Then Exit For
Next
If board(x, y) <> 0 Then
If x = 8 And y = 8 Then
printBoard()
board(x, y) = 0 'signal to keep looking
Else
testNext(x, y)
board(x, y) = 0
End If
End If
End If
End If
Next
If board(x, y) = 0 Then Return
Else
testNext(x, y)
End If
End Sub
Sub testNext(ByVal x, ByVal y)
y += 1
If y > 8 Then
y = 0
x += 1
End If
If x > 8 Then
Return
Else
test(x, y)
End If
End Sub
Sub printBoard()
solutionCount += 1
Console.WriteLine("Solution #" & solutionCount)
For i As Integer = 0 To 8
For j As Integer = 0 To 8
Console.Write(board(i, j))
Next
Console.WriteLine()
Next
Console.WriteLine()
End Sub
End Module
re(3): Haley's Comet vrs. Penny's Loafer: And the winner is....
