VB.Net-Forum - Beitragsübersicht -
ThemaSON: Sudoku mit Kandidaten lösen
Von Jörg
Datum 26. Februar 2021 um 15:30:47
Frage Hallo,
ich versuche ein Sudoku per Programmierung in Visual Studio 2019 zu lösen - dazu ermittle ich die Kandidaten je Zelle. Diese Kandidaten möchte ich dann durchprobieren anstatt immer je Zelle die Zahlen 1-9
durchzuprobieren.
Mein Problem ist, dass das Programm die Zelle (0,8) mit einer leeren Kandidatenliste versieht und es dann zu einem Fehler kommt.
Ich würde gerne das komplette Projekt hochladen, weiß aber nicht wie das geht...
Oder ist es sinnvoll nur den Code zu präsentieren?
Viele Grüße,
Jörg
Antwort:
Von Jörg
Datum 26. Februar 2021 um 19:09:34
Antwort Hallo,
dankeschön...
ich habe ein Script in VB.NET übersetzt und dieser Solver läuft (probiert die Zahlen 1-9). Jetzt versuche ich einen schnelleren Solver zu erstellen, dieser soll nur die Kandidaten durchprobieren.
Ich denke aber man wird nicht daran vorbeikommen den gesamten Code zu posten - sonst hat man keinen Überblick. Hier der Code in dem der Fehler auftritt:
Function SolveSudoku(matrix(,) As Integer, hmatrix(,) As String) As Boolean
Dim row As Integer, col As Integer, num As Integer, k As Integer, h As Integer, startrow As Integer, startcol As Integer, s As Integer, f As Integer
Dim checkBlankSpaces As Boolean = False
'Kandidaten je Matrix-Zelle, die nicht eine vorgegebene Zahl enthält, ermitteln
For row = 0 To 8
For col = 0 To 8
'Zeileninfo
If (hmatrix(row, col)).Length > 1 Then
For k = 0 To 8
If (hmatrix(row, k)).Length = 1 Then
hmatrix(row, col) = hmatrix(row, col).Replace(hmatrix(row, k), "")
End If
Next
End If
If (hmatrix(row, col)).Length = 0 Then
MessageBox.Show("Rätsel nicht lösbar.")
Exit Function
End If
'Spalteninfo
If (hmatrix(row, col)).Length > 1 Then
For k = 0 To 8
If (hmatrix(k, col)).Length = 1 Then
hmatrix(row, col) = hmatrix(row, col).Replace(hmatrix(k, col), "")
End If
Next
End If
If (hmatrix(row, col)).Length = 0 Then
MessageBox.Show("Rätsel nicht lösbar.")
Exit Function
End If
'Quadratinfo
If (hmatrix(row, col)).Length > 1 Then
startrow = row - (row Mod 3)
startcol = col - (col Mod 3)
For h = startrow To startrow + 2
For k = startcol To startcol + 2
If (hmatrix(h, k)).Length = 1 Then
hmatrix(row, col) = hmatrix(row, col).Replace(hmatrix(h, k), "")
End If
Next
Next
End If
If (hmatrix(row, col)).Length = 0 Then
MessageBox.Show("Rätsel nicht lösbar.")
Exit Function
End If
Next
Next
' verify If sudoku Is already solved And If Not solved,
' get Next "blank" space position
For row = 0 To 8
For col = 0 To 8
If matrix(row, col) = UNASSIGNED Then
checkBlankSpaces = True
Exit For
End If
Next col
If checkBlankSpaces = True Then
Exit For
End If
Next row
' no more "blank" spaces means the puzzle Is solved
If checkBlankSpaces = False Then
Return True
End If
'Try To fill "blank" space With correct num
'anzahl schritte
s = hmatrix(row, col).Length

For f = 0 To s - 1
num = CInt(hmatrix(row, col).Substring(f, 1))
'isSafe checks that num isn't already present
'In the row, column, Or 3x3 box (see below)
If IsSafe(matrix, row, col, num) Then
matrix(row, col) = num
If SolveSudoku(matrix, hmatrix) = True Then
Return True
End If
'If num Is placed In incorrect position,
'mark As "blank" again Then backtrack With
'a different num
matrix(row, col) = UNASSIGNED
End If
Next
Return False
End Function
[ Antwort schreiben | Zurück zum VB.Net-Forum | Forum-Hilfe ]
Antworten
SON: Sudoku mit Kandidaten lösen - Jörg 26. Februar 2021 um 15:30:47
Re: Sudoku mit Kandidaten lösen - Nico 26. Februar 2021 um 15:35:46
Re: Sudoku mit Kandidaten lösen - Jörg 26. Februar 2021 um 19:09:34
Re: Sudoku mit Kandidaten lösen - Jörg 26. Februar 2021 um 20:44:22
Re: Sudoku mit Kandidaten lösen - Jörg 26. Februar 2021 um 21:07:43
Re: Sudoku mit Kandidaten lösen - Nico 28. Februar 2021 um 10:46:16

Ihre Antwort
(Nick-)Name   Wichtige Informationen zur Namensangabe
E-Mail (opt.)  Wichtige Informationen zur Angabe einer eMail-Adresse
Thema   Wichtige Informationen zur Angabe eines Themas
Betrifft (IDE)  Sonstiges
Ihre Antwort
Smilies
Mehr...
FettKursivUnterstrichen   Übersicht der Tipp-KürzelÜbersicht der Projekt-KürzelÜbersicht der Bücher-Kürzel 
Homepage
Titel
Root-Smilies              
             
             
[ Zurück zum VB.Net-Forum | Forum-Archiv | Forum-Hilfe | Chat ]

Zum Seitenanfang

Startseite | VB-/VBA-Tipps | Projekte | Tutorials | API-Referenz | Komponenten | Bücherecke | Gewinnspiele | VB.Net | VB/VBA-Forum | DirectX | DirectX-Forum | Chat | Ausschreibungen | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Sonntag, 13. Dezember 2015