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

数独(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给不给审核,只有他们知道

运行效果如图: