Der Sudoku-Resolver
Der Sudoku-Resolver ist eine, mit Hilfe von Microsoft Excel und VBA implementierte Anwendung, zur
Lösung der allseits beliebten Sudoku-Rätsel.
Viel Wissenswertes zum Thema Sudoku erfährst Du in der Wikipedia
Für die Wissbegierigen wird hier erklärt, wie der Sudoku-Resolver funktioniert. Alle anderen können
sich erst die Bedienungsanleitung
ansehen oder sofort den Sudoku-Resolver herunterladen.
So wurde es gemacht
Die Voraussetzungen zur Implementierung einer Software, welche Sudoku-Rätsel löst, sind denkbar gut.
- Das Spielfeld ist eine zweidimensionale Matrix, welche sich hervorragend durch Software verwalten lässt.
- Die Matrix ist nur 9 * 9 Felder groß, woraus sich eine max. Rekursionstiefe von 81 ergibt. Damit sollte selbst
ein spärlichst ausgerüsteter Rechner zurecht kommen.
- Für jeden möglich Spielzug gibt es lediglich 3 Regeln.
Da für das Spielfeld eine Matrix verwaltet werden muss, liegt es eigentlich nahe, den Sudoku-Resovler mit Hilfe
einer Tabellenkalkulation zu implementieren. Da gerade nicht Besseres zur Hand war, habe ich zu diesem Zweck Microsoft Excel verwendet.
Die Matrix für das komplette Sudoku-Spielfeld ist also durch die Microsoft Excel Tabelle gegeben. Das Sudoku-Spielfeld ist
aber in 9 kleiner Matrizes von 3 * 3 Feldern unterteilt, den Blöcken.
Um so einen Block per Software zu durchlaufen, werden zwei
Schleifen benötigt (eine über die Zeilen, eine über die Spalten des Blocks) welche jeweils 3 Schritte beinhalten. Darüber hinaus
ist noch die Position des Blockes im Sudoku-Spielfeld zu berücksichtigen.
Um dem gerecht zu werden, sind 2 Arrays vorgesehen, von welche eines rows die Zeilenindizes und eines cols die
Spaltenindizes des Blockes, bezogen auf das komplette Sudoku-Spielfeld enthält. Die Initialisierung dieser Arrays sieht so aus:
Private Sub initRowsAndCols(fldNr As Integer, rows() As Integer, cols() As Integer)
'
' Stellt das Mapping zwischen Sudoku-Matrix und Excel-Tabelle her.
' Eine Sudoku-Matrix besteht aus 9 Feldern (fldNr), welche wiederum
' aus 9 Feldern bestehen (rows(0..2) * cols(0..2)).
'
Select Case fldNr
Case 1:
rows(0) = 2 ' Zeile 2 in der Excel-Tabelle
rows(1) = 3 ' Zeile 3 in der Excel-Tabelle
rows(2) = 4 ' Zeile 4 in der Excel-Tabelle
cols(0) = 2 ' Spalte A in der Excel-Tabelle
cols(1) = 3 ' Spalte B in der Excel-Tabelle
cols(2) = 4 ' Spalte C in der Excel-Tabelle
Case 2:
rows(0) = 2
rows(1) = 3
rows(2) = 4
cols(0) = 5
cols(1) = 6
cols(2) = 7
Case 3:
rows(0) = 2
rows(1) = 3
rows(2) = 4
cols(0) = 8
cols(1) = 9
cols(2) = 10
Case 4:
rows(0) = 5
rows(1) = 6
rows(2) = 7
cols(0) = 2
cols(1) = 3
cols(2) = 4
Case 5:
rows(0) = 5
rows(1) = 6
rows(2) = 7
cols(0) = 5
cols(1) = 6
cols(2) = 7
Case 6:
rows(0) = 5
rows(1) = 6
rows(2) = 7
cols(0) = 8
cols(1) = 9
cols(2) = 10
Case 7:
rows(0) = 8
rows(1) = 9
rows(2) = 10
cols(0) = 2
cols(1) = 3
cols(2) = 4
Case 8:
rows(0) = 8
rows(1) = 9
rows(2) = 10
cols(0) = 5
cols(1) = 6
cols(2) = 7
Case 9:
rows(0) = 8
rows(1) = 9
rows(2) = 10
cols(0) = 8
cols(1) = 9
cols(2) = 10
End Select
End Sub
Der abgebildete VB(A)-Code wurde mit dem VBA2HTML-Konverter erzeugt.
Nachdem das Spielfeld nun softwaretechnisch im Griff ist, muss eine Lösungskonzept her. Diese sieht wie folgt aus:
- Es reicht vollkommen aus, wenn der Sudoku-Resolver eine Lösung für das Sudoku-Rätsel findet.
- Der Sudoku-Resolver arbeitet rekursiv und findet die Lösung des Rätsels durch stupides Ausprobieren.
- Der Sudoku-Resolver fängt mit der Suche nach der Lösung im ersten Block (oben, links) an.
- Der Sudoku-Resolver füllt einen Block komplett aus, bevor er mit der Lösungssuche im nächten Block fortfährt.
- Beim ausfüllen der Blöcke werden Zahlen aufsteigend von 1 bis 9 verwendet.
- Wenn 81 Zahlen in der Soduku-Matrix verteilt sind ist eine Lösung gefunden.
Die erste Regel bei der Lösung eines Sudoku-Rätsels besagt, dass in jedem Block alle Zahlen von 1 bis 9 enthalten sein müssen
aber keine dieser Zahlen doppelt vorhanden sein darf.
Diese Regel wird dadurch abgebildet, dass vor jedem Spielzug die kleinste noch fehlende Zahl eines Blockes ermittelt wird.
Dabei wird sichergestellt, dass im Block jede Ziffer von 1 bis 9 nur einmal enthalten ist. Die Ermittlung der als nächstes zu
platzierenden Zahl erfolgt so:
Private Function getNextVal(fldNr As Integer) As Integer
'
' Ermittelt aus dem Sudoku-Feld die nächste fehlende Zahl.
'
Dim rows(3) As Integer
Dim cols(3) As Integer
Dim ri As Integer
Dim ci As Integer
Dim i As Integer
Dim curVal As Integer
Dim setVals(8) As Integer
'
' Liste mit allen möglichen Zahlen (1..9) anlegen
'
For i = 0 To 8
setVals(i) = i + 1
Next i
'
' Matirx für das aktuelle Feld 'fldNr' initialisieren
'
initRowsAndCols fldNr, rows, cols
'
' Schleife über die 3 Zeilen des Feldes
'
For ri = 0 To 2
'
' Schleife über die 3 Spalten des Feldes
'
For ci = 0 To 2
'
' aktuellen Wert an der Position (ri,ci) ermitteln
'
curVal = Cells(rows(ri), cols(ci)).Value
If curVal > 0 Then
'
' Wenn an der Position (ri,ci) eine Zahl > 0 steht,
' dann diese aus der Liste der möglichen Zahlen
' entfernen (auf 0 setzen)
'
setVals(curVal - 1) = 0
End If
Next ci
Next ri
'
' Zum Schluß die Liste der möglichen Zahlen durchlaufen
' und die erste Zahl > 0 als nächste zu platzierende
' Zahl zurückgeben
'
For i = 0 To 8
If setVals(i) > 0 Then
getNextVal = i + 1
Exit Function
End If
Next i
'
' Das Feld ist voll, dann -1 zurückgeben
'
getNextVal = -1
End Function
Der abgebildete VB(A)-Code wurde mit dem VBA2HTML-Konverter erzeugt.
Die zweite Regel im Sudoku besagt, dass jede Ziffer nur einmal in einer Zeile des kompletten Sudoku-Spielfeldes vorkommen darf.
Diese Regel wird wie folgt abgebildet:
Private Function checkRow(toPlace As Integer, row As Integer) As Boolean
'
' Prüft, ob die Zahl 'toPlace' in der Zeile 'row' der Sudoku-Matrix
' enthalten ist.
' Liefert false, wenn die Zahl bereits vorhanden ist.
'
Dim colIdx As Integer
Dim curVal As Integer
checkRow = True
For colIdx = 2 To 11
curVal = Cells(row, colIdx).Value
If curVal = toPlace Then
checkRow = False
Exit Function
End If
Next colIdx
End Function
Der abgebildete VB(A)-Code wurde mit dem VBA2HTML-Konverter erzeugt.
Die dritte Regel besagt, dass jede Ziffer nur einmal in einer Spalte des kompletten Sudoku-Spielfeldes vorkommen darf.
Diese Regel wird wie folgt abgebildet:
Private Function checkCol(toPlace As Integer, col As Integer) As Boolean
'
' Prüft, ob die Zahl 'toPlace' in der Spalte 'col' der Sudoku-Matrix
' enthalten ist.
' Liefert false, wenn die Zahl bereits vorhanden ist.
'
Dim rowIdx As Integer
Dim curVal As Integer
checkCol = True
For rowIdx = 2 To 11
curVal = Cells(rowIdx, col).Value
If curVal = toPlace Then
checkCol = False
Exit Function
End If
Next rowIdx
End Function
Der abgebildete VB(A)-Code wurde mit dem VBA2HTML-Konverter
Nachdem die Regeln und das Spielfeld abgebildet sind, fehlt lediglich eine Mechanismus, welcher das Spielfeld Block für Block
durchläuft und versucht die Ziffern in den Blöcken unterzubringen. Dieser Mechanismus muss, solange keine Lösung gefunden ist, in
der Lage sein Spielzüge zurückzunehmen, d.h. backtracking durchführen. Das sieht in diesem Fall so aus:
Private Sub place(fldNr As Integer, toPlace As Integer, stepCnt As Integer)
'
' Hier wird versucht, im Feld 'fldNr' die Zahl 'toPlace' unterzubringen.
'
Dim rows(3) As Integer
Dim cols(3) As Integer
Dim ri As Integer
Dim ci As Integer
Dim curVal As Integer
'
' Initialisierung der Feld-Matrix.
'
initRowsAndCols fldNr, rows, cols
'
' Schleife über alle Zeilen des Feldes
'
For ri = 0 To 2
'
' Schleife über alle Spalten des Feldes
'
For ci = 0 To 2
'
' Prüfen, ob im aktuell betrachtetem Feld
' bereits eine Zahl eingetragen ist
'
If Cells(rows(ri), cols(ci)).Value = 0 Then
'
' Prüfen, ob die Zahl 'toPlace' in der
' aktuellen betrachteten Zeile der kompletten
' Sudoku-Matrix bereits vorhanden ist.
'
If checkRow(toPlace, rows(ri)) Then
'
' Prüfen, ob die Zahl 'toPlace' in der
' aktuelle Spalte der kompletten
' Sudoku-Matrix bereits enthalten ist.
If checkCol(toPlace, cols(ci)) Then
'
' allen anderen Anwendungen auf diesem
' Rechner etwas Zeit geben
'
DoEvents
'
' die Zahl 'toPlace' in die Matrix eintragen
'
placeCell rows(ri), cols(ci), toPlace, stepCnt
'
If stepCnt = 81 Or fertig Then
'
' wenn 81 Felder belegt sind, dann sind
' wir fertig
'
fertig = True
Exit Sub
End If
'
' Wenn im aktuellen Feld noch eine Zahl
' eingetragen werden muss ...
'
If getNextVal(fldNr) > 0 Then
'
' ... in diese Feld bleiben (fldNr nicht inkrementieren)
' ... die nächste zu platzierenden Zahl ermitteln
' ... die Gesamtzahl der platzierten Zahlen erhöhen
'
place fldNr, getNextVal(fldNr), stepCnt + 1
Else
'
' Wenn das aktuelle Feld voll ist (getNextVal(fldNr) = -1),
' dann ...
' ... die erste zu platzierende Zahl im nächsten Feld ermitteln
' ... mit dem nächsten Feld weitermachen
' ... die Gesamtzahl der platzierten Zahlen erhöhen
'
toPlace = getNextVal(fldNr + 1)
place fldNr + 1, toPlace, stepCnt + 1
End If
'
' Wenn der Programmablauf bis hierher gekommen ist,
' dann wurde keine Lösung gefunden in welcher die Zahl 'toPlace'
' an genau dieser Position (rows(ri), cols(ci)) stehen kann.
' In diesem Fall ...
If Not fertig Then
'
' ... die Position wieder freigeben (Backtracking)
'
Cells(rows(ri), cols(ci)) = ""
End If
End If
End If
End If
Next ci
Next ri
NextVal:
End Sub
Private Sub placeCell(r As Integer, c As Integer, toPlace As Integer, stepCnt As Integer)
'
' Schreibt die Zahl 'toPlace' an die richtige Stelle in der Excel-Tabelle
'
If Cells(r, c).Value = 0 Then
Cells(r, c) = toPlace
Cells(1, 1).Value = stepCnt
End If
'
' wenn man mal zugucken will, hier das Sleep-Kommando
' wieder einkommentieren
'
' Sleep 500
End Sub
Der abgebildete VB(A)-Code wurde mit dem VBA2HTML-Konverter erzeugt.
Zu guter Letzt fehlt noch der Beginn der Suche. Hier muss die Anzahl der belegten Felder in der Startaufstellung ermittelt
werden (damit beim 81 Feld terminiert werden kann) und die Startaufstellung muss geprüft werden, damit überhaupt ein Ergebnis
gefunden werden kann.
'###############################################################
'# MS Excel Sudoku-Resolver
'# (C) 2007 Kurt aus Kienitz
'###############################################################
Option Explicit
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Dim fertig As Boolean
Sub ResolveSudoku()
'
' Von hier aus wird der Resolver gestartet
'
Dim stepCnt As Integer
Dim fldNr As Integer
Dim toPlace As Integer
'
' Bevor irgend etwas passiert, wird erstmal die Startaufstellung
' geprüft. Nur wenn dort kein Fehler enthalten ist kann
' das Sudoku-Rätsel korrekt gelöst werden.
'
If Not checkStartMatrix() Then
MsgBox "Fehler in der Startaufstellung", vbCritical, "Sudoku Resolver"
Exit Sub
End If
'
' Anzahl der zu Beginn ausgefüllten Felder ermitteln
'
stepCnt = countFilledFields + 1
If stepCnt = 0 Then
stepCnt = 1
End If
'
' Das Ausfüllen wird im Feld 1 begonnen
'
fldNr = 1
'
' Ermitteln welches die kleinste noch fehlende
' Zahl im ersten Feld ist
'
toPlace = getNextVal(fldNr)
While (toPlace <= 0)
'
' Nur für den Fall, dass ein Spaßvogel
' das erste Feld komplett ausgefüllt hat (toPlace = -1)
' hier das nächste Feld als Startfeld auswählen
'
fldNr = fldNr + 1
toPlace = getNextVal(fldNr)
Wend
'
' Kennzeichen für "Fertig" setzen
'
fertig = False
'
' und los geht es
'
place fldNr, toPlace, stepCnt
End Sub
Der abgebildete VB(A)-Code wurde mit dem VBA2HTML-Konverter erzeugt.
Damit ist eigentlich alles über das „wie geht dass“ gesagt.
Eine kleine Bedienungsanleitung
Nach dem Öffnen der Mircosoft Excel Arbeitsmappe solltest Du folgendes Bild vor Dir haben:
Das Sudoku-Spielfeld wirst Du sicherlich gleich wiedererkennen. Hier kannst Du eine Startaufstellung eintragen,
was ungefähr so aussehen könnte:
Über den Button „Rätsel lösen“ kannst Du nun den Sudoku-Resolver anwerfen, welcher dann in Windeseile das
Rätsel für Dich löst. Das sieht dann so aus:
Die Felder aus Deiner Startaufstellung sind gelb hinterlegt, damit sie besser zu erkennen sind. Sollte
bereits in der Startaufstellung ein Fehler im Rätsel enthalten sein, so wie hier ...
... werden die Fehler, nachdem Du den Sudoku-Resolver gestartet hast, durch einen roten Hintergrund gekennzeichnet:
Nun viel Spaß mit dem Sudoku-Resolver.
|
