Sudoku-Rätsel-Lösungs-Programm

Übersicht BlitzBasic Codearchiv

Neue Antwort erstellen

Lumne

Betreff: Sudoku-Rätsel-Lösungs-Programm

BeitragSo, Aug 07, 2005 21:15
Antworten mit Zitat
Benutzer-Profile anzeigen
Bei uns sind seit letzter Zeit immer Sudoku-Rätsel in der Tageszeitung. (Für alle, die noch nie etwas davon gehört haben: Das sind japanische Zahlenrätsel, siehe http://de.wikipedia.org/wiki/Sudoku)
Und dann hab ich mir gedacht, das müsste doch auch am Pc zu machen sein... gesagt, getan.. nach zwei Ausgaben des Rätsels war das Programm beinahe fertig. Etwas später war ein Artikel in der Zeitung, dass ein Universitätsprofessor es nach zehn Ausgaben geschafft hatte, ein solches Programm zu schreiben... und ich wär vor Lachen fast vom Stuhl gefallen. Das wird von der Zeitung dargestellt, als wäre das eine bombastische Entdeckung... hier: http://www.shz.de/index.php?RU...DID=904825

Naja, hier ist also mein Quellcode, für den Fall, das es jemanden interessiert... ich hoffe, irgendjemand steigt da durch.

BlitzBasic: [AUSKLAPPEN]
Const Debug = False
Const Update = False
Const Undo = 81
Global undocount
Global trialundocount

Type trial
Field x,y,number,i
Field column0[8],column1[8],column2[8],column3[8],column4[8],column5[8],column6[8],column7[8],column8[8]
End Type

Dim Tabelle(8,8,Undo)
Dim Werte(8,8,8)
Const Feldsize = 51

Global CursorX, CursorY, Result=-1, time

Graphics 640,480,32,1
SetBuffer BackBuffer()
ClsColor 255,255,255
;ClsColor 0,0,0

Global font1 = LoadFont(\"Courier New\",16)
Global font2 = LoadFont(\"Arial\",48,1)
Global font3 = LoadFont(\"Arial\",16,1)
Global font4 = LoadFont(\"Arial\",12,0)

Repeat


;Update

;Pfeiltasten
If KeyHit(205) Then CursorX = CursorX + 1 : CursorX = CursorX Mod 9
If KeyHit(203) Then CursorX = CursorX - 1 : If CursorX = -1 Then CursorX = 8
If KeyHit(200) Then CursorY = CursorY - 1 : If CursorY = -1 Then CursorY = 8
If KeyHit(208) Then CursorY = CursorY + 1 : CursorY = CursorY Mod 9

;Enter
If KeyHit(28) Then result = -1 : Auto()

;Backspace
If KeyHit(14) Then Undo() : result = -1

;Numpad
wert = -1
Select True
Case KeyHit(82) : wert = 0
Case KeyHit(79) : wert = 1
Case KeyHit(80) : wert = 2
Case KeyHit(81) : wert = 3
Case KeyHit(75) : wert = 4
Case KeyHit(76) : wert = 5
Case KeyHit(77) : wert = 6
Case KeyHit(71) : wert = 7
Case KeyHit(72) : wert = 8
Case KeyHit(73) : wert = 9
End Select

If wert <> -1 Then
If wert = 0 Then
SaveUndo()
Tabelle(CursorX,CursorY,0)=wert
Check()
result = -1
Else If Werte(CursorX,CursorY,wert-1) = False Then
SaveUndo()
Tabelle(CursorX,CursorY,0)=wert
Check()
result = -1
End If
End If

Draw()


Until KeyHit(1)



Function Check()

;Reset von \"Werte\"
For i1 = 0 To 8
For i2 = 0 To 8
For i3 = 0 To 8
werte(i1,i2,i3) = False
Next
Next
Next

;Fehler-Reset von \"Tabelle\"
For i1 = 0 To 8
For i2 = 0 To 8
If Tabelle(i1,i2,0) = -1 Then Tabelle(i1,i2,0) = 0
Next
Next

For x = 0 To 8
For y = 0 To 8
If Tabelle(x,y,0) > 0 Then
;Zeilen
For ix = 0 To 8
Werte(ix,y,Tabelle(x,y,0)-1) = True
Next
;Spalten
For iy = 0 To 8
Werte(x,iy,Tabelle(x,y,0)-1) = True
Next
;3x3-Block
kx = Ceil(x / 3)
ky = Ceil(y / 3)
For ix = 0 To 2
For iy = 0 To 2
Werte(kx*3+ix,ky*3+iy,Tabelle(x,y,0)-1)=True
Next
Next
End If
Next
Next

For x = 0 To 8
For y = 0 To 8
If Tabelle(x,y,0) = 0 Then
counter = 0
For i = 0 To 8
counter = counter + Werte(x,y,i)
Next
If counter = 9 Then Tabelle(x,y,0)= -1
End If
Next
Next

End Function

Function Auto()

SaveUndo()

Local starttime = MilliSecs()
Local updatetime = starttime

.start

If MilliSecs() > updatetime + 1000 Then
Draw()
updatetime = MilliSecs()
End If

Local Test[8]
Local count,stepback
Local loop = False

If update Draw()

If stepback = -1 Then result = 0 : Goto End

;Check, ob Rätsel gelöst
geloest = True
For x = 0 To 8
For y = 0 To 8
If Tabelle(x,y,0) < 1 Then geloest = False
Next
Next

If geloest = False Then

;Check, ob eine unplatzierte Zahl überhaupt noch gesetzt werden kann...

;... in einer Reihe
For y = 0 To 8
For i = 0 To 8 : test[i] = 0 : Next
For x = 0 To 8
If tabelle(x,y,0) > 0 Then
test[tabelle(x,y,0)-1] = True
End If
Next
For i = 0 To 8
If test[i] = False Then
For x = 0 To 8
If tabelle(x,y,0) = 0 Then
If werte(x,y,i) = False Then test[i] = True
End If
Next
If test[i] = False Then stepback = TrialUndo() : Goto start
End If
Next
Next

;... in einer Spalte
For x = 0 To 8
For i = 0 To 8 : test[i] = 0 : Next
For y = 0 To 8
If tabelle(x,y,0) > 0 Then
test[tabelle(x,y,0)-1] = True
End If
Next
For i = 0 To 8
If test[i] = False Then
For y = 0 To 8
If tabelle(x,y,0) = 0 Then
If werte(x,y,i) = False Then test[i] = True
End If
Next
If test[i] = False Then stepback = TrialUndo() : Goto start
End If
Next
Next

;...in einem 3x3-Block
For kx = 0 To 2
For ky = 0 To 2
For i = 0 To 8 : test[i] = 0 : Next
For ix = 0 To 2
For iy = 0 To 2
If Tabelle(kx*3+ix,ky*3+iy,0) > 0 Then test[Tabelle(kx*3+ix,ky*3+iy,0)-1] = True
Next
Next
For i = 0 To 8
If test[i] = False Then
For ix = 0 To 2
For iy = 0 To 2
If Tabelle(kx*3+ix,ky*3+iy,0) = 0 Then
If werte(kx*3+ix,ky*3+iy,i) = False Then test[i] = True
End If
Next
Next
If test[i] = False Then stepback = TrialUndo() : Goto start
End If
Next
Next
Next





;Check, ob nur eine mögliche Zahl
For x = 0 To 8
For y = 0 To 8
zahlen = 0
For i = 0 To 8
If Werte(x,y,i) = True Then zahlen = zahlen + 1
Next
If zahlen = 8 And Tabelle(x,y,0) = 0 Then
For i = 0 To 8
If Werte(x,y,i) = False Then Tabelle(x,y,0) = i+1 : Check() : loop = True
Next
End If
Next
Next

;Check, ob einzige mögliche Position der Zahl...

;...in einer Reihe
For y = 0 To 8
For i = 0 To 8 : test[i] = 0 : Next
For x = 0 To 8
If tabelle(x,y,0) = 0 Then
For i = 0 To 8
If werte(x,y,i) = False Then test[i]=test[i]+1
Next
End If
Next
For i = 0 To 8
If test[i]=1 Then
For x = 0 To 8
If tabelle(x,y,0) = 0 Then
If werte(x,y,i) = False Then tabelle(x,y,0) = i + 1 : Check() : loop = True
End If
Next
End If
Next
Next

;...in einer Spalte
For x = 0 To 8
For i = 0 To 8 : test[i] = 0 : Next
For y = 0 To 8
For i = 0 To 8
If werte(x,y,i) = False And tabelle(x,y,0) = 0 Then test[i]=test[i]+1
Next
Next
For i = 0 To 8
If test[i]=1 Then
For y = 0 To 8
If werte(x,y,i) = False And tabelle(x,y,0) = 0 Then tabelle(x,y,0) = i + 1 : Check() : loop = True
Next
End If
Next
Next

;...in einem 3x3-Block
For kx = 0 To 2
For ky = 0 To 2
For i = 0 To 8 : test[i] = 0 : Next
For ix = 0 To 2
For iy = 0 To 2
For i = 0 To 8
If Werte(kx*3+ix,ky*3+iy,i) = False And Tabelle(kx*3+ix,ky*3+iy,0) = 0 Then test[i] = test[i] + 1
Next
Next
Next
For i = 0 To 8
If test[i] = 1 Then
For ix = 0 To 2
For iy = 0 To 2
If Werte(kx*3+ix,ky*3+iy,i) = False And Tabelle(kx*3+ix,ky*3+iy,0) = 0 Then Tabelle(kx*3+ix,ky*3+iy,0) = i + 1 : Check() : loop = True
Next
Next
End If
Next
Next
Next

If stepback = 1 Then stepback = TrialUndo() : Goto start

;Check, ob Lösung gültig
possible = True
For x = 0 To 8
For y = 0 To 8
If Tabelle(x,y,0) = -1 Then possible = False
Next
Next

If debug Then
If update Draw()
WaitKey()
End If

;Versuch und Irrtum
If loop = False Then
If possible = True Then
For number = 2 To 9 ;Anzahl der ausgeschlossenen Zahlen
For x = 0 To 8
For y = 0 To 8
zahlen = 0
For i = 0 To 8
If Werte(x,y,i) = False Then zahlen = zahlen + 1
Next
If zahlen = number And Tabelle(x,y,0) = 0 Then
loop = True
SaveTrialUndo(x,y,number,1)
For i = 0 To 8
If Werte(x,y,i) = False Then
Tabelle(x,y,0) = i + 1
Check()
loop = True
If debug Then
draw()
WaitKey()
End If
Goto start
End If
Next
End If
Next
Next
Next
Else
If debug Then
Draw()
WaitKey()
End If
StepBack=TrialUndo()
loop=True
End If
End If

Else ;geloest = true
For t.trial = Each trial
Delete t
Next
result = 1
End If



If loop Then Goto start

.End

time = MilliSecs() - starttime
If result = 0 Then Undo()

FlushKeys()
If update Then WaitKey()

End Function

Function SaveUndo()
For i = Undo To 1 Step -1
For x = 0 To 8
For y = 0 To 8
Tabelle(x,y,i)=Tabelle(x,y,i-1)
Next
Next
Next
Undocount = Undocount + 1 : If undocount > 50 undocount = 50
End Function

Function Undo()
If Undocount > 0 Then
For i = 1 To Undo
For x = 0 To 8
For y = 0 To 8
Tabelle(x,y,i-1)=Tabelle(x,y,i)
Next
Next
Next
Undocount = Undocount - 1 : If undocount < 0 undocount = 0
check()
End If
End Function

Function SaveTrialUndo(x,y,number,i)
t.trial = New trial
t\x = x
t\y = y
t\number = number
t\i = i

For x = 0 To 8
For y = 0 To 8
Select x
Case 0 : t\column0[y] = Tabelle(x,y,0)
Case 1 : t\column1[y] = Tabelle(x,y,0)
Case 2 : t\column2[y] = Tabelle(x,y,0)
Case 3 : t\column3[y] = Tabelle(x,y,0)
Case 4 : t\column4[y] = Tabelle(x,y,0)
Case 5 : t\column5[y] = Tabelle(x,y,0)
Case 6 : t\column6[y] = Tabelle(x,y,0)
Case 7 : t\column7[y] = Tabelle(x,y,0)
Case 8 : t\column8[y] = Tabelle(x,y,0)
End Select
Next
Next

End Function

Function TrialUndo()

t.trial = Last trial

If t = Null Then Return -1 Goto End ;KeineLösung!

For x = 0 To 8
For y = 0 To 8
Select x
Case 0 : Tabelle(x,y,0) = t\column0[y]
Case 1 : Tabelle(x,y,0) = t\column1[y]
Case 2 : Tabelle(x,y,0) = t\column2[y]
Case 3 : Tabelle(x,y,0) = t\column3[y]
Case 4 : Tabelle(x,y,0) = t\column4[y]
Case 5 : Tabelle(x,y,0) = t\column5[y]
Case 6 : Tabelle(x,y,0) = t\column6[y]
Case 7 : Tabelle(x,y,0) = t\column7[y]
Case 8 : Tabelle(x,y,0) = t\column8[y]
End Select
Next
Next

check()

t\i = t\i + 1

If t\i > t\number Then Delete t : Return 1 : Goto End


For i = 0 To 8
If Werte(t\x,t\y,i) = False Then
count = count + 1
If count = t\i Then Tabelle(t\x,t\y,0) = i + 1 : Check() : Exit
End If
Next

.End

End Function

Function Draw()

Cls

;Cursor
Color 50,255,50
Rect 10+feldsize*CursorX,10+feldsize*CursorY,feldsize,feldsize,1

;Zahlen
For ix = 0 To 8
For iy = 0 To 8
zahl = -1
zahl2 = 0
For i = 0 To 8
If Tabelle(ix,iy,0) > 0 Then ;Große Zahl
Color 0,0,0
SetFont font2
Text 10+(ix)*feldsize+feldsize/2,12+(iy)*feldsize+feldsize/2, Tabelle(ix,iy,0),1,1
Else If Tabelle(ix,iy,0) = -1 Then ;Fehler
; Color 255,0,0
; Rect 10+feldsize*ix,10+feldsize*iy,feldsize,feldsize,1
Color 0,0,0
Line 10+feldsize*ix,10+feldsize*iy,10+feldsize*ix+feldsize,10+feldsize*iy+feldsize
Line 10+feldsize*ix,10+feldsize*iy+feldsize,10+feldsize*ix+feldsize,10+feldsize*iy
Else ;Kleine Zahlen
Color 0,0,0
SetFont font1
zahl = zahl + 1 : If zahl => 3 Then zahl = 0 : zahl2 = zahl2 + 1
If Werte(ix,iy,i) = False Then
Text 11+(ix)*feldsize+(feldsize/2)-(StringWidth(\"0\")*2.5)+zahl*StringWidth(\"0\")*2,11+(iy)*feldsize+(feldsize/2)-(StringHeight(\"0\")*1.5)+(zahl2*StringHeight(\"0\")), i+1
End If
End If
Next
Next
Next


;Feld
Color 0,0,0

For i = 0 To 9
If i Mod 3 = 0 Then
Rect 10,10+i*feldsize,feldsize*9+2,2
Else
Rect 10,10+i*feldsize,feldsize*9+2,1
End If
Next

For i = 0 To 9
If i Mod 3 = 0 Then
Rect 10+i*feldsize,10,2,feldsize*9+2
Else
Rect 10+i*feldsize,10,1,feldsize*9+2
End If
Next


;Erklärung
Color 0,0,0
SetFont font3
Text 10+feldsize*9+10,10,\"Sudoku\"
Color 100,100,100
Text 10+feldsize*9+10,30,\"by Lumne\"
Color 0,0,0
Text 10+feldsize*9+10,60,\"Steuerung\"
Color 100,100,100
Text 10+feldsize*9+10,80,\"Pfeiltasten\"
Text 10+feldsize*9+10,100,\"Numpad 1 - 9\"
Text 10+feldsize*9+10,120,\"Numpad 0\"
Text 10+feldsize*9+10,140,\"Backspace\"
Text 10+feldsize*9+10,160,\"Enter\"
Text 10+feldsize*9+10,180,\"Escape\"

Color 50,50,50
Text 10+feldsize*9+160-StringWidth(\"Cursor\"),80,\"Cursor\"
Text 10+feldsize*9+160-StringWidth(\"Eingabe\"),100,\"Eingabe\"
Text 10+feldsize*9+160-StringWidth(\"Löschen\"),120,\"Löschen\"
Text 10+feldsize*9+160-StringWidth(\"Undo\"),140,\"Undo\"
Text 10+feldsize*9+160-StringWidth(\"Automatik\"),160,\"Automatik\"
Text 10+feldsize*9+160-StringWidth(\"Beenden\"),180,\"Beenden\"

Select result
Case 0
Color 255,0,0
Text 10+feldsize*9+160-StringWidth(\"Rätsel unlösbar\"),210,\"Rätsel unlösbar\"
Text 10+feldsize*9+160-StringWidth(\"nach \" + time \" ms\"),230,\"nach \" + time + \" ms\"
Case 1
Color 0,0,0
Text 10+feldsize*9+160-StringWidth(\"Rätsel gelöst\"),210,\"Rätsel gelöst\"
Text 10+feldsize*9+160-StringWidth(\"in \" + time +\" ms\"),230,\"in \"+ time +\" ms\"
End Select

If update Then

SetFont font4
i=0

For t.trial = Each trial
Text 10+(feldsize*9)+10+Floor(i/23)*40,200+(i Mod 23) * 12,t\x + \",\" + t\y + \":\" + t\i + \"/\"+ t\number
i=i+1
Next

Text 10+feldsize*9+130,10,i

End If

Flip

End Function
  • Zuletzt bearbeitet von Lumne am So, Aug 07, 2005 22:55, insgesamt einmal bearbeitet

darth

Betreff: hehe - toll

BeitragSo, Aug 07, 2005 21:33
Antworten mit Zitat
Benutzer-Profile anzeigen
wow ^^ ich bögg zwar nix aber es sieht nach was aus...^*gg*
wenn du das schneller schaffst als dieser prof dingsda, dann solltest du zu ner uni gehn und "genialität" beantragen =)
ehrendoktor titel für lumne - sie hat das sudoku schneller begriffen als der prof
Diese Signatur ist leer.

Lumne

BeitragSo, Aug 07, 2005 22:05
Antworten mit Zitat
Benutzer-Profile anzeigen
Danke. Aber ich bin männlich. So ganz nebenbei.

So, ich werde mal versuchen, das ein wenig zu erklären.

Also erstmal gibt es das Feld Tabelle, in welchem die Zahlen eingetragen werden, dazu gehört das Feld Werte, das zu jedem Eintrag von Tabelle 9 Variablen enthält, in die genau das abgespeichert wird, was man als Mensch auf dem Papier tut: Checken, welche Zahlen in einem leeren Feld überhaupt noch gesetzt werden können. Das tut die Funktion Check(). Das kann man auch sehen, wenn man im Programm eine Zahl eingibt: Dann verschwindet diese Zahl aus allen Feldern dieser Reihe, Spalte und dieses Blocks. Dann gibt es noch die Undo-Funktion, die ist aber nur dazu da, ein wenig rumzuprobieren... das eigentlich Wichtige ist die Funktion Auto().
In dieser versucht der Computer, das Rätsel zu lösen.
Als erstes kommt eine Abfrage, ob das Rätsel gelöst wurde, dann kommen Abfragen, ob das Rätsel unlösbar ist. Da wird überprüft, ob eine Zahl, die in einer Reihe, einer Spalte oder einem Block noch fehlt, überhaupt noch gemäß der Regeln platziert werden kann. Wenn nicht, dann geht das Programm einen Schritt zurück, aber dazu später mehr.
Dann kommen die simplen Proben, die man als Mensch auch macht: Ob an einer Stelle nur eine Zahl möglich ist oder ob es für eine Zahl in einer Reihe, Spalte oder in einem Block nur eine mögliche Position gibt. Diese wird dann in "Tabelle" eingetragen.

Interessant wird es beim Kommentar "Versuch und Irrtum", es folgt das eigentliche Herzstück des Programms. Von allen leeren Feldern wird gezählt, wieviele mögliche Zahlen es in dem jeweiligen Feld gibt, und für das Feld mit den wenigsten Möglichkeiten gibt das Programm sozusagen einen Tipp ab. Mit dieser Zahl wird dann weitergerechnet. Sollte sich später herausstellen, das eine Lösung so nicht möglich ist, nimmt das Programm seine "Rateversuche" nach und nach zurück. Realisiert wird dies durch die Types "Trial", also Versuche. Gibt das Programm einen Tipp ab, ensteht ein neuer trial, in dem das Feld vor der Änderung gespeichert wird, die Koordinaten des getippten Feldes, die Anzahl der Möglichkeiten auf diesem Feld und die Nummer des Tipps. Ist auf einem Feld z.B. 1,3 & 7 noch möglich, wird das Programm als erstes mit der 1 weiterrechnen. Wenn es dann feststellt, dass es keine Lösung gibt, stellt es den alten Zustand wieder her und versucht es mit der 3 als Tipp usw...
Kann das Programm problemlos weiterrechnen, gibt es weitere Tipps ab, also entstehen neue trials... und immer das letzte wird weitergeführt bzw. gelöscht, wenn sich herausstellt, dass keine der möglichen Zahlen richtig sein kann. Dann macht das Programm mit dem trial davor weiter.
Setzt mal die Const update auf True, dann werden die trials ausgegeben. Die Angaben dabei sind: x,y,Tipp-Nummer / Anzahl möglicher Tipps

Auto wird solange wiederholt, bis ein Ergebnis feststeht.

Alfadur

BeitragMo, Aug 08, 2005 14:19
Antworten mit Zitat
Benutzer-Profile anzeigen
habe bei wiki gelesen das ein paar zahlen vorgegeben sein müssen, damit man auch als mensch seinen spaß damit hat. machs doch so das der computer so ein sudoku spiel auswürfelt und man dann raten darf.... also der computer platziert nur 30 von 81 möglichen zahlen, aber so das es auch lösbar ist....
A Cray is the only computer that runs an endless loop in less than four hours.

darth

Betreff: =S sry

BeitragMo, Aug 08, 2005 19:28
Antworten mit Zitat
Benutzer-Profile anzeigen
ähm sry... weiss gar nich mehr wie ich auf das sie gekommen bin... =S tut mir echt leid...
Diese Signatur ist leer.

Neue Antwort erstellen


Übersicht BlitzBasic Codearchiv

Gehe zu:

Powered by phpBB © 2001 - 2006, phpBB Group