Visual Basic 数独求解器和生成器
数独游戏的求解器/生成器。
引言
我最初尝试使用 VBA 在 Excel 中开发数独求解器。与 Excel 交互了几次后,我改用 VS2005 的 Visual Basic。在完成了一个处理 9x9(经典)数独的版本后,我还将代码改编为解决武士数独(5 个重叠的 9x9 网格)。我想同时提供源代码和演示,因为我发现 Visual Basic 中可以学习的完全功能的求解器并不多。
基于逻辑的求解器和用户界面可能花费了最多的工作——实际的蛮力求解器实际上编写得很快。
术语
本文不深入探讨数独的规则或解决数独谜题的详细方法。如果您想了解背景知识,请使用搜索引擎。但是,基本原则是将数字 1-9 放入行、列和子网格中,以便每行、每列和每个子网格只包含一个数字。然而,下面使用了一些术语来解释代码。
- 单元格 - 可以放置数字 1-9 的单个单元格。
- 线索/已知数 - 在上面的第一个图像中,第二个和第三个单元格分别包含数字 7 和 6。
- 候选数/铅笔标记 - 在上面的图像中,第一个单元格包含三个候选数(2、3 和 9)。在尝试解决谜题时,跟踪各种候选数非常重要。
- 行 - 一组 9 个单元格,从屏幕向下水平排列。
- 列 - 一组 9 个单元格,从屏幕向下垂直排列。
- 子网格 - 一组 9 个单元格,排列成 3x3 的分组。
- 邻居 - 在 9x9 的经典网格中,每个单元格可以“看到”多达 20 个其他单元格(同一行、同一列和同一子网格中的其他单元格)。由于一行、一列或一个子网格中不能重复数字的规则,如果您将一个数字作为某个单元格的解,则该数字可以从其每个邻居的候选数中移除。武士数独的邻居有点不同,因为由于五个重叠的网格,一些单元格将具有更多的邻居。
关注点
求解器将尝试使用逻辑步骤来求解谜题,但也会采用蛮力算法来解决更难的谜题。因此,它几乎可以立即解决大多数经典的 9x9 数独谜题,或者在几秒钟内解决大多数武士数独谜题(取决于计算机)。诚然,有一些 C++ 求解器每秒可以解决数百或数千个谜题。但是,我想要一些能够合理快速地解决谜题,同时又能逐步展示解决谜题的原因的方法。
有一个自定义控件使用 GDI+ 来绘制线索和候选数(铅笔标记)。使用大量单独的标签或其他控件刷新速度太慢。对于武士数独,刷新速度仍然可能有点慢,但通常还可以。
与我见过的许多其他求解器不同,它们倾向于使用 81(9) 的二维数组来存储每个单元格的可能候选数,这个求解器使用长度为 81 的单个数组来存储所有可能的候选数。每个候选数都使用 2 ^ (candidate-1) 的公式赋予一个值,以生成每个候选数的唯一位值(尽管我选择硬编码此值以尽量减少此计算的需要)。因此,候选数 1 = 位值 1,候选数 2 = 位值 2,候选数 3 = 位值 4,候选数 4 = 位值 8,依此类推,候选数 5 = 位值 16。
所以,如果单元格 2 有候选数 1、3 和 4 作为可能的值,您将设置数组的值为
_vsCandidateAvailableBits(2) = 13 (bit values 1+4+8)
而不是必须做类似的事情
_vsCandidateAvailableBits(2,1) = True
_vsCandidateAvailableBits(2,3) = True
_vsCandidateAvailableBits(2,4) = True
这种方法的优点是,许多基于逻辑的数独解法都基于子集,所以如果您想检查单元格 81 是否只可用候选数 1 和 9,那么只需做一个简单的检查就能知道 _vsCandidateAvailableBits(81) = 257
(位值 1 + 位值 256)。
实际的求解器本身被编码为一个类,并使用深度优先搜索。它将继续搜索多个解,或者可以设置为在找到指定数量的解后退出。
Dim solver As New clsSudokuSolver
' will exit if more than the entered number of solutions are found.
solver.intQuit = intSolverQuit
solver.blnClassic = True ' or can set to false if solving a samurai puzzle
solver.strGrid = strGame ' input puzzle string
solver.vsSolvers = My.Settings._DefaultSolvers ' solving methods
要运行求解器,您需要调用 solver._vsUnique()
来测试是否有唯一解。
然后您可以执行类似 dim blnUnique as boolean = solver._vsUnique()
的操作来检查一个谜题是否只有一个有效解。
蛮力求解器
蛮力求解器存在于自己的类中。它基本上是一个迭代循环,通过尝试找到最佳猜测来搜索解,并在猜测不正确时回溯。
首要任务是加载初始游戏(可以是包含 81 个字符的字符串(用于 9x9 数独)或五个用换行符分隔的 81 个字符的字符串(用于武士数独))。有效输入是起始线索的字符 1-9,以及句点或零字符,用于表示未填充/空的单元格。
Private Function _load(ByVal strGrid As String, Optional ByVal _
StrCandidates As String = "") As Boolean
'---load puzzle---'
_vsSteps = 1
vsTried = 0
ReDim _vsUnsolvedCells(0)
Dim i As Integer
Dim intCellOffset As Integer
Dim strClues As String = ""
Dim g As Integer
Dim j As Integer
Dim intBit As Integer
Dim blnCandidates As Boolean = False
Dim arrCandidates() As String = Split(StrCandidates, arrDivider)
If arrCandidates.Length >= 81 Then blnCandidates = True
_u = -1
_vsCandidateCount(0) = -1
For i = 1 To _vsCandidateCount.Length - 1
_vsCandidateAvailableBits(i) = 511
_vsStoreCandidateBits(i) = 0
_vsCandidateCount(i) = -1
If blnClassic = False Then
If Not blnIgnoreSamurai(i) Then _vsCandidateCount(i) = 9
Else
_vsCandidateCount(i) = 9
End If
_vsLastGuess(i) = 0
_vsCandidatePtr(i) = 1
_vsSolution(i - 1) = 0
_vsPeers(i) = 0
Next
strGrid = Trim(strGrid)
Dim midStr As String = ""
Dim ptr As Integer
Dim arrayPeers(0) As String
Dim intValue As Integer
Dim nextGuess As Integer = 0
Dim nextCandidate As Integer = 0
_vsUnsolvedCells(0) = New List(Of Integer)
Dim intMaxGrid As Integer = 5
If blnClassic Then intMaxGrid = 1
For g = 1 To intMaxGrid
For i = 1 To 81
Select Case blnClassic
Case True
midStr = Mid(strGrid, i, 1)
intCellOffset = i
Case False
midStr = Mid(strGrid, i + (81 * (g - 1)), 1)
intCellOffset = intSamuraiOffset(i, g)
End Select
Select Case Asc(midStr)
Case 46, 48
'---blank---
If (blnClassic Or Not blnIgnoreSamurai(intCellOffset)) _
AndAlso _vsUnsolvedCells(0).IndexOf(intCellOffset) = -1 Then
_u += 1
_vsUnsolvedCells(0).Add(intCellOffset)
If blnCandidates = True Then
'---insert known candidates---
_vsCandidateAvailableBits(intCellOffset) = _
arrCandidates(intCellOffset - 1)
_vsCandidateCount(intCellOffset) = _
intCountBits(arrCandidates(intCellOffset - 1))
End If
End If
Case 49 To 57
'---numeric 1 to 9---
intValue = CInt(midStr)
intBit = intGetBit(intValue)
If _vsSolution(intCellOffset - 1) = 0 Then
_vsSolution(intCellOffset - 1) = intValue
_vsCandidateCount(intCellOffset) = -1
If blnCandidates = False Then
Select Case blnClassic
Case True
arrayPeers = arrPeers(intCellOffset)
Case False
arrayPeers = ArrSamuraiPeers(intCellOffset)
End Select
'---remove value from peers---
For j = 0 To UBound(arrayPeers)
ptr = arrayPeers(j)
If _vsCandidateAvailableBits(ptr) And intBit Then
_vsCandidateAvailableBits(ptr) -= intBit
_vsCandidateCount(ptr) -= 1
End If
Next
End If
End If
Case Else
'Debug.Print("exiting due to invalid" & _
' "character " & Asc(midStr))
_load = False
Exit Function
End Select
strClues += midStr
Next
If Not blnClassic Then strClues += vbCrLf
Next
_load = True
strFormatClues = strClues
End Function
一旦有了有效的输入,我们就调用一个函数来循环测试所有解(尽管可以设置一个值(intQuit
)在找到所需的解数时退出)。例如,如果您想确保一个谜题是有效的(例如,只有一个唯一解),那么 intQuit
可以设置为“2”(这样它在找到两个解后就会退出)。但是,在某些情况下(如下文所述),找到多个解对于解决武士数独可能很有用。
主要的求解函数设置如下。
Private Function _vsbackTrack(ByVal strGrid As String, _
ByRef StrSolution As String, Optional ByVal _
StrCandidates As String = "") As Boolean
Dim intMax As Integer = 0
Dim intSolutionMax As Integer = 0
ReDim Solutions(0) ' array to hold solutions to the puzzle
Dim i As Integer
Dim j As Integer
Dim intSolutions As Integer ' counts number of puzzle solutions
Dim testPeers(0) As String
Dim tempPeers As String
Dim nextGuess As Integer = 0
Dim nextCandidate As Integer = 0
Select Case blnClassic
' sets up maximum length of arrays depending
' on whether it is a 9x9 or samurai puzzle
Case True
intMax = 81
intSolutionMax = 80
Case False
intMax = 441
intSolutionMax = 440
End Select
ReDim _vsSolution(intSolutionMax)
ReDim _vsPeers(intMax)
ReDim _vsCandidateCount(intMax)
ReDim _vsCandidateAvailableBits(intMax)
ReDim _vsCandidatePtr(intMax)
ReDim _vsLastGuess(intMax)
ReDim _vsStoreCandidateBits(intMax)
ReDim _vsRemovePeers(intMax)
If Not _load(strGrid:=strGrid, StrCandidates:=StrCandidates) Then
' input puzzle failed to load properly, so exit
intCountSolutions = intSolutions
Exit Function
End If
'---NOTE: Code for logic based solving methods is usually called here---'
'---But removed for purposes of explaining the brute force solver---'
'---END NOTE---'
_vsUnsolvedCells(0).Sort() '---order an array list of empty/unsolved cells---'
'---NOTE: Some specific code removed here for dealing with samurai puzzles---'
'---This is discussed separately below---'
'---END NOTE---'
'---setup peer array. This is intended to save processing time by---'
'---having the 'peers' for each empty cell pre-loaded, rather than needing---'
'---to recalculate peers throughout the iterative puzzle solving process---'
For i = 0 To _u
tempPeers = ""
Select Case blnClassic
'---this code retrieves a hard coded list of 'peers' (other cells---'
'---that share a row, column or subgrid with the empty cell---'
Case True
testPeers = arrPeers(_vsUnsolvedCells(0).Item(i))
Case False
testPeers = ArrSamuraiPeers(_vsUnsolvedCells(0).Item(i))
End Select
For j = 0 To UBound(testPeers)
'---Check to see if each peer is unsolved or not.
'---If the peer is empty/unsolved, then add it to a string---'
If _vsUnsolvedCells(0).IndexOf(CInt(testPeers(j))) > -1 Then
If tempPeers = "" Then
tempPeers = testPeers(j)
Else
tempPeers += "," & testPeers(j)
End If
End If
Next
_vsPeers(_vsUnsolvedCells(0).Item(i)) = tempPeers
'---save the list of peers for each empty cell---'
Next
'---end setup peer array---'
If _u = -1 Then
'---puzzle already solved by logic---'
Exit Function
End If
While _vsSteps <= _u + 1 AndAlso _vsSteps > 0
'---look for the next unfilled cell. The routine intFindCell looks---'
'---for the next empty cell containing only one candidate---'
'---or failing that, the unfilled cell with the lowest number of---'
'---candidates which will result in the maximum number of possible---'
'---eliminations. There may be room for improvement/experimentation in
'---terms of picking the next cell to test---'
If nextGuess = 0 Then nextGuess = intFindCell()
If nextGuess > 0 Then
'---we have an empty cell, so select the next candidate---'
'---to test in this cell---'
nextCandidate = IntNextCandidate(nextGuess)
If nextCandidate > 0 Then
vsTried += 1
MakeGuess(nextGuess, nextCandidate)
nextGuess = 0
Else
If _vsSteps <= 1 Then
'---we've reached the end of the search
'---there are no more steps to try---'
Select Case intSolutions
Case 0
'---invalid puzzle (no solution)---'
_vsbackTrack = False
intCountSolutions = 0
Exit Function
Case 1
'---single solution---'
_vsbackTrack = True
intCountSolutions = 1
Exit Function
Case Else
'---multiple solutions---'
_vsbackTrack = False
intCountSolutions = intSolutions
Exit Function
End Select
Else
'---need to go back...no remaining candidates for this cell---'
UndoGuess(nextGuess)
End If
End If
Else
If _vsSteps = 0 Then
_vsbackTrack = False
'---invalid puzzle---'
intCountSolutions = intSolutions
Exit Function
Else
'---cannot go further...so need to go back---'
UndoGuess()
End If
End If
If _vsSteps > _u + 1 Then
'---we have filled all the unfilled cells with a solution---'
'---so increase array size and add next solution to solution array---'
intSolutions += 1
ReDim Preserve Solutions(intSolutions - 1)
Select Case blnClassic
Case True
StrSolution = strWriteSolution(intGrid:=1)
Case False
StrSolution = strWriteSolution()
End Select
Solutions(intSolutions - 1) = StrSolution
If intSolutions = intQuit Then
'---quit if number of solutions exceeds a given number---'
_vsbackTrack = False
intCountSolutions = intSolutions
Exit Function
End If
'---solution found so backtrack---'
UndoGuess()
End If
End While
End Function
蛮力求解器的关键部分是进行“超前观察”,尝试挑选下一个最佳的未填充单元格来放置可用候选数。下面的函数旨在通过寻找具有最少可用候选数的空单元格来完成此操作。如果存在只有一个候选数的单元格,则选择该单元格,因为这是最佳猜测。否则,目标是寻找具有最小候选数的未填充单元格(这可以减少整体搜索空间/求解时间)。作为额外的改进,如果存在多个未填充单元格,每个单元格具有相同数量的候选数,则使用一个额外的循环来确定这些单元格中哪个具有最多的邻居(基于这样的假设:任何猜测都会有最大的机会从谜题中消除更多候选数)。可能有其他方法可以尝试,因为找到最佳的下一步操作最有可能提高求解速度。
Private Function intFindCell() As Integer
Dim i As Integer
Dim j As Integer
Dim ptr As Integer
Dim ptr2 As Integer
Dim arrPeers() As String
Dim intCell As Integer
Dim intCount As Integer
Dim intPeerCount As Integer
For i = 0 To 9
'---iterate array that holds number of candidates for each cell---'
'---starting from lowest possible candidates to highest---'
ptr = Array.IndexOf(_vsCandidateCount, i)
If ptr > -1 Then
intFindCell = ptr
If i = 0 Then
intFindCell = 0
End If
If i = 1 Then Exit Function
While ptr2 > -1
ptr2 = Array.IndexOf(_vsCandidateCount, i, ptr2)
If ptr2 > -1 Then
arrPeers = Split(_vsPeers(ptr2), arrDivider)
intPeerCount = 0
For j = 0 To UBound(arrPeers)
If arrPeers(j) <> "" AndAlso _
_vsUnsolvedCells(0).IndexOf(arrPeers(j)) > -1 Then
intPeerCount += 1
End If
Next
If intPeerCount >= intCount Then
'---look for unfilled cell with largest number of peers---'
intCount = intPeerCount
intCell = ptr2
End If
ptr2 += 1
End If
End While
intFindCell = intCell
Exit For
End If
Next
End Function
一旦选择了未填充单元格,下一步就是找到该单元格中的下一个可用候选数,如下面所述
Private Function IntNextCandidate(ByVal intCell As Integer, _
Optional ByVal blnLookup As Boolean = False) As Integer
Dim c As Integer
Dim intBit As Integer
For c = _vsCandidatePtr(intCell) To 9
intBit = intGetBit(c)
If _vsCandidateAvailableBits(intCell) And intBit Then
IntNextCandidate = c
If blnLookup = False Then _vsCandidatePtr(intCell) = c + 1
'---increment the value for _vsCandidatePtr---'
'---by incrementing _vsCandidatePtr it is faster to loop---'
'---through and find the next available candidate to be tested---'
Exit Function
End If
Next
End Function
所需的其他主要项目是分别用于进行猜测和回溯猜测的函数。一个关键问题是如何跟踪由于猜测而从单元格的邻居中删除了哪些候选数。如果不准确记录这一点,就无法像需要的那样正确地撤销猜测。
Private Function MakeGuess(ByVal intCell As Integer, _
ByVal intCandidate As Integer) As Boolean
Dim arrayPeers() As String
Dim j As Integer
Dim ptr As Integer
Dim intBit As Integer
_vsSolution(intCell - 1) = intCandidate
_vsCandidateCount(intCell) = -1
_vsLastGuess(_vsSteps) = intCell
'----remove from unsolved cells list---
_vsUnsolvedCells(0).Remove(intCell)
setCandidates(intCell, intCandidate)
_vsSteps += 1
arrayPeers = Split(_vsPeers(intCell), ",")
'---remove value from peers---
_vsRemovePeers(intCell) = New List(Of Integer)
intBit = intGetBit(intCandidate)
For j = 0 To UBound(arrayPeers)
ptr = arrayPeers(j)
If _vsSolution(ptr - 1) = 0 AndAlso _
(_vsCandidateAvailableBits(ptr) And intBit) Then
_vsCandidateAvailableBits(ptr) -= intBit
_vsCandidateCount(ptr) -= 1
_vsRemovePeers(intCell).Add(ptr)
If _vsCandidateCount(ptr) = 0 Then Exit Function
End If
Next
End Function
Private Function UndoGuess(Optional ByRef nextGuess As Integer = 0) As Boolean
Dim intCell As Integer = 0
Dim intCandidate As Integer = 0
Dim blnLoop As Boolean = True
_vsCandidatePtr(nextGuess) = 1
_vsSteps -= 1
If _vsSteps = 0 Then Exit Function
intCell = _vsLastGuess(_vsSteps)
intCandidate = _vsSolution(intCell - 1)
'---restore to unsolved list---
_vsUnsolvedCells(0).Add(intCell)
'---sort unsolved cells---
_vsUnsolvedCells(0).Sort()
Dim j As Integer
Dim i As Integer = 1
Dim c As Integer
Dim tC As Integer
Dim intBit As Integer = intGetBit(intCandidate)
Dim lbit As Integer = 0
'---restore candidates in this cell---
If intCell > 0 Then
If Not (_vsStoreCandidateBits(intCell) And intBit) Then
_vsStoreCandidateBits(intCell) += intBit
End If
End If
lbit = _vsStoreCandidateBits(intCell)
_vsCandidateAvailableBits(intCell) = 0
For c = 1 To 9
intBit = intGetBit(c)
If lbit And intBit Then
_vsCandidateAvailableBits(intCell) += intBit
tC += 1
End If
Next
nextGuess = intCell
_vsSolution(intCell - 1) = 0
_vsCandidateCount(intCell) = tC
If intCell = 0 Then
'---no valid solution found---
Exit Function
End If
'---restore value to peers---
Dim pCell As Integer
For j = 0 To _vsRemovePeers(intCell).Count - 1
pCell = _vsRemovePeers(intCell).Item(j)
_vsCandidateAvailableBits(pCell) += intGetBit(intCandidate)
_vsCandidateCount(pCell) += 1
Next
'---end restore values to peers---
End Function
蛮力 - 武士数独
所有数独谜题都被认为是 NP 完全问题。简而言之,随着网格大小的增加,找到解所需的时间/计算量也会增加。
对于武士数独,其中有五个重叠的网格,不幸的是,不能仅仅逐个解决这五个 9x9 的网格,因为通常情况下,单独考虑的每个网格的唯一解很少或根本没有——您通常需要将所有五个重叠的网格作为一个单独的谜题来解决。
但是,下面的代码用于帮助缩短更难的武士数独的求解时间。它基本上涉及测试是否可以找到一个 9x9 网格的多于 1 个但少于 100 个解。显然,这并不总是奏效,因为单个网格的解通常超过 100 个。但是,如果解少于 100 个,则会检查解的集合。如果一个空单元格在找到的每个解中都恰好出现相同的数字,那么我们就可以将该数字放入其中,因为这一定是该单元格的正确答案。
If _u > -1 Then
If Not blnClassic Then
Dim g As Integer
For g = 1 To 5
Dim Solver As New clsSudokuSolver
Solver.blnClassic = True
Solver.strGrid = strWriteSolution(intGrid:=g)
Solver.vsSolvers = My.Settings._UniqueSolvers
Solver.intQuit = 100
Solver._vsUnique()
If Solver.intCountSolutions > 1 _
AndAlso Solver.intCountSolutions < Solver.intQuit Then
Dim s As Integer
Dim c As Integer
Dim m(81) As Integer
Dim chk(81) As Boolean
Dim chr As String
Dim intChr As Integer
For c = 1 To 81
chk(c) = True
Next
For s = 0 To UBound(Solver.Solutions)
If Array.IndexOf(chk, True) = -1 Then Exit For
For c = 1 To 81
chr = Mid(Solver.Solutions(s), c, 1)
intChr = CInt(chr)
If m(c) = 0 Then
m(c) = intChr
Else
If intChr <> m(c) Then
chk(c) = False
m(c) = -1
End If
End If
Next
Next
Dim strRevised As String = ""
Dim blnRevised As Boolean
Dim ptr As Integer
Dim arrayPeers() As String
Dim intBit As Integer
For c = 1 To 81
chr = Mid(Solver.strGrid, c, 1)
If chr = "." Then
'---unique value across all solutions---
'---and not found in starting grid---
If m(c) > 0 Then
strRevised += CStr(m(c))
blnRevised = True
'---place solution---
ptr = intSamuraiOffset(c, g)
If _vsSolution(ptr - 1) = 0 Then
_vsSolution(ptr - 1) = m(c)
_vsCandidateCount(ptr) = -1
_vsUnsolvedCells(0).Remove(ptr)
arrayPeers = ArrSamuraiPeers(ptr)
intBit = intGetBit(m(c))
'remove value from peers
For j = 0 To UBound(arrayPeers)
If _vsSolution(arrayPeers(j) - 1) = 0 _
AndAlso (_vsCandidateAvailableBits(arrayPeers(j)) _
And intBit) Then
_vsCandidateAvailableBits(arrayPeers(j)) -= intBit
_vsCandidateCount(arrayPeers(j)) -= 1
End If
Next
_u -= 1
End If
'--end place solution---
Else
strRevised += chr
End If
Else
strRevised += chr
End If
Next
If blnRevised Then
blnRevised = False
End If
End If
Next
End If
End If
生成谜题
我想确保我能够生成不同难度的数独谜题。我最初只是尝试从填好的网格开始,然后随机删除数字……但这只会产生很多简单的谜题,但很少有困难的。下面的代码似乎有助于生成更广泛的谜题。下面的代码可用于在删除单元格中的线索时产生一定的随机性,但约束条件是特定数字的数量会保持不变(例如,它可能会删除 7 个数字 '8' 和 6 个数字 '3',下次可能会删除 7 个数字 '2' 和 6 个数字 '4',依此类推)。
Function RemoveCellsNoSymmetry(ByVal strGrid As String) As String
Dim fp As Integer
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim p As Integer
Dim r As Integer
Dim r2 As Integer
Dim intRemoved As Integer
Dim strGeneratorSeed As String = "0122211000"
Dim randomArr() As String = _
Split(GenerateRandomStr(arrDivider), arrDivider)
Dim randomArr2() As String
Dim ptr As Integer
Dim arrGame(0) As Integer
Dim arrPos(0) As Integer
Dim midStr As String = ""
strGrid = Replace(strGrid, vbCrLf, "")
ReDim arrGame(81)
'---load game into array---
For p = 1 To 81
midStr = Mid(strGrid, p, 1)
ptr = p
If midStr <> "" AndAlso CInt(midStr) > 0 Then
arrGame(ptr) = CInt(midStr)
End If
Next
'---finish load game into array---
For i = 0 To 9
r = Mid(strGeneratorSeed, i + 1, 1)
For j = 1 To CInt(r)
Debug.Print(randomArr(k) & " will be found " & i & _
" times so delete " & 9 - i & " instances")
'---start delete---'
fp = -1
For p = 1 To 81
If arrGame(p) = randomArr(k) Then
fp += 1
ReDim Preserve arrPos(fp)
'---save all positions where digit found---'
arrPos(fp) = p
End If
Next
'---randomly remove from array of cell positions---'
intRemoved = 0
randomArr2 = Split(GenerateRandomStr(arrDivider), arrDivider)
For r2 = 0 To UBound(randomArr2)
If intRemoved >= (9 - i) Then Exit For
arrGame(arrPos(randomArr2(r2) - 1)) = 0
intRemoved += 1
Next
'---end delete---
k += 1
Next
Next
RemoveCellsNoSymmetry = ""
For p = 1 To 81
ptr = p
If arrGame(ptr) <> "0" Then
RemoveCellsNoSymmetry += CStr(arrGame(ptr))
Else
RemoveCellsNoSymmetry += "."
End If
Next
End Function
下一步/改进
我写这个主要是为了个人挑战。我想做到的关键是提高蛮力求解器的速度,特别是让它能够更快地解决武士数独,并提高重绘速度,使 GDI 自定义控件刷新得更快。我也可能会做一个版本来处理其他变体(例如,拼图数独)。
示例应用
示例应用程序功能齐全,可让您输入、求解、优化和生成经典的(9x9)数独谜题,并允许您输入和求解武士数独。