一段代码,求解数独(九宫格)游戏

数独(Sudoku)游戏是从1-9共9个数字中,装在3x3x3x3的单元格内

每个小的3x3内的数值只能重复一遍,同时每行及每列的数值也只能重复一遍

每个单元格都必须有数值,不能留空

解法简介:

创建一个行列表,标定各个数值的使用情况

创建9个方块表,标定各个数值的使用情况

递归每一个不是预设的单元格,找出没有被标定的数值,直到所有单元格被填充

Visual Basic 6.0代码

Option Explicit

Private Const MIN_UNIT = 0 '1
Private Const MAX_UNIT = 80 '81

Private Const MIN_NUMBER = 1
Private Const MAX_NUMBER = 9

Private Const MIN_GRID_ROW = 1
Private Const MIN_GRID_COL = 1
Private Const MAX_GRID_ROW = 3
Private Const MAX_GRID_COL = 3

Private Const GRID_UNSELECT = 0
Private Const GRID_SELECTED = 1
Private Const GRID_CONSTANT = 2

Private Const TEXT_FAILED = -1 '数值无效
Private Const TEXT_USABLE = 0 '数值可填

Private Const CELL_USABLE = 0 '单元可填
Private Const CELL_LOCKED = 1 '单元固定

Private Type T_UNIT
GridRow As Byte '全局行号(1-9)
GridCol As Byte '全局列号
CellRow As Byte '小格行号(1-3)
CellCol As Byte '小格列号
UnitRow As Byte '格内行号(1-3)
UnitCol As Byte '格内列号
Index As Integer '序号(1-81)
End Type

Private Type T_FLAG
RowFlags(MIN_NUMBER To MAX_NUMBER) As Long '每个数字情况
ColFlags(MIN_NUMBER To MAX_NUMBER) As Long '每个数字情况
End Type

Private Type T_CELL
Value As Byte '单元值
RowId As Byte '全局行号(加速i*j+k, 遍历九宫格使用时顺便遍历全局行列)
ColId As Byte '全局列号(加速i*j+k)
Flags As Byte '属性
End Type

Private Type T_GRID
Value(MIN_GRID_ROW To MAX_GRID_ROW, MIN_GRID_COL To MAX_GRID_COL) As T_CELL
Flags(MIN_NUMBER To MAX_NUMBER) As Long '当前小九宫格每个数字情况
End Type

Private m_vtUnit(MIN_UNIT To MAX_UNIT) As T_UNIT
Private m_vtMatrix(MIN_GRID_ROW To MAX_GRID_ROW, MIN_GRID_COL To MAX_GRID_COL) As T_GRID '全局数据
Private m_dwFlags(MIN_NUMBER To MAX_NUMBER) As T_FLAG '全局行列每个数字情况

Private Sub InitUnit() 'debug ok
Dim i1 As Integer, j1 As Integer
Dim i2 As Integer, j2 As Integer
Dim i As Integer, j As Integer
Dim k As Integer

k = MIN_UNIT
Do While k <= MAX_UNIT
i = k Mod MAX_NUMBER '全局列号(0-8)
j = (k - i) / MAX_NUMBER '全局行号(0-8)
i2 = i Mod MAX_GRID_COL '单元列号(单元在九宫格内的列号: 0-2)
j2 = j Mod MAX_GRID_ROW '单元行号(单元在九宫格内的行号: 0-2)
i1 = (i - i2) / MAX_GRID_COL '方格列号(九宫格的列号: 0-2)
j1 = (j - j2) / MAX_GRID_ROW '方格行号(九宫格的行号: 0-2)
'
With m_vtUnit(k)
.GridRow = j + MIN_NUMBER
.GridCol = i + MIN_NUMBER
.CellRow = j1 + MIN_GRID_ROW
.CellCol = i1 + MIN_GRID_COL
.UnitRow = j2 + MIN_GRID_ROW
.UnitCol = i2 + MIN_GRID_COL
.Index = k
End With
'
k = k + 1
Loop
End Sub

Private Function GetTextValue(txt As TextBox) As Long
Dim s As String
Dim n As Long

s = Trim(txt.Text)
If s = "" Then
GetTextValue = TEXT_USABLE
Exit Function
End If
If IsNumeric(s) = False Then
GetTextValue = TEXT_FAILED '未设置
Exit Function '无效内容
End If
n = CLng(s)
If n < MIN_NUMBER Or n > MAX_NUMBER Then
GetTextValue = TEXT_FAILED '未设置
Exit Function '无效数值
End If
GetTextValue = n
End Function

