Bitte dreht beim Ausprobieren den Debugger ab, da sonst die Laufzeit enorm wird. Auf meinem Athlon XP komme ich so auf ungefähr 2000 Checks pro Sekunde und reale Beispiele brauchen etwa im Bereich von einer halben Million Checks.
Das Userinterface ist etwas sehr spartanisch, aber der Fokus lag ja auf dem Algorithmus. Bei Bedarf kann man jederzeit mit dem [Exit]-Knopf abbrechen.
Code: Alles auswählen
; PureBasic 4.10 (Windows - x86)
; 2008 Feb by qui
;--- sudoku
EnableExplicit
;--- globale Variable
Global Zaehler.l ; wieviele versuche
Global Startzeit.l; Laufzeit
Global Loesung.s ; hier wird die ggf gefundene loesung notiert
Global EWindow.l, EGadget.l
Global NWindow.l, NStatusBar.l, NGadgetList.l, NButtonStart.l, NButtonExit.l
;--- schnelle funktion zum auslesen eines feldes (i,j) aus dem brett; liefert 0 fuer freies Feld und 1 bis 9
Procedure.l Feld(*Brett,i.l,j.l)
ProcedureReturn PeekB(*Brett+(i-1)*9+j-1)-48
EndProcedure
;--- schnelle funktion zum setzen eines feldes (i,j) auf wert k (muss 1 bis 9 sein) im brett
Procedure Setze(*Brett,i.l,j.l,k.l)
PokeB(*Brett+(i-1)*9+j-1,48+k)
EndProcedure
;--- pruefen ob in zeile oder spalte oder subfeld des brettes doppelte ziffern stehen
Procedure.l Doppelte(*Brett)
Protected i.l, j.l, i1.l, j1.l, fi.l, fj.l, k.l, f.l
For i=1 To 8 ; alle zeilen
For j=1 To 8 ; alle spalten
f=Feld(*Brett,i,j) ; das feld fuer schnellen zugriff in variable speichern
If f>0 ; feld definiert
For k=i+1 To 9 ; für rest der zeile
If f=Feld(*Brett,k,j) ; und bereits in zeile vorhanden
ProcedureReturn 1
EndIf
Next k
For k=j+1 To 9 ; für rest der spalte
If f=Feld(*Brett,i,k) ; und bereits in spalte vorhanden
ProcedureReturn 1
EndIf
Next k
EndIf
Next j
Next i
For fi=0 To 6 Step 3 ; alle felder zeilen
For fj=0 To 6 Step 3 ; alle felder spalten
For i=1 To 3 ; alle felder im feld zeilen
For j=1 To 3 ; alle felder im feld spaten
f=Feld(*Brett,fi+i,fj+j) ; fuer schnellen zugriff speichern
If f>0 ; feld definiert
For i1=1 To 3 ; alle anderen felder in diesem feld zeilen
For j1=1 To 3 ; alle anderen felder in diesem feld spalten
If (i1<>i) Or (j1<>j) ; nicht mit eigenem feld vergleichen
If f=Feld(*Brett,fi+i1,fj+j1)
ProcedureReturn 1 ; in subfeld doppelt
EndIf
EndIf
Next j1
Next i1
EndIf
Next j
Next i
Next fj
Next fi
ProcedureReturn 0
EndProcedure
;--- nachsehen, ob schon alle felder mit ziffern besetzt sind
Procedure Fertig(*Brett)
Protected i.l, j.l
For i=1 To 9 ; alle zeilen
For j=1 To 9 ; alle spalten
If Feld(*Brett,i,j)=0 ; ist feld 0
ProcedureReturn 0 ; noch nicht fertig
EndIf
Next j
Next i
ProcedureReturn 1 ; alles geprüft, war keines 0 -> also fertig
EndProcedure
;--- nimm das gegebene brett und suche eine loesung
Procedure.l Suche(Brett.s)
Protected i.l, j.l, k.l, z.l, s.s
If Doppelte(@Brett)
ProcedureReturn 0 ; es gibt bereits doppelte ziffern, nicht weitermachen
EndIf
If Fertig(@Brett)
Loesung=Brett
ProcedureReturn 1 ; es gibt eine loesung, notieren und schluss machen
EndIf
Zaehler=Zaehler+1 ; zaehle die kombinationen
If (Zaehler % 1000)=0 ; alle 1000 wird eine neue statuszeile aufgebaut
s=Str(Zaehler)+" Checks " ; mit anzahl der versuche
z=Date()-Startzeit;
s=s+Str(z)+" Secs " ; laufzeit
If z>0
s=s+Str(Zaehler/z)+" C/s" ; wenn schon >0 sekunden -> versuche/sekunde berechnen
EndIf
StatusBarText(NStatusbar,0,s) ; alle 1000 ausgeben, damit man sieht, ob das programm noch laeuft
If WindowEvent()=#PB_Event_Gadget ; event prüfen aber nicht abwarten -> damit das programm nicht "einfriert"
If EventGadget()=NButtonExit ; war der knopf für ende und aus
End ; das machen wir dann
EndIf
EndIf
EndIf
For i=1 To 9 ; alle zeilen
For j=1 To 9 ; alle spalten
If Feld(@Brett,i,j)=0 ; ist das feld noch zu besetzen
For k=1 To 9 ; probiere alle ziffern
Setze(@Brett,i,j,k) ; setze ein und
If Suche(Brett) ; versuche diese kombination
ProcedureReturn 1 ; es wurde 1 zuruekgemeldet = loesung gefunden -> einfach beenden
EndIf
Next k
EndIf
Next j
Next i
ProcedureReturn 0
EndProcedure
;--- das userinterface
Procedure Start()
Protected i.l,j.l,k.l
Protected Dim NString.l(9,9)
Protected Brett.s
Protected Dim p.l(9)
p(1)=10: p(2)=35: p(3)=60: p(4)=90: p(5)=115: p(6)=140: p(7)=170: p(8)=195: p(9)=220 ; Positionen der Eingabefelder
NWindow=OpenWindow(#PB_Any, 100,100, 250, 310, "Sudoku", #PB_Window_TitleBar | #PB_Window_WindowCentered ) ; das Eingabefenster
NStatusBar=CreateStatusBar(#PB_Any,WindowID(NWindow)) ; Status des Programmes
AddStatusBarField(250) ; zeit an, wieviele Versuche bereits gemacht wurden
NGadgetList=CreateGadgetList(WindowID(NWindow)) ; liste der gadgets
For i=1 To 9 ; alle zeilen
For j=1 To 9 ; alle spalten
NString(i,j)=StringGadget(#PB_Any, p(j), p(i), 20,20,"",#PB_String_BorderLess) ; erzeuge ein eingabefeld, merke die nummer in array
Next j
Next i
NButtonStart=ButtonGadget(#PB_Any, 10, 260, 50, 20, "Start") ; beginne mit versuchen
NButtonExit =ButtonGadget(#PB_Any, 190, 260, 50, 20, "Exit") ; abbruch und ausstieg
Repeat
EWindow=WaitWindowEvent() ; warte auf aktion des users
If EWindow=#PB_Event_Gadget ; ein gadget (eingabefeld oder button)
EGadget=EventGadget() ; welches?
Brett="" ; leere aufgabenspeicher
If EGadget=NButtonStart ; es war der knopf für start
For i=1 To 9 ; alle zeilen
For j=1 To 9 ; alle spalten
k=Val(GetGadgetText(NString(i,j))) ; mache aus eingabefeld eine zahl (wenn leer oder mist wird es null)
If (k<1) Or (k>9) ; zahl im gültigen bereich
SetGadgetText(NString(i,j),"") ; nein - feld löschen
Brett=Brett+"0" ; eine 0 in das aufgabefeld rein
Else
SetGadgetText(NString(i,j),Str(k)) ; richtige zahl wieder setzen
Brett=Brett+Str(k) ; und in das aufgabefeld reinschreiben
EndIf
Next j
Next i
Zaehler=0 ; wir beginnen mit zaehler mit 0
Startzeit=Date() ; Anfangszeit
StatusBarText(NStatusBar,0,"Start!") ; damit bis zur ersten anzeige (nach 1000 versuchen) was drinnen steht
Loesung="" ; loesung loeschen
If Suche(Brett) ; nach loesung suchen
MessageRequester("Sudoku","Lösung gefunden!",#PB_MessageRequester_Ok)
k=1 ; ausgabe der lösung, beginnt bei ertem zeichen
For i=1 To 9 ; alle zeilen
For j=1 To 9 ; alle spalten
SetGadgetText(NString(i,j),Mid(Loesung,k,1)) ; das (i-1)*9+j te zeichen auf feld(i,j) setzen
k=k+1 ; nächstes zeichen
Next j
Next i
Else
MessageRequester("Sudoku","Keine Lösung gefunden!",#PB_MessageRequester_Ok) ; nix gefunden
EndIf
EndIf
EndIf
Until (EWindow=#PB_Event_CloseWindow) Or (EGadget=NButtonExit) ; bis fenster zu oder exit
EndProcedure
Start() ; rufe start auf