[2005/2008]Generating A Sudoku grid
Here's the class in it's entirety:
Code:
Option Explicit On
Option Strict On
Friend Class SudokuBoard
Private WithEvents bw As New System.ComponentModel.BackgroundWorker
Private m_TheBoard(8I, 8I) As Integer
Private m_Numbers(8, 8) As List(Of Integer)
Private Rand As New Random
Friend Event BoardGenerated(ByVal TheBoard(,) As Integer)
#Region " Constructors "
Friend Sub New()
Me.GenerateBoard()
End Sub
#End Region
#Region " GenerateBoard "
Friend Sub GenerateBoard()
Me.bw.RunWorkerAsync()
End Sub
Private Sub bw_DoWork(ByVal sender As Object, ByVal e As System.ComponentModel.DoWorkEventArgs) Handles bw.DoWork
Dim ValidBoard As Boolean = False
While ValidBoard = False
ValidBoard = GenerateTheBoard()
End While
End Sub
Private Sub bw_RunWorkerCompleted(ByVal sender As Object, ByVal e As System.ComponentModel.RunWorkerCompletedEventArgs) Handles bw.RunWorkerCompleted
Dim Copy(8, 8) As Integer
For x As Integer = 0I To 8I
For y As Integer = 0I To 8I
Copy(x, y) = m_TheBoard(x, y)
Next y
Next x
RaiseEvent BoardGenerated(Copy)
End Sub
#End Region
#Region " GenerateTheBoard "
Private Function GenerateTheBoard() As Boolean
'Code from JohnH
Call ResetBoard()
'try fill a board
Dim fillcount As Integer = 0
Do Until fillcount = 81
'find cell with least available options
Dim lowestAvailable As Integer = 10
Dim cellref As Point = Point.Empty
For x As Integer = 0 To 8
For y As Integer = 0 To 8
If m_TheBoard(x, y) = 0 Then 'only include empty cells in search
Dim availCount As Integer = m_Numbers(x, y).Count
If availCount = 0 Then
Return False 'hit a dead end
ElseIf availCount < lowestAvailable Then
lowestAvailable = availCount
cellref = New Point(x, y)
End If
End If
Next y
Next x
'fill that cell
Dim available As List(Of Integer) = m_Numbers(cellref.X, cellref.Y)
If available.Count = 1 Then
m_TheBoard(cellref.X, cellref.Y) = available(0)
Else
m_TheBoard(cellref.X, cellref.Y) = available(Rand.Next(0, available.Count))
End If
RemoveAvailable(cellref.X, cellref.Y)
fillcount += 1
Loop
Return True 'valid solution
End Function
#End Region
#Region " Friend Methods "
Friend Sub ClearBoard()
For x As Integer = 0I To 8I
For y As Integer = 0I To 8I
m_TheBoard(x, y) = 0I
Next y
Next x
End Sub
#End Region
#Region " ResetBoard "
Private Sub ResetBoard()
'Code from JohnH
For x As Integer = 0 To 8
For y As Integer = 0 To 8
m_Numbers(x, y) = New List(Of Integer)
m_Numbers(x, y).AddRange(New Integer() {1, 2, 3, 4, 5, 6, 7, 8, 9})
m_TheBoard(x, y) = 0
Next y
Next x
End Sub
#End Region
#Region " RemoveAvailable "
Private Sub RemoveAvailable(ByVal x As Integer, ByVal y As Integer)
'Code from JohnH
Dim value As Integer = m_TheBoard(x, y)
'remove from column and row
For xx As Integer = 0 To 8
m_Numbers(xx, y).Remove(value)
Next xx
For yy As Integer = 0 To 8
m_Numbers(x, yy).Remove(value)
Next yy
'remove from one of the 3x3 sections
Dim xxx As Integer = (x \ 3) * 3
Dim yyy As Integer = (y \ 3) * 3
For xx As Integer = xxx To xxx + 2
For yy As Integer = yyy To yyy + 2
m_Numbers(xx, yy).Remove(value)
Next yy
Next xx
End Sub
#End Region
End Class
To use it, simply make a new instance and handle the BoardGenerated() event. Which gives you a 9x9 grid of the entire thing.
Code:
Private WithEvents m_Sudoku As SudokuBoard
Private m_ActualBoard(8, 8) As Integer
Private Sub GenerateBoard()
m_Sudoku = New SudokuBoard
End Sub
Private Sub m_Sudoku_BoardGenerated(ByVal TheBoard(,) As Integer) Handles m_Sudoku.BoardGenerated
For X As Integer = 0 To 8
For Y As Integer = 0 To 8
m_ActualBoard(X, Y) = TheBoard(X, Y)
Next Y
Next X
End Sub