你如何在VB.NET中生成数独生成器 [英] How do you produce a Sudoku Generator in VB.NET
本文介绍了你如何在VB.NET中生成数独生成器的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！
问题描述
我已经使用回溯方法在VB.NET中成功制作了一个Sudoku Solver，我希望能够从这一点开始生成一个Sudoku网格，这个网格是人类可以单独留下的数字解决的。我如何制作一个网格，它将100％的时间产生一个可由人类和数字单独解决的网格，无需猜测？
网格算法如下：
- 绘制网格
- 在几个随机单元格中输入1到9之间的随机数
- 从这些输入的数字中求解网格
- 从这个已解决的网格中创建一个网格，用户可以通过清空某些单元格来播放
我试过随机删除随机单元格中的数字，但这总是产生一个无法解决的（单独使用数字和逻辑）网格。
代码：
I have successfully produced a Sudoku Solver in VB.NET using the backtracking method, and I want to be able to produce a Sudoku grid from this point that is humanly solvable with the numbers left behind alone. How do I produce a grid which will 100% of the time produce a grid that can be solved by a human and the numbers alone, with no guessing?
The grids algorithm is as follows:
- Draw grid
- Enter random numbers between 1 and 9 in a few random cells
- Solve the grid from these inputted numbers
- Create a grid from this solved grid that can be played by the user by emptying certain cells
I have tried just randomly removing numbers in random cells but this always produces an unsolvable (with the numbers and logic alone) grid.
Code:
<pre>Public Class Form1
Class sudoku_textbox
Inherits TextBox
Protected Overrides Sub OnKeyPress(e As KeyPressEventArgs)
If Char.IsDigit(e.KeyChar) Or e.KeyChar = " " Or e.KeyChar = ControlChars.Back Then
e.Handled = False
Else
e.Handled = True
End If
If e.KeyChar = "0" Then
e.KeyChar = ControlChars.Back
End If
End Sub
End Class
Dim cell(0 To 8, 0 To 8) As sudoku_textbox
Dim grid(0 To 8, 0 To 8) As String
Dim backtracking As Boolean = False
Dim RandomClass As New Random()
Dim RandomNumber As Integer
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Dim xxtra As Integer
Dim yxtra As Integer
Dim limit As Integer = 0
'x = row
'y = column
For x As Integer = 0 To 8
For y As Integer = 0 To 8
cell(x, y) = New sudoku_textbox
cell(x, y).Text = ""
cell(x, y).Width = 20
cell(x, y).Height = 20
cell(x, y).MaxLength = 1
cell(x, y).TextAlign = HorizontalAlignment.Center
xxtra = 0
yxtra = 0
If x > 2 Then '3rd box across
xxtra = 4
End If
If x > 5 Then ' 6th box across
xxtra = 8
End If
If y > 2 Then
yxtra = 4
End If
If y > 5 Then
yxtra = 8
End If
cell(x, y).Location = New Point(45 + x * 20 + xxtra, 15 + y * 20 + yxtra) '20 = space between boxes
Me.Controls.Add(cell(x, y))
AddHandler cell(x, y).TextChanged, AddressOf cell_changed
Next
Next
For x As Integer = 0 To 8
For y As Integer = 0 To 8
RandomNumber = RandomClass.Next(1, 100)
If (RandomNumber < 10) And limit < 16 Then
cell(x, y).Text = RandomNumber
limit += 1
End If
If cell(x, y).ForeColor = Color.Red Then
cell(x, y).Text = ""
End If
Next
Next
BackTrackFunc()
CreatePuzzleFunc()
End Sub
Function BackTrackFunc()
backtracking = True
For x As Integer = 0 To 8
For y As Integer = 0 To 8
grid(x, y) = cell(x, y).Text
Next
Next
BackTrack(0, 0)
For x = 0 To 8
For y = 0 To 8
cell(x, y).Text = grid(x, y)
Next
Next
backtracking = False
End Function
Private Sub cell_changed()
If backtracking Then Return
For x As Integer = 0 To 8
For y As Integer = 0 To 8
grid(x, y) = cell(x, y).Text
cell(x, y).ForeColor = Color.Black
Next
Next
For x As Integer = 0 To 8
For y As Integer = 0 To 8
If check_rows(x, y) Then
If check_columns(x, y) Then
If Not check_box(x, y) Then
cell(x, y).ForeColor = Color.Red
End If
Else
cell(x, y).ForeColor = Color.Red
End If
Else
cell(x, y).ForeColor = Color.Red
End If
Next
Next
End Sub
Function check_rows(ByVal xSender, ByVal ySender) As Boolean
Dim noClash As Boolean = True
For x As Integer = 0 To 8
If grid(x, ySender) <> "" Then
If x <> xSender Then
If grid(x, ySender) = grid(xSender, ySender) Then
noClash = False
End If
End If
End If
Next
Return noClash
End Function
Function check_columns(ByVal xSender, ByVal ySender) As Boolean
Dim noClash As Boolean = True
For y As Integer = 0 To 8
If grid(xSender, y) <> "" Then
If y <> ySender Then
If grid(xSender, y) = grid(xSender, ySender) Then
noClash = False
End If
End If
End If
Next
Return noClash
End Function
Function check_box(ByVal xSender, ByVal ySender) As Boolean '3 x 3 box
Dim noClash As Boolean = True
Dim xStart As Integer 'first box of 3x3 grid
Dim yStart As Integer
If xSender < 3 Then
xStart = 0
ElseIf xSender < 6 Then
xStart = 3
Else
xStart = 6
End If
If ySender < 3 Then
yStart = 0
ElseIf ySender < 6 Then
yStart = 3
Else
yStart = 6
End If
For y As Integer = yStart To (yStart + 2)
For x As Integer = xStart To (xStart + 2)
If grid(x, y) <> "" Then
If Not (x = xSender And y = ySender) Then
If grid(x, y) = grid(xSender, ySender) Then
noClash = False
End If
End If
End If
Next
Next
Return noClash
End Function
Private Sub checkButton_Click(sender As Object, e As EventArgs) Handles checkButton.Click
Dim noRed As Boolean = True
For x As Integer = 0 To 8
For y As Integer = 0 To 8
If cell(x, y).ForeColor = Color.Red Or cell(x, y).Text = "" Then
noRed = False
End If
Next
Next
If noRed = True Then
MessageBox.Show("Well Done! You have completed the Sudoku successfully")
Else
MessageBox.Show("You have not completed the Sudoku successfully")
End If
End Sub
Function BackTrack(ByVal x As Integer, ByVal y As Integer) As Boolean
Dim number As Integer = 1
If grid(x, y) = "" Then
Do
grid(x, y) = CStr(number)
If check_rows(x, y) Then
If check_columns(x, y) Then
If check_box(x, y) Then
y = y + 1
If y = 9 Then
y = 0
x = x + 1
If x = 9 Then Return True
End If
If BackTrack(x, y) Then Return True
y = y - 1
If y < 0 Then
y = 8
x = x - 1
End If
End If
End If
End If
number += 1
Loop Until number = 10
grid(x, y) = ""
Return False
Else
y = y + 1
If y = 9 Then
y = 0
x = x + 1
If x = 9 Then Return True
End If
Return BackTrack(x, y)
End If
End Function
Function CreatePuzzleFunc()
'Create grid playable by user
End Function
End Class
推荐答案
哦，小男孩！你不挑选容易的，是吗？ ：笑：
这很复杂，这不是我想要承担的任务：有很多想法要做，因为拼图必须不是只是可解决，它也应该是 唯一可解决的 - 来自给定数据集的应该只有一个解决方案。
当我经常做数独游戏时，如果我的解决方案与已发布的解决方案有所不同，它常常会让我烦恼：特别是如果我没有犯错的话！
但是......这并不容易，所以很少有人解释这个过程，我从未见过任何生成的C＃或VB代码独特的可解决难题（可能是因为大多数解决方案都是商业化的，因此代码永远不会发布：它是公司的知识产权）。
但我确实找到了： http://www.sudokuwiki.org/Sudoku_Creation_and_Grading.pdf [ ^ ] - 它不会解决您的问题，但它确实表明了开发解决方案的策略。
祝你好运！
Oh boy! You don't pick the easy ones, do you? :laugh:
This is pretty complicated, and it's not a task I would want to take on: There is a lot of thinking to do, because the puzzle must be not just solvable, it should also be uniquely solvable - there should be one and only one solution from a given set of data.
When I did sudoku puzzles regularly, it used to annoy the heck out of me if my solution and the published one differed: particularly if I had not made a mistake!
But...this is not easy, so there is very, very little out there explaining the process, and I have never seen any C# or VB code that generates uniquely solvable puzzles (probably because most solutions are commercial, so the code never gets published: it's a corporate Intellectual Property).
But I did find this: http://www.sudokuwiki.org/Sudoku_Creation_and_Grading.pdf[^] - it won't solve your problem, but it does indicate a strategy for developing a solution.
Good luck!
这篇关于你如何在VB.NET中生成数独生成器的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
查看全文
