我正在VB.NET中编写一个Sudoku App。目前我正在为Sudoku益智生成器的实现工作。我写的那个有一个奇怪的问题，应用程序刚刚陷入停顿。起初我只是理性地假设我的代码中有一个无限循环。所以我添加了一个功能，如果do ... while循环连续运行超过50次，函数将重置。但那没有做任何事情！对于我的生活，我不能弄清楚我的程序发生了什么。如果有人能解释这个冻结，我会所以感激不尽。
这是我的功能/子/子程序：
Private Sub CreatePuzzle(ByVal Dificulty As Integer)
Dim Rand As New Random()
For Each Row As List(Of Box) In Rows
Dim UsedNumbers As New List(Of Integer)
Dim Column As Integer = 0
For Each Cell As Box In Row
Column = Cell.Column
Dim I As Integer
Do
I = Math.Floor(Rand.NextDouble() * 9) + 1
Loop While Arrays.Contains(UsedNumbers.ToArray(), I) Or _
Arrays.Contains(Box.GetValues(Columns(Column)), I) Or _
Arrays.Contains(Box.GetValues(Squares(Math.Floor(Column / 3D))), I)
Cell.Val(I)
UsedNumbers.Add(I)
Debug.Print("Row: " & "ABCDEFGHI"(Cell.Row) & ", Column: " & _
(Cell.Column + 1).ToString() & ", Square: " & Cell.Square.ToString() & _
", (Predicted) Square: " & Math.Floor(Column / 3D).ToString())
Debug.Print("I: " & I.ToString())
Debug.Print("")
Next
Next
End Sub
此外，以下是我用来表示Sudoku难题中的单元格的自定义Box类的实现：
Public Class Box
Private _Value As Integer = 0
Private _Row As Integer
Private _Column As Integer
Private _Square As Integer
Private Label As Label
Private _Name As String
Public ReadOnly Property Value As Integer
Get
Return _Value
End Get
End Property
Public ReadOnly Property Row As Integer
Get
Return _Row
End Get
End Property
Public ReadOnly Property Column As Integer
Get
Return _Column
End Get
End Property
Public ReadOnly Property Square As Integer
Get
Return _Square
End Get
End Property
Public ReadOnly Property Name As String
Get
Return Label.Name
End Get
End Property
Public Sub New(ByRef Box As Label)
Dim Values As String() = Box.Tag.ToString.Split(",")
If Not Box.Text = "" Then
_Value = Integer.Parse(Box.Text)
End If
_Row = Integer.Parse(Values(0))
_Column = Integer.Parse(Values(1))
_Square = Integer.Parse(Values(2))
Label = Box
End Sub
Public Sub Val(ByVal Digit As Char, ByRef PreVal As Integer, ByRef PrevSelect As Label)
Dim Value As Integer
If Integer.TryParse(Digit, Value) AndAlso Not Value = 0 Then
If Label.Text = "" Then
PreVal = 0
Else
PreVal = Integer.Parse(PrevSelect.Text)
End If
PrevSelect = Label
Label.Text = Digit
_Value = Value
End If
End Sub
Public Sub Val(ByVal Digit As Integer)
If Digit = 0 Then
Label.Text = ""
Else
Label.Text = Digit.ToString()
End If
_Value = Digit
End Sub
Public Shared Function GetValues(ByVal Boxes As List(Of Box)) As Integer()
Dim Output(Boxes.Count - 1) As Integer
For I As Integer = 0 To Output.GetUpperBound(0)
Output(I) = Boxes(I).Value
Next
Return Output
End Function
End Class
编辑：这是Arrays.Contains（）
的代码Function Contains(ByVal HayStack() As Integer, ByVal Needle As Integer) As Boolean
For I As Integer = 0 To HayStack.GetUpperBound(0)
If HayStack(I) = Needle Then
Return True
End If
Next
Return False
End Function
如果您需要查看任何自定义实施，请发表评论。
答案 0 :(得分：0)
好的......所以事实证明它不是一个无限循环，而是一个效率低下的算法，需要10分钟来创建拼图。
答案 1 :(得分：0)
我尝试创建一个数独谜题。使用该课程。
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim foo As New Puzzle()
RichTextBox1.Text = foo.Display
RichTextBox1.Refresh()
End Sub
班级
Public Class Puzzle
Private Shared PRNG As New Random
Private _thePuzzle As New List(Of List(Of Integer))
Public thePuzzle As New List(Of List(Of Integer))
Private base As List(Of Integer) = Enumerable.Range(1, 9).OrderBy(Function(x) PRNG.Next).ToList
Public Sub New(Optional empties As Integer = 27)
'creat base puzzle
For x As Integer = 0 To 2 'first three rows
Me._thePuzzle.Add(New List(Of Integer))
Me.thePuzzle.Add(New List(Of Integer))
Me._thePuzzle(x).AddRange(base)
'blocks of three from front to rear
base.AddRange(base.GetRange(0, 3))
base.RemoveRange(0, 3)
Next
'DebugHelp(Me._thePuzzle)
For x As Integer = 0 To 5 'next six rows
base.Clear()
base.AddRange(Me._thePuzzle(x))
base.Add(base(0))
base.RemoveAt(0)
Me._thePuzzle.Add(New List(Of Integer))
Me.thePuzzle.Add(New List(Of Integer))
Me._thePuzzle(Me._thePuzzle.Count - 1).AddRange(base)
Next
'DebugHelp(Me._thePuzzle)
'' shuffle
Const shuffles As Integer = 3
For sh As Integer = 1 To shuffles
Me.Shuffle()
Next
'visible
For r As Integer = 0 To Me._thePuzzle.Count - 1
Me.thePuzzle(r).AddRange(Me._thePuzzle(r))
Next
DebugHelp(Me.thePuzzle)
'set certain entries to zero
Dim idxs As List(Of Integer) = Enumerable.Range(0, 81).ToList
For x As Integer = 1 To empties
Dim rmx As Integer = PRNG.Next(idxs.Count)
Dim idx As Integer = idxs(rmx)
idxs.RemoveAt(rmx)
Dim r As Integer
Dim c As Integer
r = Math.DivRem(idx, 9, c)
Me.thePuzzle(r)(c) = 0
Threading.Thread.Sleep(0)
Next
' DebugHelp(Me.thePuzzle)
End Sub
Public Function Display() As String
Dim rv As New System.Text.StringBuilder
Dim fmt As String = "{0,3}"
For r As Integer = 0 To 8
For c As Integer = 0 To 8
If Me.thePuzzle(r)(c) = 0 Then
rv.AppendFormat(fmt, "□")
Else
rv.AppendFormat(fmt, Me.thePuzzle(r)(c))
End If
If c Mod 3 = 2 AndAlso c <> 8 Then rv.AppendFormat(fmt, "|")
Next
rv.AppendLine()
If r Mod 3 = 2 AndAlso r <> 8 Then
rv.AppendLine("---------------------------------")
'rv.AppendLine("_________________________________")
End If
Next
Return rv.ToString
End Function
Private Sub Shuffle()
Dim temp As Integer
Dim agrp As Integer
Dim IDT As Integer
Dim IDF As Integer
agrp = PRNG.Next(Me._thePuzzle.Count \ 3) * 3
Do
IDT = PRNG.Next(3) + agrp
IDF = PRNG.Next(3) + agrp
Loop While IDT = IDF
'swap rows
base.Clear()
base.AddRange(Me._thePuzzle(IDT))
Me._thePuzzle(IDT).Clear()
Me._thePuzzle(IDT).AddRange(Me._thePuzzle(IDF))
Me._thePuzzle(IDF).Clear()
Me._thePuzzle(IDF).AddRange(base)
'swap columns
For rw As Integer = 0 To Me._thePuzzle.Count - 1
temp = Me._thePuzzle(rw)(IDF)
Me._thePuzzle(rw)(IDF) = Me._thePuzzle(rw)(IDT)
Me._thePuzzle(rw)(IDT) = temp
Next
End Sub
Private Sub DebugHelp(sl As List(Of List(Of Integer)))
Debug.WriteLine("")
For r As Integer = 0 To sl.Count - 1
Debug.Write("'")
For c As Integer = 0 To sl(r).Count - 1
Debug.Write(sl(r)(c) & " ")
Next
Debug.WriteLine("")
Next
End Sub
End Class