Problem Sudoku Solver

  • VB.NET

Es gibt 22 Antworten in diesem Thema. Der letzte Beitrag () ist von ErfinderDesRades.

    Problem Sudoku Solver

    Hallo,

    ich lerne gerade ein bisschen mit Visual Basic zu programmieren und muss einen Sudoku Solver erstellen. Bis jetzt habe ich leider nicht wirklich viel Ahnung vom Programmieren

    Ich habe mir vorgenommen einen Solver mit Backtracking zu erstellen und auch schon etwas Code geschrieben. Nur leider hackt es noch an einigen Stellen.
    Vielleicht kann mir ja jemand von euch weiterhelfen, das wäre wirklich super!

    Ich denke es hängt vor allem noch an der Backtracking Funktion. Außerdem kann ich diese Funktion auch nicht aus dem Button Sub aufrufen
    Schon einmal vielen Dank falls Ihr mir helfen könnt.

    Ich hoffe ich habe den Thread im richtigen Unterforum erstellt.

    Hier ist der Quellcode mit meinen "Erläuterungen":

    Spoiler anzeigen

    VB.NET-Quellcode

    1. Public Class Form1
    2. Dim ncells As Integer = 8 'here input of the line / column number of sudoku cells
    3. Dim sudoku(0 To ncells, 0 To ncells) As Integer '2 dimensional array for sudoku grid. it is used to save the sudoku solution. if this didn't exsit, the program would be slow because too much time to fill in all the boxes.
    4. Dim number As Integer
    5. Dim scell(0 To ncells, 0 To ncells) As TextBox '2 dimensional array (i, j) with which the sudoku will be created
    6. Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
    7. For i As Integer = 0 To ncells
    8. For j As Integer = 0 To ncells
    9. scell(i, j) = New TextBox 'for every element in the cell I create new sudoku cell
    10. scell(i, j).MinimumSize = New Size(50, 50) 'the size of the cell is defined
    11. scell(i, j).Text = ""
    12. scell(i, j).Font = New Font(scell(i, j).Font.FontFamily, 25, FontStyle.Regular) 'the size of the text input is defined
    13. scell(i, j).TextAlign = HorizontalAlignment.Center 'input is centered
    14. scell(i, j).Width = 50 'the cell width is defined
    15. scell(i, j).Location = New Point(i * 50, j * 50) 'the cells are located depending on their index
    16. scell(i, j).BorderStyle = BorderStyle.FixedSingle 'the style of the cells is defined
    17. scell(i, j).MaxLength = 1 'the input can only be one character
    18. Me.Controls.Add(scell(i, j)) 'the cells are added to the form
    19. Next
    20. Next
    21. End Sub
    22. 'this function checks whether the number assigned is already existant in the line
    23. Function testlines(ByVal jcolumns As Integer, ByVal number As Integer, ByVal sudoku(,) As Object) As Boolean
    24. testlines = True 'in the beginning it is assumed that there is no clash. Then it is checked whether there might be a clash
    25. Dim i As Integer
    26. For i = 0 To ncells 'the lines are indexed
    27. If sudoku(i, jcolumns) = number Then
    28. testlines = False 'if there is a cell in the line which has the same number like another one, then there is a clash
    29. Exit Function
    30. End If
    31. Next i
    32. End Function
    33. ' this function checks whether the number assigned is already existant in the column
    34. Function testcolumns(ByVal ilines As Integer, ByVal number As Integer, ByVal sudoku(,) As Object) As Boolean
    35. testcolumns = True 'in the beginning it is assumed that there is no clash. Then it is checked whether there might be a clash
    36. Dim j As Integer
    37. For j = 0 To ncells 'the columns are indexed
    38. If sudoku(ilines, j) = number Then
    39. testcolumns = False 'if there is a cell in the column which has the same number like another one, then there is a clash
    40. Exit Function
    41. End If
    42. Next j
    43. End Function
    44.  
    45. Function testboxes(ByVal ilines As Integer, ByVal jcolumns As Integer, ByVal number As Integer, ByVal sudoku(,) As Object) As Boolean
    46. testboxes = True
    47. Dim istart As Integer
    48. Dim jstart As Integer
    49. Dim i As Integer
    50. Dim j As Integer
    51.  
    52. 'now I define that only the 9 3x3 boxes are checked for clashes
    53. 'lines 1-3 are summarized to 1 big line:
    54. If ilines < 3 Then
    55. istart = 0
    56. 'lines 4-6 are summarizes to 1 big line:
    57. ElseIf ilines < 6 Then
    58. istart = 3
    59. 'lines 7-9 are summarizes to 1 big line:
    60. Else
    61. istart = 6
    62. End If
    63. 'columns 1-3 are summarized to 1 big column:
    64. If jcolumns < 3 Then
    65. jstart = 0
    66. 'columns 4-6 are summarized to 1 big column:
    67. ElseIf jcolumns < 6 Then
    68. jstart = 3
    69. 'columns 7-9 are summarized to 1 big column:
    70. Else
    71. jstart = 6
    72. End If
    73. For i = 0 To (istart + 2) 'the +2 because istart was defined to be maximum 6
    74. For j = 0 To (jstart + 2) 'the +2 because jstart was defined to be maximum 6
    75. If sudoku(i, j) = number Then 'it is checked whether there is a clash in the 9 3x3 boxes
    76. testboxes = False
    77. Exit Function
    78. End If
    79. Next j
    80. Next i
    81. End Function
    82. 'this function summarizes all the the functions above and returns only true, if
    83. Function safe(ByVal i As Integer, ByVal j As Integer, ByVal number As Integer, ByVal sudoku(,) As Object) As Boolean
    84. safe = False
    85. If testlines(j, number, sudoku) = True And testcolumns(i, number, sudoku) = True And testboxes(i, j, number, sudoku) = True Then
    86. safe = True
    87. Exit Function
    88. End If
    89. End Function
    90.  
    91. Function solve(ByVal i As Integer, ByVal j As Integer, ByVal sudoku(,) As Object) As Boolean
    92. Dim number As Integer
    93. Dim copyi As Integer
    94. Dim copyj As Integer
    95. 'first check whether the cell is empty / if it is not empty, then check whether cell 81 / if cell 81, then sudoku solved
    96. If sudoku(i, j) <> "" Then
    97. If i = ncells And j = ncells Then
    98. solve = True
    99. Exit Function
    100. 'if it is not empy I jump to the next cell by calling the sub nextcell() / then I call the function solve again
    101. Else
    102. nextcell(i, j)
    103. solve(i, j, sudoku)
    104. 'now I assign the numbers 1 to 9 to the variable number and check whether they comply with the restrictions / afterwards I check again whether I am already at cell 81 / if cell 81, then sudoku solved
    105. 'I also make copies of the cells i and j and go on with the copies / by doing that I can jump back to the "old" i and j indexes if the new number does not comply with the restrictions
    106. number = 1
    107. Do Until number = 10
    108. If safe(i, j, number, sudoku) = True Then
    109. sudoku(i, j) = number
    110. If i = ncells And j = ncells Then
    111. solve = True
    112. Exit Function
    113. Else
    114. copyi = i
    115. copyj = j
    116. nextcell(copyi, copyj) 'sicherstellen, dass kopien gelöscht werden ??
    117. If solve(copyi, copyj, sudoku) = True Then
    118. Return True
    119. Else
    120. sudoku(i, j) = ""
    121. Return False
    122. End If
    123. End If
    124. End If
    125. number = number + 1
    126. Loop
    127. End If
    128. End If
    129.  
    130. End Function
    131. 'this sub delivers the coordinates for the next cell in the sudoku grid
    132. Sub nextcell(ByVal i As Integer, ByVal j As Integer)
    133. If i = 8 Then
    134. i = 0
    135. j = j + 1
    136. Else
    137. i = i + 1
    138. End If
    139. End Sub
    140. 'This sub does, if the button solve is clicked: It loads the current values that are put in the grid in the 2-dimensional array / After that the function solve starts
    141. 'After the function solve is finished, the filled array is loaded in the cells, meaning the solved sudoku is shown.
    142. Private Sub Button1_Click_1(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
    143. For i As Integer = 0 To ncells
    144. For j As Integer = 0 To ncells
    145. sudoku(i, j) = Convert.ToInt16(scell(i, j).Text)
    146. Next
    147. Next
    148. solve(0, 0, 0)
    149. For i = 0 To ncells
    150. For j = 0 To ncells
    151. scell(i, j).Text = Convert.ToString(sudoku(i, j))
    152. Next
    153. Next
    154. End Sub




    Dieser Beitrag wurde bereits 4 mal editiert, zuletzt von „clancy700“ ()

    Willkommen im Forum. :thumbup:

    clancy700 schrieb:

    das wäre wirklich super
    wenn Du genau schreiben würdest, wo es hapert.
    Also:
    • Die Prozedur soll dies, macht aber jenes
    • In der Zeile n kommt die Exception xx
    • Wie mache ich, dass bei Auslösen von aaa bbb passiert
    So was in der Art.
    Ansonsten sieht es so aus, als sollten wir Deine Hausaufgaben machen.
    Falls Du diesen Code kopierst, achte auf die C&P-Bremse.
    Jede einzelne Zeile Deines Programms, die Du nicht explizit getestet hast, ist falsch :!:
    Ein guter .NET-Snippetkonverter (der ist verfügbar).
    Programmierfragen über PN / Konversation werden ignoriert!
    Schon einmal vielen Dank für die Antwort :saint: .

    Die Aufgabe einen Sudoku Solver zu programmieren wurde mir eher unfreiwillig zugeteilt, da ich bis vor kurzem noch keinerlei Ahnung vom Programmieren hatte und immer noch kaum habe.
    Mittlerweile habe ich aber schon Gefallen daran gefunden :) .

    Mein Problem ist, dass ich die Funktion Solve() nicht aus dem Sub Button click starten kann. Ich weiß nicht welche Argumente ich hier für die Funktion angeben soll. Momentan steht hier (0,0,0).

    Ein weiteres Problem ist, dass ich mir mit den Variablen, die bei den Funktionen übergeben werden sollen nicht sicher bin ob diese so stimmen.

    Außerdem kann ich, da ich die Funktion Solve() ja nicht wirklich aufrufen kann, nicht überprüfen ob denn mit dem Backtracking alles so stimmt wie ich es geschrieben habe.


    Vielleicht erkennt ja einer von den Profis alleine schon durch bloßes Hinschauen, dass etwas nicht funktionieren kann.
    @clancy700 da kommst Du nicht in Verlegenheit, untypisierte Datentypen zu verwenden.
    Projekt -> Eigenschaften -> Kompilieren
    Falls die Prozedur Sub nextcell(ByVal i As Integer, ByVal j As Integer) i und j zurückgeben soll, musst Du sie Sub nextcell(ByRef i As Integer, ByRef j As Integer) deklarieren.
    Ansonsten werde ich mir den Code mal ansehen.
    Die Deklaration der Button_Click-Prozedur sieht so aus:
    Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
    Falls Du diesen Code kopierst, achte auf die C&P-Bremse.
    Jede einzelne Zeile Deines Programms, die Du nicht explizit getestet hast, ist falsch :!:
    Ein guter .NET-Snippetkonverter (der ist verfügbar).
    Programmierfragen über PN / Konversation werden ignoriert!

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „RodFromGermany“ ()

    Du hast recht, die Funktion nextcell soll die Variablen i und j zurückgeben. Das habe ich jetzt auf Byref umgeändert.

    Wenn ich Strict on mache, zeigt mir das Programm immer in den Situationen in denen ich überprüfe ob die "number" schon im Array enthalten ist einen Fehler an.

    Vielen Dank, dass du den Code durchcheckst :)

    clancy700 schrieb:

    einen Fehler
    Object ==> Integer
    Falls Du diesen Code kopierst, achte auf die C&P-Bremse.
    Jede einzelne Zeile Deines Programms, die Du nicht explizit getestet hast, ist falsch :!:
    Ein guter .NET-Snippetkonverter (der ist verfügbar).
    Programmierfragen über PN / Konversation werden ignoriert!
    @clancy700 : Ich habe schon einen Solver hintermir, und folgendes bevor du auf die Nase fällst: Du brauchst auch ein Array für die Kandidaten in einer leeren Zelle. Wenn die nicht bereit sind, bringen dir keine Lösungsmethoden.
    »There's no need to "teach" atheism. It's the natural result of education without indoctrination.« — Ricky Gervais
    @clancy700 In Deinen Algorithmus hänge ich mich nicht rein, es sei denn, Du hast eine ganz gezielte Frage.
    Deinen Code hab ich mal leicht aufgeräumt.
    Du müsstest in der Prozedur solve() Do Until number = 10 in eine For-Schleife umwanadeln.
    Spoiler anzeigen

    Quellcode

    1. Public Class Form1
    2. Dim ncells As Integer = 8 'here input of the line / column number of sudoku cells
    3. Dim sudoku(0 To ncells, 0 To ncells) As Integer '2 dimensional array for sudoku grid. it is used to save the sudoku solution. if this didn't exsit, the program would be slow because too much time to fill in all the boxes.
    4. Dim number As Integer
    5. Dim scell(0 To ncells, 0 To ncells) As TextBox '2 dimensional array (i, j) with which the sudoku will be created
    6. Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
    7. For i As Integer = 0 To ncells
    8. For j As Integer = 0 To ncells
    9. scell(i, j) = New TextBox 'for every element in the cell I create new sudoku cell
    10. scell(i, j).MinimumSize = New Size(50, 50) 'the size of the cell is defined
    11. scell(i, j).Text = ""
    12. scell(i, j).Font = New Font(scell(i, j).Font.FontFamily, 25, FontStyle.Regular) 'the size of the text input is defined
    13. scell(i, j).TextAlign = HorizontalAlignment.Center 'input is centered
    14. scell(i, j).Width = 50 'the cell width is defined
    15. scell(i, j).Location = New Point(i * 50, j * 50) 'the cells are located depending on their index
    16. scell(i, j).BorderStyle = BorderStyle.FixedSingle 'the style of the cells is defined
    17. scell(i, j).MaxLength = 1 'the input can only be one character
    18. Me.Controls.Add(scell(i, j)) 'the cells are added to the form
    19. Next
    20. Next
    21. End Sub
    22. 'this function checks whether the number assigned is already existant in the line
    23. Function testlines(ByVal jcolumns As Integer, ByVal number As Integer, ByVal sudoku(,) As Integer) As Boolean
    24. For i = 0 To ncells 'the lines are indexed
    25. If sudoku(i, jcolumns) = number Then
    26. Return False 'if there is a cell in the line which has the same number like another one, then there is a clash
    27. End If
    28. Next i
    29. Return True
    30. End Function
    31. ' this function checks whether the number assigned is already existant in the column
    32. Function testcolumns(ByVal ilines As Integer, ByVal number As Integer, ByVal sudoku(,) As Integer) As Boolean
    33. 'in the beginning it is assumed that there is no clash. Then it is checked whether there might be a clash
    34. For j = 0 To ncells 'the columns are indexed
    35. If sudoku(ilines, j) = number Then
    36. Return False 'if there is a cell in the column which has the same number like another one, then there is a clash
    37. End If
    38. Next j
    39. Return True
    40. End Function
    41. Function testboxes(ByVal ilines As Integer, ByVal jcolumns As Integer, ByVal number As Integer, ByVal sudoku(,) As Integer) As Boolean
    42. Dim istart As Integer
    43. Dim jstart As Integer
    44. 'now I define that only the 9 3x3 boxes are checked for clashes
    45. 'lines 1-3 are summarized to 1 big line:
    46. If ilines < 3 Then
    47. istart = 0
    48. 'lines 4-6 are summarizes to 1 big line:
    49. ElseIf ilines < 6 Then
    50. istart = 3
    51. 'lines 7-9 are summarizes to 1 big line:
    52. Else
    53. istart = 6
    54. End If
    55. 'columns 1-3 are summarized to 1 big column:
    56. If jcolumns < 3 Then
    57. jstart = 0
    58. 'columns 4-6 are summarized to 1 big column:
    59. ElseIf jcolumns < 6 Then
    60. jstart = 3
    61. 'columns 7-9 are summarized to 1 big column:
    62. Else
    63. jstart = 6
    64. End If
    65. For i = 0 To (istart + 2) 'the +2 because istart was defined to be maximum 6
    66. For j = 0 To (jstart + 2) 'the +2 because jstart was defined to be maximum 6
    67. If sudoku(i, j) = number Then 'it is checked whether there is a clash in the 9 3x3 boxes
    68. Return False
    69. End If
    70. Next j
    71. Next i
    72. Return True
    73. End Function
    74. 'this function summarizes all the the functions above and returns only true, if
    75. Function safe(ByVal i As Integer, ByVal j As Integer, ByVal number As Integer, ByVal sudoku(,) As Integer) As Boolean
    76. If testlines(j, number, sudoku) AndAlso testcolumns(i, number, sudoku) AndAlso testboxes(i, j, number, sudoku) Then
    77. Return True
    78. End If
    79. Return False
    80. End Function
    81. Function solve(ByVal i As Integer, ByVal j As Integer, ByVal sudoku(,) As Integer) As Boolean
    82. Dim number As Integer
    83. Dim copyi As Integer
    84. Dim copyj As Integer
    85. 'first check whether the cell is empty / if it is not empty, then check whether cell 81 / if cell 81, then sudoku solved
    86. If sudoku(i, j) <> 0 Then
    87. If i = ncells And j = ncells Then
    88. Return True
    89. 'if it is not empy I jump to the next cell by calling the sub nextcell() / then I call the function solve again
    90. Else
    91. nextcell(i, j)
    92. solve(i, j, sudoku)
    93. 'now I assign the numbers 1 to 9 to the variable number and check whether they comply with the restrictions / afterwards I check again whether I am already at cell 81 / if cell 81, then sudoku solved
    94. 'I also make copies of the cells i and j and go on with the copies / by doing that I can jump back to the "old" i and j indexes if the new number does not comply with the restrictions
    95. number = 1
    96. Do Until number = 10
    97. If safe(i, j, number, sudoku) = True Then
    98. sudoku(i, j) = number
    99. If i = ncells And j = ncells Then
    100. Return True
    101. Else
    102. copyi = i
    103. copyj = j
    104. nextcell(copyi, copyj) 'sicherstellen, dass kopien gelöscht werden ??
    105. If solve(copyi, copyj, sudoku) = True Then
    106. Return True
    107. Else
    108. sudoku(i, j) = 0
    109. Return False
    110. End If
    111. End If
    112. End If
    113. number = number + 1
    114. Loop
    115. End If
    116. End If
    117. Return False
    118. End Function
    119. 'this sub delivers the coordinates for the next cell in the sudoku grid
    120. Sub nextcell(ByRef i As Integer, ByRef j As Integer)
    121. If i = 8 Then
    122. i = 0
    123. j = j + 1
    124. Else
    125. i = i + 1
    126. End If
    127. End Sub
    128. 'This sub does, if the button solve is clicked: It loads the current values that are put in the grid in the 2-dimensional array / After that the function solve starts
    129. 'After the function solve is finished, the filled array is loaded in the cells, meaning the solved sudoku is shown.
    130. Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
    131. For i As Integer = 0 To ncells
    132. For j As Integer = 0 To ncells
    133. If scell(i, j).Text = "" Then
    134. sudoku(i, j) = 0
    135. Else
    136. sudoku(i, j) = CInt(scell(i, j).Text)
    137. End If
    138. Next
    139. Next
    140. solve(0, 0, sudoku)
    141. For i = 0 To ncells
    142. For j = 0 To ncells
    143. If sudoku(i, j) <> 0 Then
    144. scell(i, j).Text = sudoku(i, j).ToString
    145. End If
    146. Next
    147. Next
    148. End Sub
    149. End Class
    Falls Du diesen Code kopierst, achte auf die C&P-Bremse.
    Jede einzelne Zeile Deines Programms, die Du nicht explizit getestet hast, ist falsch :!:
    Ein guter .NET-Snippetkonverter (der ist verfügbar).
    Programmierfragen über PN / Konversation werden ignoriert!
    @ RodFromGermany :

    Vielen, vielen Dank, dass Du den Code bereinigt hast. Jetzt kann ich auch die Argumente für die Funktion Solve() bei dem Sub Button Click definieren :) .

    Nun kann ich das Programm starten, nur leider bekomme ich immer noch keinen Output, obwohl mir kein Fehler angezeigt wird :( .
    Natürlich kann ich verstehen, dass Du nicht den ganzen Code umändern willst aber kannst Du mir einen Tipp geben, wo ich anfangen sollte nach dem Fehler zu suchen?

    Ich habe aus dem Loop eine For-Schleife gemacht. Die Solve Funktion sieht jetzt so aus:

    Spoiler anzeigen

    Quellcode

    1. Function solve(ByVal i As Integer, ByVal j As Integer, ByVal sudoku(,) As Integer) As Boolean
    2. Dim number As Integer
    3. Dim copyi As Integer
    4. Dim copyj As Integer
    5. 'first check whether the cell is empty / if it is not empty, then check whether cell 81 / if cell 81, then sudoku solved
    6. If sudoku(i, j) <> 0 Then
    7. If i = ncells And j = ncells Then
    8. Return True
    9. 'if it is not empy I jump to the next cell by calling the sub nextcell() / then I call the function solve again
    10. Else
    11. nextcell(i, j)
    12. solve(i, j, sudoku)
    13. 'now I assign the numbers 1 to 9 to the variable number and check whether they comply with the restrictions / afterwards I check again whether I am already at cell 81 / if cell 81, then sudoku solved
    14. 'I also make copies of the cells i and j and go on with the copies / by doing that I can jump back to the "old" i and j indexes if the new number does not comply with the restrictions
    15. For number = 1 To 9
    16. If safe(i, j, number, sudoku) = True Then
    17. sudoku(i, j) = number
    18. If i = ncells And j = ncells Then
    19. Return True
    20. Else
    21. copyi = i
    22. copyj = j
    23. nextcell(copyi, copyj) 'sicherstellen, dass kopien gelöscht werden ??
    24. If solve(copyi, copyj, sudoku) = True Then
    25. Return True
    26. Else
    27. sudoku(i, j) = 0
    28. Return False
    29. End If
    30. End If
    31. End If
    32. Next
    33. End If
    34. End If
    35. Return False
    36.  
    37. End Function

    @ clancy700
    Jetzt wird es interessant, Du musst lernen, Dein Programm zu debuggen, gugst Du hier.
    Fang an und setz in die Button_Click-Routine einen Haltepunkt. Führe jede Zeile einzeln aus und sieh Dir mit Klick drauf, Shift+F9 den Inhalt der Variablen an. => anpinnen, Überwachungsfenster.
    Wenn in einer Zeile der Inhalt einer Variablen nicht Deiner Vorstellung entspricht, hast Du einen Fehler gefunden. Entweder im Quelltext oder in Deinem Plan.
    Und
    Jede Zeile Quelltext, von deren Richtigkeit Du Dich nicht überzeugst hast, ist falsch (ja, es ist so).
    Falls Du diesen Code kopierst, achte auf die C&P-Bremse.
    Jede einzelne Zeile Deines Programms, die Du nicht explizit getestet hast, ist falsch :!:
    Ein guter .NET-Snippetkonverter (der ist verfügbar).
    Programmierfragen über PN / Konversation werden ignoriert!
    @ RodFromGermany :

    ich habe den Vormittag damit verbracht den Quelltext einzeln zu überprüfen und habe deshalb auch ein paar Korrekturen vorgenommen.
    Es waren bis jetzt immer die Zeilen mit den Spalten vertauscht, d.h. i stand für Spalten und j für Zeilen. Das habe ich umgeändert indem ich bei dem String die Textfelder anders einlese.
    Außerdem war ein Fehler in der Funktion, die überprüft, ob die Zahl im jeweiligen 3x3 Quadrat zulässig ist. Den habe ich auch behoben.

    Alle Funktionen und Subs sollten nun in Ordnung sein, bis auf die Backtracking Funktion.

    Bei der Backtracking Funktion passiert folgendes:

    Die Funktion weißt dem ersten freien Feld die erste freie Nummer zu.
    Dann werden Kopien von i und j angefertigt, die nächste Zelle mit diesen ausgewählt und die Funktion wieder mit den neuen Kopien aufgerufen. (vorausgesetzt ich interpretiere das richtig)
    Dem zweiten freien Feld wird dann die zweite freie Nummer zugewiesen.
    Dann werden wieder Kopien von den neuen i und j angefertigt, die nächste Zelle mit diesen ausgewählt und die Funktion wieder mit den neuen Kopien aufgerufen.
    ==> jetzt passiert aber plötzlich, dass die Funktion, nachdem sie wieder aufgerufen wird gleich auf das letzte End IF springt, dann auf return false und schließlich in einer Schleife endet, in der sie aus dem Sudoku Array die neu gespeicherten Werte wieder löscht :(

    Kannst Du bzw. natürlich auch jemand anders mir sagen, was ich hier verändern sollte?

    Ich probiere gerade selbst herum, habe aber leider noch keine Lösung gefunden.


    Das ist der veränderte Code:
    Spoiler anzeigen

    Quellcode

    1. Public Class Form1
    2. [vbnet]Dim ncells As Integer = 8 'here input of the line / column number of sudoku cells
    3. Dim sudoku(0 To ncells, 0 To ncells) As Integer '2 dimensional array for sudoku grid. it is used to save the sudoku solution. if this didn't exsit, the program would be slow because too much time to fill in all the boxes.
    4. Dim number As Integer
    5. Dim scell(0 To ncells, 0 To ncells) As TextBox '2 dimensional array (i, j) with which the sudoku will be created
    6. Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
    7. For i As Integer = 0 To ncells
    8. For j As Integer = 0 To ncells
    9. scell(i, j) = New TextBox 'for every element in the cell I create new sudoku cell
    10. scell(i, j).MinimumSize = New Size(50, 50) 'the size of the cell is defined
    11. scell(i, j).Text = ""
    12. scell(i, j).Font = New Font(scell(i, j).Font.FontFamily, 25, FontStyle.Regular) 'the size of the text input is defined
    13. scell(i, j).TextAlign = HorizontalAlignment.Center 'input is centered
    14. scell(i, j).Width = 50 'the cell width is defined
    15. scell(i, j).Location = New Point(i * 50, j * 50) 'the cells are located depending on their index
    16. scell(i, j).BorderStyle = BorderStyle.FixedSingle 'the style of the cells is defined
    17. scell(i, j).MaxLength = 1 'the input can only be one character
    18. Me.Controls.Add(scell(i, j)) 'the cells are added to the form
    19. Next
    20. Next
    21. End Sub
    22. 'this function checks whether the number assigned is already existant in the line
    23. Function testlines(ByVal jcolumns As Integer, ByVal number As Integer, ByVal sudoku(,) As Integer) As Boolean
    24. 'in the beginning it is assumed that there is no clash. Then it is checked whether there might be a clash
    25. Dim i As Integer
    26. For i = 0 To ncells 'the lines are indexed
    27. If sudoku(i, jcolumns) = number Then
    28. Return False 'if there is a cell in the line which has the same number like another one, then there is a clash
    29. End If
    30. Next i
    31. Return True
    32. End Function
    33. ' this function checks whether the number assigned is already existant in the column
    34. Function testcolumns(ByVal ilines As Integer, ByVal number As Integer, ByVal sudoku(,) As Integer) As Boolean
    35. 'in the beginning it is assumed that there is no clash. Then it is checked whether there might be a clash
    36. Dim j As Integer
    37. For j = 0 To ncells 'the columns are indexed
    38. If sudoku(ilines, j) = number Then
    39. Return False 'if there is a cell in the column which has the same number like another one, then there is a clash
    40. End If
    41. Next j
    42. Return True
    43. End Function
    44.  
    45. Function testboxes(ByVal ilines As Integer, ByVal jcolumns As Integer, ByVal number As Integer, ByVal sudoku(,) As Integer) As Boolean
    46. Dim istart As Integer
    47. Dim jstart As Integer
    48. Dim i As Integer
    49. Dim j As Integer
    50.  
    51. 'now I define that only the 9 3x3 boxes are checked for clashes
    52. 'lines 1-3 are summarized to 1 big line:
    53. If ilines < 3 Then
    54. istart = 0
    55. 'lines 4-6 are summarizes to 1 big line:
    56. ElseIf ilines < 6 Then
    57. istart = 3
    58. 'lines 7-9 are summarizes to 1 big line:
    59. Else
    60. istart = 6
    61. End If
    62. 'columns 1-3 are summarized to 1 big column:
    63. If jcolumns < 3 Then
    64. jstart = 0
    65. 'columns 4-6 are summarized to 1 big column:
    66. ElseIf jcolumns < 6 Then
    67. jstart = 3
    68. 'columns 7-9 are summarized to 1 big column:
    69. Else
    70. jstart = 6
    71. End If
    72. For i = istart To (istart + 2) 'the +2 because istart was defined to be maximum 6
    73. For j = jstart To (jstart + 2) 'the +2 because jstart was defined to be maximum 6
    74. If sudoku(i, j) = number Then 'it is checked whether there is a clash in the 9 3x3 boxes
    75. Return False
    76. End If
    77. Next j
    78. Next i
    79. Return True
    80. End Function
    81. 'this function summarizes all the the functions above and returns only true, if
    82. Function safe(ByVal i As Integer, ByVal j As Integer, ByVal number As Integer, ByVal sudoku(,) As Integer) As Boolean
    83. safe = False
    84. If testlines(j, number, sudoku) AndAlso testcolumns(i, number, sudoku) AndAlso testboxes(i, j, number, sudoku) = True Then
    85. Return True
    86. End If
    87. Return False
    88. End Function
    89.  
    90. Function solve(ByVal i As Integer, ByVal j As Integer, ByVal sudoku(,) As Integer) As Boolean
    91. Dim number As Integer
    92. Dim copyi As Integer
    93. Dim copyj As Integer
    94. 'first check whether the cell is empty / if it is not empty, then check whether cell 81 / if cell 81, then sudoku solved
    95. If sudoku(i, j) <> 0 Then
    96. If i = ncells And j = ncells Then
    97. Return True
    98. 'if it is not empy I jump to the next cell by calling the sub nextcell() / then I call the function solve again
    99. Else
    100. nextcell(i, j)
    101. solve(i, j, sudoku)
    102. 'now I assign the numbers 1 to 9 to the variable number and check whether they comply with the restrictions / afterwards I check again whether I am already at cell 81 / if cell 81, then sudoku solved
    103. 'I also make copies of the cells i and j and go on with the copies / by doing that I can jump back to the "old" i and j indexes if the new number does not comply with the restrictions
    104. For number = 1 To 8
    105. If safe(i, j, number, sudoku) = True Then
    106. sudoku(i, j) = number
    107. If i = ncells And j = ncells Then
    108. Return True
    109. Else
    110. copyi = i
    111. copyj = j
    112. nextcell(copyi, copyj) 'sicherstellen, dass kopien gelöscht werden ??
    113. If solve(copyi, copyj, sudoku) Then
    114. Return True
    115. Else
    116. sudoku(i, j) = 0
    117. Return False
    118. End If
    119. End If
    120. End If
    121. Next
    122. End If
    123. End If
    124. Return False
    125.  
    126. End Function
    127. 'this sub delivers the coordinates for the next cell in the sudoku grid
    128. Sub nextcell(ByRef i As Integer, ByRef j As Integer)
    129. If i = 8 Then
    130. i = 0
    131. j = j + 1
    132. Else
    133. i = i + 1
    134. End If
    135. End Sub
    136. 'This sub does, if the button solve is clicked: It loads the current values that are put in the grid in the 2-dimensional array / After that the function solve starts
    137. 'After the function solve is finished, the filled array is loaded in the cells, meaning the solved sudoku is shown.
    138. Private Sub Button1_Click_1(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
    139. For i As Integer = 0 To ncells
    140. For j As Integer = 0 To ncells
    141. If scell(i, j).Text = "" Then
    142. sudoku(j, i) = 0
    143. Else
    144. sudoku(j, i) = CInt(scell(i, j).Text)
    145. End If
    146. Next
    147. Next
    148. solve(0, 0, sudoku)
    149. For i = 0 To ncells
    150. For j = 0 To ncells
    151. If sudoku(i, j) <> 0 Then
    152. scell(j, i).Text = sudoku(i, j).ToString
    153. End If
    154. Next
    155. Next
    156. End Sub
    157. End Class
    158. [/vbnet]

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „clancy700“ ()

    2 Vorschläge zur besseren Lesbarkeit:
    1. Bitte VB-Tag benutzen - aber richtig
    2. Leerzeilen ohne Sinn wegmachen
    welche Funktion ist überhaupt die "Backtracking"-Funktion? Was ist Backtracking?

    ah - ok - Wikipedia sei dank.
    Aber Backtracking muss ja rekursiv implementiert sein - und da sehe ich noch nix dergleichen - kann auch an der unlesbaren Darstellung liegen.
    Hallo, die Backtracking Funktion hat die Bezeichnung Solve()

    Ich hoffe so ist der Code besser lesbar:

    Spoiler anzeigen

    VB.NET-Quellcode

    1. Public Class Form1
    2. Public Class Form1
    3. Dim ncells As Integer = 8 'here input of the line / column number of sudoku cells
    4. Dim sudoku(0 To ncells, 0 To ncells) As Integer '2 dimensional array for sudoku grid. it is used to save the sudoku solution. if this didn't exsit, the program would be slow because too much time to fill in all the boxes.
    5. Dim number As Integer
    6. Dim scell(0 To ncells, 0 To ncells) As TextBox '2 dimensional array (i, j) with which the sudoku will be created
    7. Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
    8. For i As Integer = 0 To ncells
    9. For j As Integer = 0 To ncells
    10. scell(i, j) = New TextBox 'for every element in the cell I create new sudoku cell
    11. scell(i, j).MinimumSize = New Size(50, 50) 'the size of the cell is defined
    12. scell(i, j).Text = ""
    13. scell(i, j).Font = New Font(scell(i, j).Font.FontFamily, 25, FontStyle.Regular) 'the size of the text input is defined
    14. scell(i, j).TextAlign = HorizontalAlignment.Center 'input is centered
    15. scell(i, j).Width = 50 'the cell width is defined
    16. scell(i, j).Location = New Point(i * 50, j * 50) 'the cells are located depending on their index
    17. scell(i, j).BorderStyle = BorderStyle.FixedSingle 'the style of the cells is defined
    18. scell(i, j).MaxLength = 1 'the input can only be one character
    19. Me.Controls.Add(scell(i, j)) 'the cells are added to the form
    20. Next
    21. Next
    22. End Sub
    23. 'this function checks whether the number assigned is already existant in the line
    24. Function testlines(ByVal jcolumns As Integer, ByVal number As Integer, ByVal sudoku(,) As Integer) As Boolean
    25. 'in the beginning it is assumed that there is no clash. Then it is checked whether there might be a clash
    26. Dim i As Integer
    27. For i = 0 To ncells 'the lines are indexed
    28. If sudoku(i, jcolumns) = number Then
    29. Return False 'if there is a cell in the line which has the same number like another one, then there is a clash
    30. End If
    31. Next i
    32. Return True
    33. End Function
    34. ' this function checks whether the number assigned is already existant in the column
    35. Function testcolumns(ByVal ilines As Integer, ByVal number As Integer, ByVal sudoku(,) As Integer) As Boolean
    36. 'in the beginning it is assumed that there is no clash. Then it is checked whether there might be a clash
    37. Dim j As Integer
    38. For j = 0 To ncells 'the columns are indexed
    39. If sudoku(ilines, j) = number Then
    40. Return False 'if there is a cell in the column which has the same number like another one, then there is a clash
    41. End If
    42. Next j
    43. Return True
    44. End Function
    45.  
    46. Function testboxes(ByVal ilines As Integer, ByVal jcolumns As Integer, ByVal number As Integer, ByVal sudoku(,) As Integer) As Boolean
    47. Dim istart As Integer
    48. Dim jstart As Integer
    49. Dim i As Integer
    50. Dim j As Integer
    51.  'now I define that only the 9 3x3 boxes are checked for clashes
    52. 'lines 1-3 are summarized to 1 big line:
    53. If ilines < 3 Then
    54. istart = 0
    55. 'lines 4-6 are summarizes to 1 big line:
    56. ElseIf ilines < 6 Then
    57. istart = 3
    58. 'lines 7-9 are summarizes to 1 big line:
    59. Else
    60. istart = 6
    61. End If
    62. 'columns 1-3 are summarized to 1 big column:
    63. If jcolumns < 3 Then
    64. jstart = 0
    65. 'columns 4-6 are summarized to 1 big column:
    66. ElseIf jcolumns < 6 Then
    67. jstart = 3
    68. 'columns 7-9 are summarized to 1 big column:
    69. Else
    70. jstart = 6
    71. End If
    72. For i = istart To (istart + 2) 'the +2 because istart was defined to be maximum 6
    73. For j = jstart To (jstart + 2) 'the +2 because jstart was defined to be maximum 6
    74. If sudoku(i, j) = number Then 'it is checked whether there is a clash in the 9 3x3 boxes
    75. Return False
    76. End If
    77. Next j
    78. Next i
    79. Return True
    80. End Function
    81. 'this function summarizes all the the functions above and returns only true, if
    82. Function safe(ByVal i As Integer, ByVal j As Integer, ByVal number As Integer, ByVal sudoku(,) As Integer) As Boolean
    83. safe = False
    84. If testlines(j, number, sudoku) AndAlso testcolumns(i, number, sudoku) AndAlso testboxes(i, j, number, sudoku) = True Then
    85. Return True
    86. End If
    87. Return False
    88. End Function
    89.  
    90. Function solve(ByVal i As Integer, ByVal j As Integer, ByVal sudoku(,) As Integer) As Boolean
    91. Dim number As Integer
    92. Dim copyi As Integer
    93. Dim copyj As Integer
    94. 'first check whether the cell is empty / if it is not empty, then check whether cell 81 / if cell 81, then sudoku solved
    95. If sudoku(i, j) <> 0 Then
    96. If i = ncells And j = ncells Then
    97. Return True
    98. 'if it is not empy I jump to the next cell by calling the sub nextcell() / then I call the function solve again
    99. Else
    100. nextcell(i, j)
    101. solve(i, j, Sudoku)
    102. 'now I assign the numbers 1 to 9 to the variable number and check whether they comply with the restrictions / afterwards I check again whether I am already at cell 81 / if cell 81, then sudoku solved
    103. 'I also make copies of the cells i and j and go on with the copies / by doing that I can jump back to the "old" i and j indexes if the new number does not comply with the restrictions
    104. For number = 1 To 9
    105. If safe(i, j, number, sudoku) = True Then
    106. sudoku(i, j) = number
    107. If i = ncells And j = ncells Then
    108. Return True
    109. Else
    110. copyi = i
    111. copyj = j
    112. nextcell(copyi, copyj) 'sicherstellen, dass kopien gelöscht werden ??
    113. If solve(copyi, copyj, sudoku) = True Then
    114. Return True
    115. Else
    116. sudoku(i, j) = 0
    117. Return False
    118. End If
    119. End If
    120. End If
    121. Next
    122. End If
    123. End If
    124. Return False
    125. End Function
    126. 'this sub delivers the coordinates for the next cell in the sudoku grid
    127. Sub nextcell(ByRef i As Integer, ByRef j As Integer)
    128. If i = 8 Then
    129. i = 0
    130. j = j + 1
    131. Else
    132. i = i + 1
    133. End If
    134. End Sub
    135. 'This sub does, if the button solve is clicked: It loads the current values that are put in the grid in the 2-dimensional array / After that the function solve starts
    136. 'After the function solve is finished, the filled array is loaded in the cells, meaning the solved sudoku is shown.
    137. Private Sub Button1_Click_1(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
    138. For i As Integer = 0 To ncells
    139. For j As Integer = 0 To ncells
    140. If scell(i, j).Text = "" Then
    141. sudoku(j, i) = 0
    142. Else
    143. sudoku(j, i) = CInt(scell(i, j).Text)
    144. End If
    145. Next
    146. Next
    147. solve(0, 0, Sudoku)
    148. For i = 0 To ncells
    149. For j = 0 To ncells
    150. If sudoku(i, j) <> 0 Then
    151. scell(j, i).Text = sudoku(i, j).ToString
    152. End If
    153. Next
    154. Next
    155. End Sub
    156. End Class

    Dieser Beitrag wurde bereits 4 mal editiert, zuletzt von „clancy700“ ()

    du kannst es nochmal editieren, und die sinnlosen Leerzeilen wegmachen.

    immerhin kann ich schonmal erkennen, dass wirklich Rekursion vorliegt, nur versteh ich die Funktionsweise nicht.
    Warum läuft die Schleife von 1 bis 8? Wären nicht 9 Ziffern durchzuchecken?

    Dieser Beitrag wurde bereits 3 mal editiert, zuletzt von „ErfinderDesRades“ ()

    ja da hast Du natürlich vollkommen recht, die Schleife muss von 1 bis 9 laufen.
    Ich habe, da ich die Zeilen und Spalten immer von 0 bis 8 indiziere hier den Fehler gemacht die Zahlen, die ich einsetze auch nur bis 8 laufen zu lassen X/


    Der Backtracking Algorithmus bzw. die Funktion Solve() sollte folgendes machen:

    Überprüfen, ob das Feld frei ist. Falls nicht, dann zum nächsten Feld springen und gleichzeitig überprüfen, ob schon Feld 81 erreicht ist, denn dann könnte die Funktion beendet werden.
    Dann sollen die Zahlen 1 bis 9 durchprobiert werden, angefangen bei eins. Erfüllt eine dieser Zahlen die Restriktionen, so wird dem aktuellen Feld die Zahl zugewiesen. Sollte das aktuelle Feld wieder Feld 81 sein, kann die Funktion hier auch aufhören.
    Wenn nicht Feld 81, werden Kopien von dem Zeilenindex und Spaltenindex angelegt und mit diesen weitergemacht.
    Sollte es dazu kommen, dass eine Zahl die Restriktionen nicht mehr erfüllt, so wird zum vorhergehenden Feld zurückgegangen und dessen Inhalt gelöscht und ein neuer passender Wert vergeben. Sollte dies hier auch nicht möglich sein, wird wieder ein Feld weiter zurückgegangen usw.

    Dieser Beitrag wurde bereits 3 mal editiert, zuletzt von „clancy700“ ()

    Falls du den Code änderst, und noch weiter drüber reden möchtest, dann änder ihn doch auch im Post.

    Dass man nicht verschiedene Codes diskutiert.

    Eine richtige Rekursion besteht aber immer noch nicht, denn die Solve-Methode ruft sich selbst ja nur ein einziges Mal auf. Sie sollte sich aber für alle noch ausstehenden Zellen jeweils ein mal aufrufen - da musste dir noch eine sinnige Schleife für ausdenken.

    ach - und noch ein Tipp: Arrays sind Cloneable.
    Du kannst also mit einem Einzeiler einen Klon erstellen, damit die Solve-Funktion in tieferer Verschachtelung nicht das Ausgangs-Sudoku-Array verwüstet. Guggemol:

    VB.NET-Quellcode

    1. Dim arr(2, 4) As Integer
    2. Dim arr2 = DirectCast(arr.Clone, Integer(,))

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „ErfinderDesRades“ ()

    @clancy700 Ohne Deinen jetzigen Algorithmus weiter zu analysieren:
    Du musst alle Zeilen ansehen,
    Du musst alle Spalten ansehen
    und Du musst alle Sub-Quadrate ansehen.
    Dann ist es erforderlich, für jedes einzelne leere Feld alle noch möglichen Werte vorrätig zu haben, da kann man, wenn nur noch einer übrig ist, das Feld auf Gelöst setzen.
    Wenn in einer 9er Gruppe z.B. ein Paar zwei Mal oder ein Tripel drei Mal vorkommt usw., können diese 2 bzw. 3 Werte aus allen anderen Wertetupeln leerer Felder rausgenommen werden.
    Falls Du diesen Code kopierst, achte auf die C&P-Bremse.
    Jede einzelne Zeile Deines Programms, die Du nicht explizit getestet hast, ist falsch :!:
    Ein guter .NET-Snippetkonverter (der ist verfügbar).
    Programmierfragen über PN / Konversation werden ignoriert!

    RodFromGermany schrieb:

    Du musst alle Zeilen ansehen,
    Du musst alle Spalten ansehen
    und Du musst alle Sub-Quadrate ansehen.
    Das tut er. Ob richtig weiß ich nicht, jdfs. die Methoden dafür sind da, und iwelche groben Schnitzer sprangen mir nicht ins Auge.

    Und groß Intelligenz will er ja garnet einbauen. "BackTracking" - bedeutet: alles mögliche auszuprobieren - im Wortsinne: sobald sich ein Ansatz als unmöglich herausstellt, wird er nicht mehr weiterverfolgt.

    Iwann hab ich das auch mal gemacht - ein Sudoku-Feld ist klein genug, dass ein Rechner das problemlos abarbeiten kann.

    Dieser Beitrag wurde bereits 2 mal editiert, zuletzt von „ErfinderDesRades“ ()

    @clancy700 : Also, folgendes gibt es (braucht halt die Kandidaten) und die grünen habe ich implementiert und damit eine Erfolgsquote von ~88%:
    Spoiler anzeigen

    Chain
    Double Implication Chain
    Forcing Chain
    Remote Pair
    X-Chain
    XY-Chain

    Coloring
    Color Trap
    Color Wing
    Color Wrap

    Fish
    Finned Jellyfish
    Finned Swordfish
    Finned X-Wing
    Jellyfish
    Swordfish
    X-Wing

    Hidden Subset
    Hidden Pair
    Hidden Quadruple
    Hidden Triple

    Intersection
    Block-Line Interaction
    Line-Block Interaction


    Loop
    Single Loop

    Naked Subset
    Naked Pair
    Naked Quadruple
    Naked Triple

    Single Digit Pattern
    Empty Rectangle
    Long String Kite
    Skyscraper
    Turbot Fish
    Two-String Kite

    Singles
    Full House
    Hidden Single
    Last Digit
    Naked Single

    Uniqueness
    Bivalue Universal Grave
    Unique Rectangle Type 1
    Unique Rectangle Type 2
    Unique Rectangle Type 3
    Unique Rectangle Type 4

    Wing
    W Wing
    WXYZ Wing
    XY Wing
    XYZ Wing

    »There's no need to "teach" atheism. It's the natural result of education without indoctrination.« — Ricky Gervais