1. ## [WIP] Sudoku Solver

Hi all,
I made these two classes whilst I was supposed to study for exams. The sudoku solver needs one more logic addition and it will be able to solve any solvable sudoku. At this moment it can only solve up to a Hard sudoku. If you try a evil one it will just fill in about 10 numbers.

If there is a 0 in the cell it is treated as empty.

Sudoku class
vb.net Code:
`Public Class Sudoku    Private _Numbers(,) As Integer    Public ReadOnly Property Numbers As Integer(,)        Get            Return _Numbers        End Get    End Property    Private Sub New()    End Sub    Public Sub New(ByVal Numbers() As Integer)        If Numbers.Length <> 81 Then Throw New ArgumentOutOfRangeException("Numbers", "Must have 81 elements")        ReDim _Numbers(8, 8)        For x = 0 To 8            For y = 0 To 8                _Numbers(x, y) = Numbers(y * 9 + x)            Next        Next    End Sub     Public Sub New(ByVal Numbers(,) As Integer)        If Numbers.Length <> 81 Then Throw New ArgumentOutOfRangeException("Numbers", "Must have 81 elements")        If Numbers.GetUpperBound(0) <> 8 Or Numbers.GetUpperBound(1) <> 8 Then Throw New ArgumentOutOfRangeException("Numbers", "Must be a 8X8 Array")        _Numbers = Numbers    End SubEnd Class`

Sudoku Solver class.
vb.net Code:
`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 RegionEnd Class`

I didn't put in comments(yet) and my names might be ambiguous, so please ask if you want to know anything about the class.

P.S. The attached project has a form, but it is only meant for debugging.

#### Posting Permissions

• You may not post new threads
• You may not post replies
• You may not post attachments
• You may not edit your posts
•

Featured