Private Function GetTextMatrix() As Boolean
Dim i1 As Integer, j1 As Integer
Dim i2 As Integer, j2 As Integer
Dim i As Integer, j As Integer
Dim k As Integer
Dim n As Long
'
k = 0
Do While k < Me.txtNum.Count '<行扫描>
With m_vtUnit(k)
i = .GridCol '界面的列号(第N行第i1列)
j = .GridRow '界面的行号(第N列第j1行)
i1 = .CellCol '大方格列号
j1 = .CellRow '大方格行号
i2 = .UnitCol '小方格列号
j2 = .UnitRow '小方格行号
End With
'
n = GetTextValue(txtNum(k))
If n = TEXT_FAILED Then
Exit Do
End If
With m_vtMatrix(j1, i1)
With .Value(j2, i2)
.Value = n
.RowId = j
.ColId = i
If n <> TEXT_USABLE Then
.Flags = CELL_LOCKED
Else
.Flags = CELL_USABLE
End If
End With
End With
'Debug.Print "第[" & CStr(j1) & "," & CStr(i1) & "]方块的第(" & CStr(j2) & "," & CStr(i2) & ")小格值为: " & CStr(n)
'
k = k + 1
Loop
'
For i1 = MIN_NUMBER To MAX_NUMBER
With m_dwFlags(i1)
For j1 = MIN_NUMBER To MAX_NUMBER
.RowFlags(j1) = GRID_UNSELECT '默认未使用(全局行列)
.ColFlags(j1) = GRID_UNSELECT '默认未使用(全局行列)
Next j1
End With
Next i1
'
For j1 = MIN_GRID_ROW To MAX_GRID_ROW '每一行
For i1 = MIN_GRID_COL To MAX_GRID_COL '每一列
'
With m_vtMatrix(j1, i1) '方块
For k = MIN_NUMBER To MAX_NUMBER
.Flags(k) = GRID_UNSELECT '默认未使用(方块)
Next k
'遍历方块内数字使用情况
For j2 = MIN_GRID_ROW To MAX_GRID_ROW '每一行
For i2 = MIN_GRID_COL To MAX_GRID_COL '每一列
With .Value(j2, i2) '单元
j = .RowId
i = .ColId
k = .Value
End With
If k <> TEXT_USABLE Then
'
If .Flags(k) = GRID_CONSTANT Then
Exit Function '九宫格内出现相同数值
End If
.Flags(k) = GRID_CONSTANT '这个数值在方块内被固定选择
'
With m_dwFlags(j)
If .RowFlags(k) = GRID_CONSTANT Then
Exit Function '全局行出现相同数值
End If
.RowFlags(k) = GRID_CONSTANT '这个数值在全局行被固定选择
End With
With m_dwFlags(i)
If .ColFlags(k) = GRID_CONSTANT Then
Exit Function '全局列出现相同数值
End If
.ColFlags(k) = GRID_CONSTANT '这个数值在全局列被固定选择
End With
End If
Next i2
Next j2
End With
Next i1
Next j1
GetTextMatrix = True
End Function

'
Public Function Crack(ByVal nIndex As Long) As Boolean
Dim i1 As Integer, j1 As Integer
Dim i2 As Integer, j2 As Integer
Dim i As Integer, j As Integer
Dim k As Integer

If nIndex < MIN_UNIT Then
Exit Function '数组越界
End If
If nIndex > MAX_UNIT Then
Crack = True
Exit Function '最后一个单元是固定的且前面都已求解完成
End If
With m_vtUnit(nIndex)
i = .GridCol '界面的列号(第N行第i1列)
j = .GridRow '界面的行号(第N列第j1行)
i1 = .CellCol '大方格列号
j1 = .CellRow '大方格行号
i2 = .UnitCol '小方格列号
j2 = .UnitRow '小方格行号
End With

'寻找一个空格, 从1-9尝试行列重复和周边重复, 所有空格填完结束, 否则无解
With m_vtMatrix(j1, i1) '方块
With .Value(j2, i2) '单元
If .Flags = CELL_LOCKED Then
Crack = Crack(nIndex + 1) '固定不可编辑传递下一节点
Exit Function
End If
'k = .Value '取当前单元值
End With
'If k < MIN_NUMBER Then
k = MIN_NUMBER
'End If
labLoop:
If k > MAX_NUMBER Then
Exit Function '无解
End If
If .Flags(k) <> GRID_UNSELECT Then
k = k + 1
GoTo labLoop '九宫格固定或已选, 检查下一个值
End If
If m_dwFlags(j).RowFlags(k) <> GRID_UNSELECT Then
k = k + 1
GoTo labLoop '全局行固定或已选, 检查下一个值
End If
If m_dwFlags(i).ColFlags(k) <> GRID_UNSELECT Then
k = k + 1
GoTo labLoop '全局列固定或已选, 检查下一个值
End If

