[WIP] Sudoku Solver-VBForums
Results 1 to 1 of 1

Thread: [WIP] Sudoku Solver

Hybrid View

  1. #1

    Thread Starter
    Fanatic Member BlindSniper's Avatar
    Join Date
    Jan 2011
    Location
    South Africa
    Posts
    865

    [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:
    1. Public Class Sudoku
    2.     Private _Numbers(,) As Integer
    3.     Public ReadOnly Property Numbers As Integer(,)
    4.         Get
    5.             Return _Numbers
    6.         End Get
    7.     End Property
    8.     Private Sub New()
    9.     End Sub
    10.     Public Sub New(ByVal Numbers() As Integer)
    11.         If Numbers.Length <> 81 Then Throw New ArgumentOutOfRangeException("Numbers", "Must have 81 elements")
    12.         ReDim _Numbers(8, 8)
    13.         For x = 0 To 8
    14.             For y = 0 To 8
    15.                 _Numbers(x, y) = Numbers(y * 9 + x)
    16.             Next
    17.         Next
    18.     End Sub
    19.  
    20.     Public Sub New(ByVal Numbers(,) As Integer)
    21.         If Numbers.Length <> 81 Then Throw New ArgumentOutOfRangeException("Numbers", "Must have 81 elements")
    22.         If Numbers.GetUpperBound(0) <> 8 Or Numbers.GetUpperBound(1) <> 8 Then Throw New ArgumentOutOfRangeException("Numbers", "Must be a 8X8 Array")
    23.         _Numbers = Numbers
    24.     End Sub
    25. End Class

    Sudoku Solver class.
    vb.net Code:
    1. Public Class SudokuSolver
    2. #Region "Row Methods"
    3.     Shared Function GetRowPossibleIndexes(ByVal YVal As Integer, ByVal Puzzel As Sudoku, ByVal Number As Integer) As Integer()
    4.         Dim OpenIndexes As New List(Of Integer)
    5.         For i = 0 To 8
    6.             If Not IsValidNumber(Puzzel.Numbers(i, YVal)) AndAlso GetPossibilities(i, YVal, Puzzel).Contains(Number) Then OpenIndexes.Add(i)
    7.         Next
    8.         Return OpenIndexes.ToArray
    9.     End Function
    10.     Shared Function GetRowNeededNumbers(ByVal YVal As Integer, ByVal Puzzel As Sudoku) As Integer()
    11.         Dim Possible() As Integer = {1, 2, 3, 4, 5, 6, 7, 8, 9}
    12.         Return Possible.Except(GetRow(YVal, Puzzel)).ToArray
    13.     End Function
    14.     Shared Function GetRow(ByVal YVal As Integer, ByVal puzzel As Sudoku) As Integer()
    15.         Dim Row(8) As Integer
    16.         For x = 0 To 8
    17.             Row(x) = puzzel.Numbers(x, YVal)
    18.         Next
    19.         Return Row
    20.     End Function
    21. #End Region
    22. #Region "Column Methods"
    23.     Shared Function GetColumn(ByVal XVal As Integer, ByVal puzzel As Sudoku) As Integer()
    24.         Dim Column(8) As Integer
    25.         For y = 0 To 8
    26.             Column(y) = puzzel.Numbers(XVal, y)
    27.         Next
    28.         Return Column
    29.     End Function
    30.  
    31.     Shared Function GetColumnNeededNumbers(ByVal XVal As Integer, ByVal Puzzel As Sudoku) As Integer()
    32.         Dim Possible() As Integer = {1, 2, 3, 4, 5, 6, 7, 8, 9}
    33.         Return Possible.Except(GetColumn(XVal, Puzzel)).ToArray
    34.     End Function
    35.  
    36.     Shared Function GetColumnPossibleIndexes(ByVal XVal As Integer, ByVal Puzzel As Sudoku, ByVal Number As Integer) As Integer()
    37.         Dim OpenIndexes As New List(Of Integer)
    38.         For i = 0 To 8
    39.             If Not IsValidNumber(Puzzel.Numbers(XVal, i)) AndAlso GetPossibilities(XVal, i, Puzzel).Contains(Number) Then OpenIndexes.Add(i)
    40.         Next
    41.         Return OpenIndexes.ToArray
    42.     End Function
    43. #End Region
    44. #Region "Block Methods"
    45.     Shared Function GetBlock(ByVal Block As Integer, ByVal Puzzel As Sudoku) As Integer(,)
    46.         Dim BlockValues(2, 2) As Integer
    47.         Dim Loc As Point = GetBlockStartingIndex(Block)
    48.         Dim X As Integer = Loc.X
    49.         Dim Y As Integer = Loc.Y
    50.         Dim CX As Integer = 0
    51.         For XX = X To X + 2
    52.             Dim CY As Integer = 0
    53.             For YY = Y To Y + 2
    54.                 BlockValues(CX, CY) = Puzzel.Numbers(XX, YY)
    55.                 CY += 1
    56.             Next
    57.             CX += 1
    58.         Next
    59.         Return BlockValues
    60.     End Function
    61.  
    62.     Shared Function GetBlockNumber(ByVal X As Integer, ByVal Y As Integer, ByVal Puzzel As Sudoku) As Integer
    63.         Dim BX As Integer = CInt(Math.Floor(X / 3))
    64.         Dim BY As Integer = CInt(Math.Floor(Y / 3))
    65.         Return (BY * 3 + BX) + 1
    66.     End Function
    67.  
    68.     Shared Function GetBlockNeededNumbers(ByVal Block As Integer, ByVal Puzzel As Sudoku) As Integer()
    69.         Dim TempBlock(,) As Integer = GetBlock(Block, Puzzel)
    70.         Dim Numbers() As Integer = {1, 2, 3, 4, 5, 6, 7, 8, 9}
    71.         Dim B() As Integer = DimentionChange(TempBlock)
    72.         Return Numbers.Except(B).ToArray
    73.     End Function
    74.  
    75.     Shared Function GetBlockStartingIndex(ByVal Block As Integer) As Point
    76.         Dim X As Integer
    77.         Dim Y As Integer
    78.         Select Case Block
    79.             Case 1
    80.                 X = 0
    81.                 Y = 0
    82.             Case 2
    83.                 X = 3
    84.                 Y = 0
    85.             Case 3
    86.                 X = 6
    87.                 Y = 0
    88.             Case 4
    89.                 X = 0
    90.                 Y = 3
    91.             Case 5
    92.                 X = 3
    93.                 Y = 3
    94.             Case 6
    95.                 X = 6
    96.                 Y = 3
    97.             Case 7
    98.                 X = 0
    99.                 Y = 6
    100.             Case 8
    101.                 X = 3
    102.                 Y = 6
    103.             Case 9
    104.                 X = 6
    105.                 Y = 6
    106.             Case Else
    107.                 Throw New ArgumentOutOfRangeException("Block", "Must be between 1 and 9")
    108.         End Select
    109.         Return New Point(X, Y)
    110.     End Function
    111.  
    112.     Shared Function GetBlockPossibleIndexes(ByVal Block As Integer, ByVal Puzzel As Sudoku, ByVal Number As Integer) As Point()
    113.         Dim Index As Point = GetBlockStartingIndex(Block)
    114.         Dim OpenIndexes As New List(Of Point)
    115.         For x = Index.X To Index.X + 2
    116.             For y = Index.Y To Index.Y + 2
    117.                 If Not IsValidNumber(Puzzel.Numbers(x, y)) AndAlso GetPossibilities(x, y, Puzzel).Contains(Number) Then OpenIndexes.Add(New Point(x, y))
    118.             Next
    119.         Next
    120.         Return OpenIndexes.ToArray
    121.     End Function
    122. #End Region
    123. #Region "Sudoku Methods"
    124.     Shared Function IsCorrect(ByVal puzzel As Sudoku) As Boolean
    125.         If Not IsCompleted(puzzel) Then Return False
    126.         Dim numbers(,) As Integer = puzzel.Numbers
    127.  
    128.         For x = 0 To 8 'check columns
    129.             Dim Column() As Integer = GetColumn(x, puzzel)
    130.             If Column.Length <> Column.Distinct.Count Then Return False
    131.  
    132.         Next
    133.         For y = 0 To 8 'check rows
    134.             Dim row() As Integer = GetColumn(y, puzzel)
    135.             If row.Length <> row.Distinct.Count Then Return False
    136.         Next
    137.  
    138.         For i = 1 To 9 'check blocks
    139.             Dim Block() As Integer = DimentionChange(GetBlock(i, puzzel))
    140.             If Block.Length <> Block.Distinct.Count Then Return False
    141.         Next
    142.  
    143.         'At this point there are no duplicates in any row,column or block and there are valid numbers in each cell.
    144.         'Does that mean that it is solved ? I think so, lets assume so for now.
    145.         Return True
    146.  
    147.     End Function
    148.     Shared Function IsCompleted(ByVal puzzel As Sudoku) As Boolean
    149.         Return CountElements(puzzel) = 81
    150.     End Function
    151.     Shared Function CountElements(ByVal Puzzel As Sudoku) As Integer
    152.         Dim Counter As Integer = 0
    153.         For x = 0 To 8
    154.             For y = 0 To 8
    155.                 If IsValidNumber(Puzzel.Numbers(x, y)) Then Counter += 1
    156.             Next
    157.         Next
    158.         Return Counter
    159.     End Function
    160.     Shared Function CountElements(ByVal Numbers() As Integer) As Integer
    161.         Dim Counter As Integer = 0
    162.         For i = 0 To Numbers.Length - 1
    163.             If IsValidNumber(Numbers(i)) Then Counter += 1
    164.         Next
    165.         Return Counter
    166.     End Function
    167.     Shared Function GetPossibilities(ByVal X As Integer, ByVal Y As Integer, ByVal Puzzel As Sudoku) As Integer()
    168.         Dim Possible() As Integer = {1, 2, 3, 4, 5, 6, 7, 8, 9}
    169.         Return Possible.Except(GetColumn(X, Puzzel)).Except(GetRow(Y, Puzzel)).Except(DimentionChange(GetBlock(GetBlockNumber(X, Y, Puzzel), Puzzel))).ToArray
    170.     End Function
    171.     Shared Function IsValidNumber(ByVal Number As Integer) As Boolean
    172.         Return Number > 1 AndAlso Number < 10
    173.     End Function
    174.     Shared Function SolveSudoku(ByVal Puzzel As Sudoku) As Sudoku
    175.         If IsCompleted(Puzzel) Then Return Puzzel
    176.         Dim Solved As Boolean = False
    177.         Dim Numbers As Integer(,) = Puzzel.Numbers
    178.         Dim Temp As Sudoku = Nothing
    179.         Dim Changes As Integer = -1
    180.         While Not Solved And Changes <> 0
    181.             Changes = 0
    182.             Temp = New Sudoku(Numbers)
    183.             Dim AllPossibilities As New Dictionary(Of Point, Integer()) 'first param is the index, second is the possibilities
    184.             For x = 0 To 8
    185.                 For y = 0 To 8
    186.                     If Numbers(x, y) = 0 Then
    187.                         AllPossibilities.Add(New Point(x, y), GetPossibilities(x, y, Temp))
    188.                     End If
    189.                 Next
    190.             Next
    191.  
    192.             For Each i In AllPossibilities
    193.                 If i.Value.Length = 1 Then
    194.                     Numbers(i.Key.X, i.Key.Y) = i.Value(0) 'testing all
    195.                     Changes += 1
    196.                 End If
    197.             Next
    198.             Temp = New Sudoku(Numbers)
    199.             For i = 1 To 9
    200.                 Dim NeededNumbers() As Integer = GetBlockNeededNumbers(i, Temp)
    201.                 For j = 0 To NeededNumbers.Length - 1
    202.                     Dim Possibles() As Point = GetBlockPossibleIndexes(i, Temp, NeededNumbers(j))
    203.                     If Possibles.Length = 1 Then
    204.                         Numbers(Possibles(0).X, Possibles(0).Y) = NeededNumbers(j)
    205.                         Changes += 1
    206.                     End If
    207.  
    208.                 Next
    209.             Next
    210.             Temp = New Sudoku(Numbers)
    211.             For i = 0 To 8
    212.                 Dim needednumbers() As Integer = GetColumnNeededNumbers(i, Temp)
    213.                 For j = 0 To needednumbers.Length - 1
    214.                     Dim possibles() = GetColumnPossibleIndexes(i, Temp, needednumbers(j))
    215.                     If possibles.Length = 1 Then
    216.                         Numbers(i, possibles(0)) = needednumbers(j)
    217.                         Changes += 1
    218.                     End If
    219.                 Next
    220.             Next
    221.             Temp = New Sudoku(Numbers)
    222.  
    223.             For i = 0 To 8
    224.                 Dim needednumbers() As Integer = GetRowNeededNumbers(i, Temp)
    225.                 For j = 0 To needednumbers.Length - 1
    226.                     Dim possibles() = GetRowPossibleIndexes(i, Temp, needednumbers(j))
    227.                     If possibles.Length = 1 Then
    228.                         Numbers(possibles(0), i) = needednumbers(j)
    229.                         Changes += 1
    230.                     End If
    231.                 Next
    232.             Next
    233.             Temp = New Sudoku(Numbers)
    234.             Solved = IsCompleted(Temp)
    235.         End While
    236.         Return Temp
    237.     End Function
    238. #End Region
    239. #Region "Misc Method(s)"
    240.     Shared Function DimentionChange(Of T)(ByVal Array(,) As T) As T()
    241.         Dim Width As Integer = Array.GetUpperBound(0) + 1
    242.         Dim Height As Integer = Array.GetUpperBound(1) + 1
    243.         Dim dest(Width * Height - 1) As T
    244.         For x = 0 To Width - 1
    245.             For y = 0 To Height - 1
    246.                 dest(y * Width + x) = Array(x, y)
    247.             Next
    248.         Next
    249.         Return dest
    250.     End Function
    251. #End Region
    252. End 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.
    Attached Files Attached Files

    Useful CodeBank Entries of mine
    Expand Function
    Code Compiler
    Sudoku Solver
    HotKeyHandler Class

    Read this to get Effective help on VBForums
    Hitchhiker's Guide to Getting Help at VBF

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


Click Here to Expand Forum to Full Width

Survey posted by VBForums.