Public Class SudokuSolver
#Region "Row Methods"
Shared Function GetRowPossibleIndexes(ByVal YVal As Integer, ByVal Puzzel As Sudoku, ByVal Number As Integer) As Integer()
Dim OpenIndexes As New List(Of Integer)
For i = 0 To 8
If Not IsValidNumber(Puzzel.Numbers(i, YVal)) AndAlso GetPossibilities(i, YVal, Puzzel).Contains(Number) Then OpenIndexes.Add(i)
Next
Return OpenIndexes.ToArray
End Function
Shared Function GetRowNeededNumbers(ByVal YVal As Integer, ByVal Puzzel As Sudoku) As Integer()
Dim Possible() As Integer = {1, 2, 3, 4, 5, 6, 7, 8, 9}
Return Possible.Except(GetRow(YVal, Puzzel)).ToArray
End Function
Shared Function GetRow(ByVal YVal As Integer, ByVal puzzel As Sudoku) As Integer()
Dim Row(8) As Integer
For x = 0 To 8
Row(x) = puzzel.Numbers(x, YVal)
Next
Return Row
End Function
#End Region
#Region "Column Methods"
Shared Function GetColumn(ByVal XVal As Integer, ByVal puzzel As Sudoku) As Integer()
Dim Column(8) As Integer
For y = 0 To 8
Column(y) = puzzel.Numbers(XVal, y)
Next
Return Column
End Function
Shared Function GetColumnNeededNumbers(ByVal XVal As Integer, ByVal Puzzel As Sudoku) As Integer()
Dim Possible() As Integer = {1, 2, 3, 4, 5, 6, 7, 8, 9}
Return Possible.Except(GetColumn(XVal, Puzzel)).ToArray
End Function
Shared Function GetColumnPossibleIndexes(ByVal XVal As Integer, ByVal Puzzel As Sudoku, ByVal Number As Integer) As Integer()
Dim OpenIndexes As New List(Of Integer)
For i = 0 To 8
If Not IsValidNumber(Puzzel.Numbers(XVal, i)) AndAlso GetPossibilities(XVal, i, Puzzel).Contains(Number) Then OpenIndexes.Add(i)
Next
Return OpenIndexes.ToArray
End Function
#End Region
#Region "Block Methods"
Shared Function GetBlock(ByVal Block As Integer, ByVal Puzzel As Sudoku) As Integer(,)
Dim BlockValues(2, 2) As Integer
Dim Loc As Point = GetBlockStartingIndex(Block)
Dim X As Integer = Loc.X
Dim Y As Integer = Loc.Y
Dim CX As Integer = 0
For XX = X To X + 2
Dim CY As Integer = 0
For YY = Y To Y + 2
BlockValues(CX, CY) = Puzzel.Numbers(XX, YY)
CY += 1
Next
CX += 1
Next
Return BlockValues
End Function
Shared Function GetBlockNumber(ByVal X As Integer, ByVal Y As Integer, ByVal Puzzel As Sudoku) As Integer
Dim BX As Integer = CInt(Math.Floor(X / 3))
Dim BY As Integer = CInt(Math.Floor(Y / 3))
Return (BY * 3 + BX) + 1
End Function
Shared Function GetBlockNeededNumbers(ByVal Block As Integer, ByVal Puzzel As Sudoku) As Integer()
Dim TempBlock(,) As Integer = GetBlock(Block, Puzzel)
Dim Numbers() As Integer = {1, 2, 3, 4, 5, 6, 7, 8, 9}
Dim B() As Integer = DimentionChange(TempBlock)
Return Numbers.Except(B).ToArray
End Function
Shared Function GetBlockStartingIndex(ByVal Block As Integer) As Point
Dim X As Integer
Dim Y As Integer
Select Case Block
Case 1
X = 0
Y = 0
Case 2
X = 3
Y = 0
Case 3
X = 6
Y = 0
Case 4
X = 0
Y = 3
Case 5
X = 3
Y = 3
Case 6
X = 6
Y = 3
Case 7
X = 0
Y = 6
Case 8
X = 3
Y = 6
Case 9
X = 6
Y = 6
Case Else
Throw New ArgumentOutOfRangeException("Block", "Must be between 1 and 9")
End Select
Return New Point(X, Y)
End Function
Shared Function GetBlockPossibleIndexes(ByVal Block As Integer, ByVal Puzzel As Sudoku, ByVal Number As Integer) As Point()
Dim Index As Point = GetBlockStartingIndex(Block)
Dim OpenIndexes As New List(Of Point)
For x = Index.X To Index.X + 2
For y = Index.Y To Index.Y + 2
If Not IsValidNumber(Puzzel.Numbers(x, y)) AndAlso GetPossibilities(x, y, Puzzel).Contains(Number) Then OpenIndexes.Add(New Point(x, y))
Next
Next
Return OpenIndexes.ToArray
End Function
#End Region
#Region "Sudoku Methods"
Shared Function IsCorrect(ByVal puzzel As Sudoku) As Boolean
If Not IsCompleted(puzzel) Then Return False
Dim numbers(,) As Integer = puzzel.Numbers
For x = 0 To 8 'check columns
Dim Column() As Integer = GetColumn(x, puzzel)
If Column.Length <> Column.Distinct.Count Then Return False
Next
For y = 0 To 8 'check rows
Dim row() As Integer = GetColumn(y, puzzel)
If row.Length <> row.Distinct.Count Then Return False
Next
For i = 1 To 9 'check blocks
Dim Block() As Integer = DimentionChange(GetBlock(i, puzzel))
If Block.Length <> Block.Distinct.Count Then Return False
Next
'At this point there are no duplicates in any row,column or block and there are valid numbers in each cell.
'Does that mean that it is solved ? I think so, lets assume so for now.
Return True
End Function
Shared Function IsCompleted(ByVal puzzel As Sudoku) As Boolean
Return CountElements(puzzel) = 81
End Function
Shared Function CountElements(ByVal Puzzel As Sudoku) As Integer
Dim Counter As Integer = 0
For x = 0 To 8
For y = 0 To 8
If IsValidNumber(Puzzel.Numbers(x, y)) Then Counter += 1
Next
Next
Return Counter
End Function
Shared Function CountElements(ByVal Numbers() As Integer) As Integer
Dim Counter As Integer = 0
For i = 0 To Numbers.Length - 1
If IsValidNumber(Numbers(i)) Then Counter += 1
Next
Return Counter
End Function
Shared Function GetPossibilities(ByVal X As Integer, ByVal Y As Integer, ByVal Puzzel As Sudoku) As Integer()
Dim Possible() As Integer = {1, 2, 3, 4, 5, 6, 7, 8, 9}
Return Possible.Except(GetColumn(X, Puzzel)).Except(GetRow(Y, Puzzel)).Except(DimentionChange(GetBlock(GetBlockNumber(X, Y, Puzzel), Puzzel))).ToArray
End Function
Shared Function IsValidNumber(ByVal Number As Integer) As Boolean
Return Number > 1 AndAlso Number < 10
End Function
Shared Function SolveSudoku(ByVal Puzzel As Sudoku) As Sudoku
If IsCompleted(Puzzel) Then Return Puzzel
Dim Solved As Boolean = False
Dim Numbers As Integer(,) = Puzzel.Numbers
Dim Temp As Sudoku = Nothing
Dim Changes As Integer = -1
While Not Solved And Changes <> 0
Changes = 0
Temp = New Sudoku(Numbers)
Dim AllPossibilities As New Dictionary(Of Point, Integer()) 'first param is the index, second is the possibilities
For x = 0 To 8
For y = 0 To 8
If Numbers(x, y) = 0 Then
AllPossibilities.Add(New Point(x, y), GetPossibilities(x, y, Temp))
End If
Next
Next
For Each i In AllPossibilities
If i.Value.Length = 1 Then
Numbers(i.Key.X, i.Key.Y) = i.Value(0) 'testing all
Changes += 1
End If
Next
Temp = New Sudoku(Numbers)
For i = 1 To 9
Dim NeededNumbers() As Integer = GetBlockNeededNumbers(i, Temp)
For j = 0 To NeededNumbers.Length - 1
Dim Possibles() As Point = GetBlockPossibleIndexes(i, Temp, NeededNumbers(j))
If Possibles.Length = 1 Then
Numbers(Possibles(0).X, Possibles(0).Y) = NeededNumbers(j)
Changes += 1
End If
Next
Next
Temp = New Sudoku(Numbers)
For i = 0 To 8
Dim needednumbers() As Integer = GetColumnNeededNumbers(i, Temp)
For j = 0 To needednumbers.Length - 1
Dim possibles() = GetColumnPossibleIndexes(i, Temp, needednumbers(j))
If possibles.Length = 1 Then
Numbers(i, possibles(0)) = needednumbers(j)
Changes += 1
End If
Next
Next
Temp = New Sudoku(Numbers)
For i = 0 To 8
Dim needednumbers() As Integer = GetRowNeededNumbers(i, Temp)
For j = 0 To needednumbers.Length - 1
Dim possibles() = GetRowPossibleIndexes(i, Temp, needednumbers(j))
If possibles.Length = 1 Then
Numbers(possibles(0), i) = needednumbers(j)
Changes += 1
End If
Next
Next
Temp = New Sudoku(Numbers)
Solved = IsCompleted(Temp)
End While
Return Temp
End Function
#End Region
#Region "Misc Method(s)"
Shared Function DimentionChange(Of T)(ByVal Array(,) As T) As T()
Dim Width As Integer = Array.GetUpperBound(0) + 1
Dim Height As Integer = Array.GetUpperBound(1) + 1
Dim dest(Width * Height - 1) As T
For x = 0 To Width - 1
For y = 0 To Height - 1
dest(y * Width + x) = Array(x, y)
Next
Next
Return dest
End Function
#End Region
End Class