With .Value(j2, i2) '单元
.Value = k '设当前单元值
End With
.Flags(k) = GRID_SELECTED '选择
m_dwFlags(j).RowFlags(k) = GRID_SELECTED '选择
m_dwFlags(i).ColFlags(k) = GRID_SELECTED '选择

If nIndex = MAX_UNIT Then
Crack = True '最后一个单元, 不再递归(最多递归81次, 1024K堆栈完全满足)
Exit Function
End If
If Crack(nIndex + 1) = False Then
.Flags(k) = GRID_UNSELECT '取消选择
m_dwFlags(j).RowFlags(k) = GRID_UNSELECT '取消选择(必定是前面选择的)
m_dwFlags(i).ColFlags(k) = GRID_UNSELECT '取消选择
k = k + 1
GoTo labLoop '此值无解, 检查下一个值
Else
Crack = True '正解
Exit Function
End If
End With
End Function

Private Sub ShowMaxtrix()
Dim i1 As Integer, j1 As Integer
Dim i2 As Integer, j2 As Integer
Dim i As Integer, j As Integer
Dim k As Integer

k = 0
Do While k <= MAX_UNIT
With m_vtUnit(k)
'i = .GridCol '界面的列号(第N行第i1列)
'j = .GridRow '界面的行号(第N列第j1行)
i1 = .CellCol '大方格列号
j1 = .CellRow '大方格行号
i2 = .UnitCol '小方格列号
j2 = .UnitRow '小方格行号
End With
'
With m_vtMatrix(j1, i1) '方块
'
With .Value(j2, i2) '单元
If .Flags = CELL_LOCKED Then
txtNum.Item(k).ForeColor = &H888888
Else
txtNum.Item(k).ForeColor = &H881618
End If
'
txtNum.Item(k).Text = CStr(.Value)
End With
End With
'
k = k + 1
Loop
End Sub

Private Sub btnClear_Click()
Dim i As Integer

For i = 0 To MAX_UNIT
txtNum(i).Text = ""
Next i
End Sub

Private Sub btnCrack_Click()
If GetTextMatrix() = False Then
Exit Sub
End If
'
If Me.Crack(MIN_UNIT) = False Then
MsgBox "failed", vbExclamation '无解
Else
Call ShowMaxtrix
MsgBox "finish", vbInformation '有解
End If
End Sub

Private Sub Form_Load()
Dim i As Integer
Dim j As Integer
Dim k As Integer
'Dim s As String

'
Call InitUnit
'
Me.ScaleMode = vbPixels
For i = 0 To 8 '每一行
For j = 0 To 8 '每一列
If k = 0 Then
txtNum(k).Left = 4 '60 / 15
txtNum(k).Top = 4
txtNum(k).FontBold = True
txtNum(k).Text = ""
Else
Load txtNum(k)
txtNum(k).Left = 4 + (txtNum(0).Width + 3) * j '逐行
txtNum(k).Top = 4 + (txtNum(0).Height + 3) * i
txtNum(k).Visible = True
End If
'With m_vtUnit(k)
' s = "{" & CStr(.GridRow) & "," & CStr(.GridCol) & "}: "
' s = s & "[" & CStr(.CellRow) & "," & CStr(.CellCol) & "].("
' s = s & CStr(.UnitRow) & "," & CStr(.UnitCol) & ")"
'End With
'txtNum(k).ToolTipText = s
k = k + 1
Next j
Next i
'最难九宫格
txtNum(0).Text = "8"
txtNum(11).Text = "3"
txtNum(12).Text = "6"
txtNum(19).Text = "7"
txtNum(22).Text = "9"
txtNum(24).Text = "2"
txtNum(28).Text = "5"
txtNum(32).Text = "7"
txtNum(40).Text = "4"
txtNum(41).Text = "5"
txtNum(42).Text = "7"
txtNum(48).Text = "1"
txtNum(52).Text = "3"
txtNum(56).Text = "1"
txtNum(61).Text = "6"
txtNum(62).Text = "8"
txtNum(65).Text = "8"
txtNum(66).Text = "5"
txtNum(70).Text = "1"
txtNum(73).Text = "9"
txtNum(78).Text = "4"
'
'Label1.Caption = ""
Label1.Caption = "数独: 每个行列的数值只能出现一次, 每个3x3小方块内数值也只能出现一次, 数值范围1-9, 不可留空"
Label1.WordWrap = True
Label1.AutoSize = True
End Sub


源码将在随后上传到我的资源,至于CSDN给不给审核,只有他们知道
运行效果如图: