Sudoku Contest
Übersicht
Sonstiges Projekte
|
FirstdeathmakerBetreff: Sudoku Contest |
 Di, Jul 15, 2008 19:32Antworten mit Zitat 
|
|---|---|---|
|
Hi Leute,
Die Idee wurde im Codearchiv geboren, und jetzt stell ich sie hier einfach mal vor: Aufgabe: Programmiere die Funktion "sudoku_solve(), welche Sudoku Rätsel löst, und zwar möglichst schnell. Sie soll das Array "sudoku(x,y)", welches das Sudoku-Feld repräsentiert mit den richtigen Zahlen auffüllen und bei einer korrekten Lösung "true" zurückliefert. Falls es keine Lösung gibt, soll sie "false" zurück liefern. Gegeben: Dieser Coderumpf ist gegeben. An den markierten Stellen kann man Änderungen vornehmen (einmal globale Variablen und einmal Funktionen). Das Programm ist soweit schon lauffähig, es fehlt nur die Lösungsfunktion. Mit der F1 Taste kann man sich die Hilfe anzeigen lassen. Beachte: Mit "S" kann man das aktuell eingegebene Sudoku abspeichern, mit "L" laden. Das Wikipedia Sudoku Rätsel ist ganz gut zum testen. Einsendeschluss ist der 31. Juli 2008 23:59 Uhr. Der Sieger erhält den Titel: "King of Sudoku Hacking 2008" (es sei denn jmd findet sich bereit noch was anderes als Preis zu stiften  )
Der Sieger wird von mir durch einen Schnelligkeitstest ermittelt. Dabei werde ich die Algorithmen mit einer bestimmten Anzahl zufällig erstellter Sudoku's füttern und im Schnitt ermitteln wie schnell die verschiedenen Algorithmen sind. (Also ich werde vorher eine bestimmte Menge erstellen, und dann alle Algorithmen die gleiche Menge abbarbeiten lassen). Den Sourcecode dazu werde ich hier noch posten. Hier der Programmrumpf in dem ihr eure Sudoku-Lösungen programmieren könnt: Code: [AUSKLAPPEN] Const VERSION$ = "0.1"
Global coderName$ = "BlitzBasicUser" AppTitle("SudokuSolver "+VERSION) ;Global Var's Dim sudoku(8,8);sudoku field, 0-8 x 0-8 (=3x3 fields) Global mx#,my#;mouse x and y position Global sudoku_selx%,sudoku_sely%;selected field x and y coordinates Global help%;if it shall show the help menue Global lastAttemp$;used to display last solve attemp time ;################################ ;DEINE GLOBALEN VARIABLEN ;################################ Main() ;################################ ;Ab hier deine Implementation: ;Löst ein sudoku-Rätsel ;gibt 'true' zurück, wenn eine Lösung gefunden wurde, ansonsten 'false' Function sudoku_solve() End Function ;Ende deiner Implementation ;################################### ;AB HIER BITTE NICHTS MEHR VERÄNDERN Function MAIN() ;INITIALISATION Graphics 310,310,16,2 SetBuffer BackBuffer() ClsColor 255,255,255 SetFont LoadFont("arial", 20,1) ;MAINLOOP Repeat mx = MouseX() my = MouseY() Cls sudoku_draw() sudoku_logic() Flip Until KeyHit(1) End End Function ;LOGIC LOOP Function Sudoku_logic() x = Floor((mx-20)/30.0) y = Floor((my-20)/30.0) If MouseHit(1) ;select field beneath mousepointer If x=>0 And x < 9 If y=>0 And y < 9 sudoku_selx = x sudoku_sely = y EndIf EndIf EndIf If KeyHit(200) And sudoku_sely>0 sudoku_sely = sudoku_sely - 1 ;decrease selected field y - coord If KeyHit(208) And sudoku_sely<9 sudoku_sely = sudoku_sely + 1 ;increase selected field y - coord If KeyHit(203) And sudoku_selx>0 sudoku_selx = sudoku_selx - 1 ;decrease selected field x - coord If KeyHit(205) And sudoku_selx<9 sudoku_selx = sudoku_selx + 1 ;increase selected field x - coord For i=2 To 10 ;write number (1-9) into selected field If KeyHit(i) sudoku(sudoku_selx,sudoku_sely) = i-1 Next If KeyHit(11) Or KeyHit(211) sudoku(sudoku_selx,sudoku_sely) = 0 ;0 or DEL - delete current selected field If KeyHit(57);SPACE solve sudoku Cls Sudoku_draw() Text 135,1,"work in progress..." Flip 0 If sudoku_valid() lastAttemp = MilliSecs() If Sudoku_solve() LastAttemp = "time: "+(MilliSecs() - Int(lastAttemp)) Else LastAttemp = "no solution found" EndIf EndIf EndIf If KeyHit(49) sudoku_clear() ;key "n" - empty sudoku paper If KeyHit(59) help=Not help If KeyHit(38) sudoku_load() If KeyHit(31) sudoku_save() End Function ;RENDER LOOP, shows sudoku and helpmenü Function Sudoku_draw() For x%=0 To 8 For y%=0 To 8 Local posx% = 20 + x * 30 Local posy% = 20 + y * 30 If sudoku_selx = x And sudoku_sely = y Color 255,200,100 Rect posx,posy,31,31,1 EndIf Color 0,0,0 Rect posx,posy,31,31,0 If sudoku(x,y) Text posx+15,posy+15,sudoku(x,y),1,1 Next Next Color 0,0,0 For i=0 To 1 Line 111 + 90*i,20,111+90*i,290 Line 20,111 + 90*i,290,111+90*i Next If Sudoku_solved() Text 20,1,"solved sudoku" ElseIf Sudoku_valid() Text 20,1,"valid sudoku" EndIf If LastAttemp<>"" Text 155,290,LastAttemp,1,0 EndIf If help Color 255,255,255 Rect 40,40,230,230 Color 0,0,0 Rect 39,39,232,232,0 Text 155,50,"Help",1,0 Text 50,80,"Arrow Keys - select field" Text 50,100,"'1'-'9' - write number" Text 50,120,"'0' or 'Del' - clear number" Text 50,140,"'space' - solve sudoku" Text 50,160,"'n' clear sudoku field" Text 50,180,"'F1' toggle helpmenue" Text 155,240,"programmed by "+coderName,1 EndIf End Function ;Functions helping to manage SUDOKU ;Checks, if sudoku is solved ;@ return - true, if sudoku is solved correctly Function Sudoku_solved() If Not Sudoku_valid() Return False For x=0 To 8 For y=0 To 8 If sudoku(x,y) = 0 Return False Next Next Return True End Function ;checks, if sudoku is a valid sudoku ;@return true, if sudoku is valid, false if sudoku is not valid Function Sudoku_valid() Local x[9] Local y[9] For bx=0 To 2 For by=0 To 2 For n=0 To 9 x[n]=0 Next For xi=0 To 2 For yi=0 To 2 Local lx = bx*3 + xi Local ly = by*3 + yi If sudoku(lx,ly) If x[sudoku(lx,ly)] Return False Else x[sudoku(lx,ly)]=True EndIf EndIf Next Next Next Next For i=0 To 8 For n=0 To 9 x[n]=0 y[n]=0 Next For i2=0 To 8 If sudoku(i,i2) If x[sudoku(i,i2)] Return False Else x[sudoku(i,i2)]=True EndIf EndIf If sudoku(i2,i) If y[sudoku(i2,i)] Return False Else y[sudoku(i2,i)]=True EndIf EndIf Next Next Return True End Function ;Clears sudoku field Function sudoku_clear() For x%=0 To 8 For y%=0 To 8 sudoku(x,y) = 0 Next Next End Function ;Loads a sudoku Function sudoku_load() file = ReadFile("save.sud") For x=0 To 8 For y=0 To 8 sudoku(x,y) = ReadInt(file) Next Next CloseFile file End Function ;saves current sudoku Function sudoku_save() file = WriteFile("save.sud") For x=0 To 8 For y=0 To 8 WriteInt file,sudoku(x,y) Next Next CloseFile file End Function Tipps: Lest euch den Wikipedia Artikel sorgfältig durch, vor allem den Teil über die verbesserte Backtracking Lösungsstrategie!!! Wikipedia Artikel Sudoku/Backtracking Und nun viel Erfolg! EDIT: unpinned. MfG BladeRunner |
||
- Zuletzt bearbeitet von Firstdeathmaker am Di, Jul 15, 2008 23:46, insgesamt einmal bearbeitet
|
Noobody |
Di, Jul 15, 2008 21:57 Antworten mit Zitat
|
|---|---|---|
|
So, hier ist mal meine erste Version eines Sudokulösers:
Code: [AUSKLAPPEN] Const VERSION$ = "0.5"
Global coderName$ = "Noobody" AppTitle("SudokuSolver "+VERSION) ;Global Var's Dim sudoku(8,8);sudoku field, 0-8 x 0-8 (=3x3 fields) Global mx#,my#;mouse x and y position Global sudoku_selx%,sudoku_sely%;selected field x and y coordinates Global help%;if it shall show the help menue Global lastAttemp$;used to display last solve attemp time ;################################ ;DEINE GLOBALEN VARIABLEN Dim ZeroX( 80 ) Dim ZeroY( 80 ) Global ZeroOffset, ZeroCount ;################################ Main() ;################################ ;Ab hier deine Implementation: ;Löst ein sudoku-Rätsel ;gibt 'true' zurück, wenn eine Lösung gefunden wurde, ansonsten 'false' Function Sudoku_Solve() ;Mit Gross- Kleinschreibung ists doch gleich viel schöner. For Row = 0 To 8 For Column = 0 To 8 If Sudoku( Column, Row ) = 0 Then ZeroX( ZeroOffset ) = Column ZeroY( ZeroOffset ) = Row ZeroOffset = ZeroOffset + 1 EndIf Next Next ZeroCount = ZeroOffset ZeroOffset = 0 Return Sgn( Backtrack( ZeroX( 0 ), ZeroY( 0 ) ) ) End Function Function BackTrack( X, Y ) For i = 1 To 9 For Row = 0 To 8 If Row <> Y Then If Sudoku( X, Row ) = i Then Permitted = False Exit Else Permitted = True EndIf EndIf Next If Permitted Then For Column = 0 To 8 If Column <> X Then If Sudoku( Column, Y ) = i Then Permitted = False Exit EndIf EndIf Next If Permitted Then XThird = Floor( X/3. ) YThird = Floor( Y/3. ) For Row = YThird*3 To YThird*3 + 2 For Column = XThird*3 To XThird*3 + 2 If Row <> Y And Column <> X Then If Sudoku( Column, Row ) = i Then Permitted = False Exit EndIf EndIf Next If Not Permitted Then Exit Next If Permitted Then Sudoku( X, Y ) = i If ZeroOffset = ZeroCount - 1 Then Return i ZeroOffset = ZeroOffset + 1 If Not BackTrack( ZeroX( ZeroOffset ), ZeroY( ZeroOffset ) ) Then ZeroOffset = ZeroOffset - 1 Sudoku( X, Y ) = 0 Else Return i EndIf EndIf EndIf EndIf Next Return False End Function ;Ende deiner Implementation ;################################### ;AB HIER BITTE NICHTS MEHR VERÄNDERN Function MAIN() ;INITIALISATION Graphics 310,310,16,2 SetBuffer BackBuffer() ClsColor 255,255,255 SetFont LoadFont("arial", 20,1) ;MAINLOOP Repeat mx = MouseX() my = MouseY() Cls sudoku_draw() sudoku_logic() Flip Until KeyHit(1) End End Function ;LOGIC LOOP Function Sudoku_logic() x = Floor((mx-20)/30.0) y = Floor((my-20)/30.0) If MouseHit(1) ;select field beneath mousepointer If x=>0 And x < 9 If y=>0 And y < 9 sudoku_selx = x sudoku_sely = y EndIf EndIf EndIf If KeyHit(200) And sudoku_sely>0 sudoku_sely = sudoku_sely - 1 ;decrease selected field y - coord If KeyHit(208) And sudoku_sely<9 sudoku_sely = sudoku_sely + 1 ;increase selected field y - coord If KeyHit(203) And sudoku_selx>0 sudoku_selx = sudoku_selx - 1 ;decrease selected field x - coord If KeyHit(205) And sudoku_selx<9 sudoku_selx = sudoku_selx + 1 ;increase selected field x - coord For i=2 To 10 ;write number (1-9) into selected field If KeyHit(i) sudoku(sudoku_selx,sudoku_sely) = i-1 Next If KeyHit(11) Or KeyHit(211) sudoku(sudoku_selx,sudoku_sely) = 0 ;0 or DEL - delete current selected field If KeyHit(57);SPACE solve sudoku Cls Sudoku_draw() Text 135,1,"work in progress..." Flip 0 If sudoku_valid() lastAttemp = MilliSecs() If Sudoku_solve() LastAttemp = "time: "+(MilliSecs() - Int(lastAttemp)) Else LastAttemp = "no solution found" EndIf EndIf EndIf If KeyHit(49) sudoku_clear() ;key "n" - empty sudoku paper If KeyHit(59) help=Not help If KeyHit(38) sudoku_load() If KeyHit(31) sudoku_save() End Function ;RENDER LOOP, shows sudoku and helpmenü Function Sudoku_draw() For x%=0 To 8 For y%=0 To 8 Local posx% = 20 + x * 30 Local posy% = 20 + y * 30 If sudoku_selx = x And sudoku_sely = y Color 255,200,100 Rect posx,posy,31,31,1 EndIf Color 0,0,0 Rect posx,posy,31,31,0 If sudoku(x,y) Text posx+15,posy+15,sudoku(x,y),1,1 Next Next Color 0,0,0 For i=0 To 1 Line 111 + 90*i,20,111+90*i,290 Line 20,111 + 90*i,290,111+90*i Next If Sudoku_solved() Text 20,1,"solved sudoku" ElseIf Sudoku_valid() Text 20,1,"valid sudoku" EndIf If LastAttemp<>"" Text 155,290,LastAttemp,1,0 EndIf If help Color 255,255,255 Rect 40,40,230,230 Color 0,0,0 Rect 39,39,232,232,0 Text 155,50,"Help",1,0 Text 50,80,"Arrow Keys - select field" Text 50,100,"'1'-'9' - write number" Text 50,120,"'0' or 'Del' - clear number" Text 50,140,"'space' - solve sudoku" Text 50,160,"'n' clear sudoku field" Text 50,180,"'F1' toggle helpmenue" Text 155,240,"programmed by "+coderName,1 EndIf End Function ;Functions helping to manage SUDOKU ;Checks, if sudoku is solved ;@ return - true, if sudoku is solved correctly Function Sudoku_solved() If Not Sudoku_valid() Return False For x=0 To 8 For y=0 To 8 If sudoku(x,y) = 0 Return False Next Next Return True End Function ;checks, if sudoku is a valid sudoku ;@return true, if sudoku is valid, false if sudoku is not valid Function Sudoku_valid() Local x[9] Local y[9] For bx=0 To 2 For by=0 To 2 For n=0 To 9 x[n]=0 Next For xi=0 To 2 For yi=0 To 2 Local lx = bx*3 + xi Local ly = by*3 + yi If sudoku(lx,ly) If x[sudoku(lx,ly)] Return False Else x[sudoku(lx,ly)]=True EndIf EndIf Next Next Next Next For i=0 To 8 For n=0 To 9 x[n]=0 y[n]=0 Next For i2=0 To 8 If sudoku(i,i2) If x[sudoku(i,i2)] Return False Else x[sudoku(i,i2)]=True EndIf EndIf If sudoku(i2,i) If y[sudoku(i2,i)] Return False Else y[sudoku(i2,i)]=True EndIf EndIf Next Next Return True End Function ;Clears sudoku field Function sudoku_clear() For x%=0 To 8 For y%=0 To 8 sudoku(x,y) = 0 Next Next End Function ;Loads a sudoku Function sudoku_load() file = ReadFile("save.sud") For x=0 To 8 For y=0 To 8 sudoku(x,y) = ReadInt(file) Next Next CloseFile file End Function ;saves current sudoku Function sudoku_save() file = WriteFile("save.sud") For x=0 To 8 For y=0 To 8 WriteInt file,sudoku(x,y) Next Next CloseFile file End Function Er verwendet auch das Backtrackingverfahren, ist aber noch relativ langsam. Für ein mittleres Sudoku aus der Zeitung hatte er 10 Ms, für das Sudoku von Wikipedia glatte 72 Sekunden 
Ich werde schauen, ob ich das Ding noch schneller machen kann oder eine schnellere Methode finde, das ist also nocht nicht mein finaler Beitrag. Als Preis könnte man neben dem geilen Titel (*haben will*) noch die Organisation für den nächsten Wettbewerb vergeben (so à la BCC). Damit das hier nicht fast das gleiche wie der BCC wird, könnte man den Fokus auf Geschwindigkeit und nicht auf Codegrösse legen (oder einfach keine Spiele programmieren, sondern nur Algorithmen). |
||
| Man is the best computer we can put aboard a spacecraft ... and the only one that can be mass produced with unskilled labor. -- Wernher von Braun | ||
AvaGast |
Di, Jul 15, 2008 22:34 Antworten mit Zitat |
|
|---|---|---|
|
Jau, find ich gut! - wenn dann beim nächsten Mal nen Pathfinding-Algo gesucht wird, bin ich dabei! *g* ... nur von Sodoku habe ich leider kein Schimmer (und zudem atm leider keine Zeit zum rumprobieren)
|
||
|
|
Firstdeathmaker |
Di, Jul 15, 2008 22:47 Antworten mit Zitat
|
|---|---|---|
|
@ Noobody: Werde deinen code gleich mal testen.
Edit: Hab ihn getestet. vllt. sollte ich noch hinzufügen, dass ich das ganze natürlich nicht im Debugmodus testen werde, sondern ohne. Meine Testfunktion steht jetzt, aber da ich für das Erstellen von 500 Testsudokus (Alles ziemlich schwere) auch eine ziemlich optimierte Solve Funktion benutze, werde ich es erst nach Contestschluss hier posten können. Aber hier schonmal das Rätselpaket was ich zum testen benutzen werde: https://www.blitzforum.de/upload/file.php?id=3160 Das mit "der Gewinner kann den nächsten Contest veranstalten" betrachte ich mit gemischten Gefühlen. Einerseits ist das natürlich toll, andererseit sollten es aber immer spannende Aufgaben sein. D.h. ich würde vorschlagen, der nächste "darf" den nächsten Contest veranstalten bzw. darf entscheiden welche Idee als nächstes kommt (Ideen können dann im Anschluss an die Abstimmung gepostet werden). Zudem würde ich den Contest gerne nur auf einzelne Funktionen und Geschwindigkeit, bzw. Qualität beschränken, Also immer mit vorgefertigtem Programmtemplate. Ich denke damit ist er dann eine sinnvolle Ergänzung zum BBC. |
||
- Zuletzt bearbeitet von Firstdeathmaker am Di, Jul 15, 2008 23:40, insgesamt einmal bearbeitet
|
SpionAtom |
Di, Jul 15, 2008 23:11 Antworten mit Zitat
|
|---|---|---|
| Ich will ja kein Miesmacher sein. Aber bei dieser Art Wettbewerb gewinnt doch eigentlich der, der am besten googlen kann. Solche Algorithmen oder die dazugehörigen Wettbewerbe gibts ja nicht erst seit gestern. Und die Ergebnisse sind auch meist einzusehen... | ||
| os: Windows 10 Home cpu: Intel Core i7 6700K 4.00Ghz gpu: NVIDIA GeForce GTX 1080 | ||
|
Casiopaya |
Di, Jul 15, 2008 23:19 Antworten mit Zitat
|
|---|---|---|
|
SpionAtom hat Folgendes geschrieben: Ich will ja kein Miesmacher sein. Aber bei dieser Art Wettbewerb gewinnt doch eigentlich der, der am besten googlen kann. Solche Algorithmen oder die dazugehörigen Wettbewerbe gibts ja nicht erst seit gestern. Und die Ergebnisse sind auch meist einzusehen...
Das glaube ich nicht. Sicher, es gibt 2 Stufen bei der Optimierung eines Lösungsverfahrens. Die 1. (und wichtigere) ist der theorethische Lösungsansatz der dahintersteckt. Die 2. ist allerdings die Optimierung des speziellen Programmcodes in einer speziellen Sprache. Ich denke, das Soduko-Problem ist derart überschaubar, dass man hier durchaus mit eigenem Hirnschmalz an optimale Lösungen rankommt. Klar könnte sich jemand Tagelang durch Papers durchquälen, aber ich vermute mal nicht, dass das hier jemand macht (ich selbst meine übrigens, dass das bei einem Problem wie Sudoku ohnehin sinnlos wäre). Die Teilnehmer des Wettbewerbs machen es ja nicht für den Preis  , sondern wegen der geistigen und technischen Herausforderung.
@Firstdeathmaker: Freut mich wirklich, dass du die Idee aufgenommen hast, werd was ordentliches abliefern. |
||
|
|
SpionAtom |
Di, Jul 15, 2008 23:26 Antworten mit Zitat
|
|---|---|---|
|
@ Casiopaya Siehste, ist viel platzsparender, als den kompletten Vorpost zu quoten
Du hast Recht, ich sollte viel mehr an das Gute im Menschen glauben, gerade bei dieser Community 
Wenn ich meinen BCC-Beitrag fertigbekomme, steuere ich hier vll auch noch was bei. |
||
| os: Windows 10 Home cpu: Intel Core i7 6700K 4.00Ghz gpu: NVIDIA GeForce GTX 1080 | ||
|
|
Firstdeathmaker |
Di, Jul 15, 2008 23:44 Antworten mit Zitat
|
|---|---|---|
|
Kleiner Tipp an alle: Lest euch den Wikipedia Artikel sorgfältig durch, vor allem den über die verbesserte Backtracking Lösungsstrategie!!!
Wikipedia Artikel Sudoku/Backtracking Man kann locker auf unter 1 Sekunde kommen... |
||
|
www.illusion-games.de
Space War 3 | Space Race | Galaxy on Fire | Razoon Gewinner des BCC #57 User posted image |
||
|
|
Noobody |
Mi, Jul 16, 2008 0:41 Antworten mit Zitat
|
|---|---|---|
So, ich hab das ganze vorhin mal ohne Debugger ausprobiert und gemerkt, dass es so markant schneller ist 
Ein einfaches Sudoku löst er tatsächlich mit 0 Ms, das von Wikipedia in knapp 5 Sekunden. Ich habe versucht, den Tipp von Wikipedia umzusetzen, und beim Sudoku von Wikipedia ist er 200 Ms schneller - bei einfachen aber um ein bis zwei Millisekunden langsamer. Code: [AUSKLAPPEN] Const VERSION$ = "0.5"
Global coderName$ = "Noobody" AppTitle("SudokuSolver "+VERSION) ;Global Var's Dim sudoku(8,8);sudoku field, 0-8 x 0-8 (=3x3 fields) Global mx#,my#;mouse x and y position Global sudoku_selx%,sudoku_sely%;selected field x and y coordinates Global help%;if it shall show the help menue Global lastAttemp$;used to display last solve attemp time ;################################ ;DEINE GLOBALEN VARIABLEN Type TZero Field X Field Y Field Possibilities Field Done[ 9 ] End Type Dim ZeroX( 80 ) Dim ZeroY( 80 ) Global ZeroOffset, ZeroCount ;################################ Main() ;################################ ;Ab hier deine Implementation: ;Löst ein sudoku-Rätsel ;gibt 'true' zurück, wenn eine Lösung gefunden wurde, ansonsten 'false' Function Sudoku_Solve() ;Mit Gross- Kleinschreibung ists doch gleich viel schöner. ZeroOffset = 0 Delete Each TZero For Row = 0 To 8 For Column = 0 To 8 If Sudoku( Column, Row ) = 0 Then Zero.TZero = New TZero Zero\X = Column Zero\Y = Row Zero\Possibilities = 9 XThird = Floor( Column/3. ) YThird = Floor( Row/3. ) For Y = YThird*3 To YThird*3 + 2 For X = XThird*3 To XThird*3 + 2 Zero\Done[ Sudoku( X, Y ) ] = 0 Next Next For i = 0 To 8 Zero\Done[ Sudoku( Column, i ) ] = 0 Zero\Done[ Sudoku( i, Row ) ] = 0 Next For i = 1 To 9 Zero\Possibilities = Zero\Possibilities - ( Not Zero\Done[ i ] ) Next EndIf Next Next Local Border.TZero[ 9 ] For Zero.TZero = Each TZero If Border[ Zero\Possibilities ] = Null Then Border[ Zero\Possibilities ] = Zero If Zero\Possibilities > 0 Then Insert Zero Before Border[ Zero\Possibilities - 1 ] Else Insert Zero Before First TZero EndIf Else Insert Zero Before Border[ Zero\Possibilities ] EndIf Next For Zero.TZero = Each TZero ZeroX( ZeroOffset ) = Zero\X ZeroY( ZeroOffset ) = Zero\Y ZeroOffset = ZeroOffset + 1 Next ZeroCount = ZeroOffset ZeroOffset = 0 Return Sgn( Backtrack( ZeroX( 0 ), ZeroY( 0 ) ) ) End Function Function BackTrack( X, Y ) For i = 1 To 9 For Row = 0 To 8 If Row <> Y Then If Sudoku( X, Row ) = i Then Permitted = False Exit Else Permitted = True EndIf EndIf Next If Permitted Then For Column = 0 To 8 If Column <> X Then If Sudoku( Column, Y ) = i Then Permitted = False Exit EndIf EndIf Next If Permitted Then XThird = Floor( X/3. ) YThird = Floor( Y/3. ) For Row = YThird*3 To YThird*3 + 2 For Column = XThird*3 To XThird*3 + 2 If Row <> Y And Column <> X Then If Sudoku( Column, Row ) = i Then Permitted = False Exit EndIf EndIf Next If Not Permitted Then Exit Next If Permitted Then Sudoku( X, Y ) = i If ZeroOffset = ZeroCount - 1 Then Return i ZeroOffset = ZeroOffset + 1 If Not BackTrack( ZeroX( ZeroOffset ), ZeroY( ZeroOffset ) ) Then ZeroOffset = ZeroOffset - 1 Sudoku( X, Y ) = 0 Else Return i EndIf EndIf EndIf EndIf Next Return False End Function ;Ende deiner Implementation ;################################### ;AB HIER BITTE NICHTS MEHR VERÄNDERN Function MAIN() ;INITIALISATION Graphics 310,310,16,2 SetBuffer BackBuffer() ClsColor 255,255,255 SetFont LoadFont("arial", 20,1) ;MAINLOOP Repeat mx = MouseX() my = MouseY() Cls sudoku_draw() sudoku_logic() Flip Until KeyHit(1) End End Function ;LOGIC LOOP Function Sudoku_logic() x = Floor((mx-20)/30.0) y = Floor((my-20)/30.0) If MouseHit(1) ;select field beneath mousepointer If x=>0 And x < 9 If y=>0 And y < 9 sudoku_selx = x sudoku_sely = y EndIf EndIf EndIf If KeyHit(200) And sudoku_sely>0 sudoku_sely = sudoku_sely - 1 ;decrease selected field y - coord If KeyHit(208) And sudoku_sely<9 sudoku_sely = sudoku_sely + 1 ;increase selected field y - coord If KeyHit(203) And sudoku_selx>0 sudoku_selx = sudoku_selx - 1 ;decrease selected field x - coord If KeyHit(205) And sudoku_selx<9 sudoku_selx = sudoku_selx + 1 ;increase selected field x - coord For i=2 To 10 ;write number (1-9) into selected field If KeyHit(i) sudoku(sudoku_selx,sudoku_sely) = i-1 Next If KeyHit(11) Or KeyHit(211) sudoku(sudoku_selx,sudoku_sely) = 0 ;0 or DEL - delete current selected field If KeyHit(57);SPACE solve sudoku Cls Sudoku_draw() Text 135,1,"work in progress..." Flip 0 If sudoku_valid() lastAttemp = MilliSecs() If Sudoku_solve() LastAttemp = "time: "+(MilliSecs() - Int(lastAttemp)) Else LastAttemp = "no solution found" EndIf EndIf EndIf If KeyHit(49) sudoku_clear() ;key "n" - empty sudoku paper If KeyHit(59) help=Not help If KeyHit(38) sudoku_load() If KeyHit(31) sudoku_save() End Function ;RENDER LOOP, shows sudoku and helpmenü Function Sudoku_draw() For x%=0 To 8 For y%=0 To 8 Local posx% = 20 + x * 30 Local posy% = 20 + y * 30 If sudoku_selx = x And sudoku_sely = y Color 255,200,100 Rect posx,posy,31,31,1 EndIf Color 0,0,0 Rect posx,posy,31,31,0 If sudoku(x,y) Text posx+15,posy+15,sudoku(x,y),1,1 Next Next Color 0,0,0 For i=0 To 1 Line 111 + 90*i,20,111+90*i,290 Line 20,111 + 90*i,290,111+90*i Next If Sudoku_solved() Text 20,1,"solved sudoku" ElseIf Sudoku_valid() Text 20,1,"valid sudoku" EndIf If LastAttemp<>"" Text 155,290,LastAttemp,1,0 EndIf If help Color 255,255,255 Rect 40,40,230,230 Color 0,0,0 Rect 39,39,232,232,0 Text 155,50,"Help",1,0 Text 50,80,"Arrow Keys - select field" Text 50,100,"'1'-'9' - write number" Text 50,120,"'0' or 'Del' - clear number" Text 50,140,"'space' - solve sudoku" Text 50,160,"'n' clear sudoku field" Text 50,180,"'F1' toggle helpmenue" Text 155,240,"programmed by "+coderName,1 EndIf End Function ;Functions helping to manage SUDOKU ;Checks, if sudoku is solved ;@ return - true, if sudoku is solved correctly Function Sudoku_solved() If Not Sudoku_valid() Return False For x=0 To 8 For y=0 To 8 If sudoku(x,y) = 0 Return False Next Next Return True End Function ;checks, if sudoku is a valid sudoku ;@return true, if sudoku is valid, false if sudoku is not valid Function Sudoku_valid() Local x[9] Local y[9] For bx=0 To 2 For by=0 To 2 For n=0 To 9 x[n]=0 Next For xi=0 To 2 For yi=0 To 2 Local lx = bx*3 + xi Local ly = by*3 + yi If sudoku(lx,ly) If x[sudoku(lx,ly)] Return False Else x[sudoku(lx,ly)]=True EndIf EndIf Next Next Next Next For i=0 To 8 For n=0 To 9 x[n]=0 y[n]=0 Next For i2=0 To 8 If sudoku(i,i2) If x[sudoku(i,i2)] Return False Else x[sudoku(i,i2)]=True EndIf EndIf If sudoku(i2,i) If y[sudoku(i2,i)] Return False Else y[sudoku(i2,i)]=True EndIf EndIf Next Next Return True End Function ;Clears sudoku field Function sudoku_clear() For x%=0 To 8 For y%=0 To 8 sudoku(x,y) = 0 Next Next End Function ;Loads a sudoku Function sudoku_load() file = ReadFile("save.sud") For x=0 To 8 For y=0 To 8 sudoku(x,y) = ReadInt(file) Next Next CloseFile file End Function ;saves current sudoku Function sudoku_save() file = WriteFile("save.sud") For x=0 To 8 For y=0 To 8 WriteInt file,sudoku(x,y) Next Next CloseFile file End Function |
||
| Man is the best computer we can put aboard a spacecraft ... and the only one that can be mass produced with unskilled labor. -- Wernher von Braun | ||
|
|
Firstdeathmaker |
Do, Jul 17, 2008 10:49 Antworten mit Zitat
|
|---|---|---|
| An der Struktur könntest du noch einiges verbessern, sodass du vielleicht auch unter 1 Sekunde kommst (für das Wikipedia Sudoku). | ||
|
www.illusion-games.de
Space War 3 | Space Race | Galaxy on Fire | Razoon Gewinner des BCC #57 User posted image |
||
|
Smily |
Do, Jul 17, 2008 10:59 Antworten mit Zitat
|
|---|---|---|
|
Sehr interessant, wie aus einer Fixen Spielerei von mir ein Contest werden kann.
Kann ich meinen Code, aus dem das ganze hier entstanden ist, gleich zur Teilnahme einsenden?
|
||
|
Lesestoff:
gegen Softwarepatente | Netzzensur | brain.exe | Unabhängigkeitserklärung des Internets "Wir müssen die Rechte der Andersdenkenden selbst dann beachten, wenn sie Idioten oder schädlich sind. Wir müssen aufpassen. Wachsamkeit ist der Preis der Freiheit --- Keine Zensur!" stummi.org |
||
|
|
Firstdeathmaker |
Do, Jul 17, 2008 11:46 Antworten mit Zitat
|
|---|---|---|
|
Hmm, du solltest ihn schon soweit anpassen, dass er ins Template hinein passt. Aber dann kannst du natürlich mitmachen
Ins Template hineinpassen heisst eigentlich nur, dass er eben sudoku(8,8) als Array benutzt, und als ein einzelner Funktionsaufruf implementiert wurde (mit beliebig vielen Hilfsfunktionen). Das brauche ich als Vorraussetzung, damit ich das ganze dann auf Schnelligkeit überprüfen kann mit einem Programm das ich jetzt schon verfasst, hier aber erst am Ende posten werde. |
||
|
www.illusion-games.de
Space War 3 | Space Race | Galaxy on Fire | Razoon Gewinner des BCC #57 User posted image |
||
|
|
Smily |
Do, Jul 17, 2008 11:52 Antworten mit Zitat
|
|---|---|---|
| Ich halte es aber für Sinnvoller, das Sudoku-Feld in einem Array[3][3][3][3] zu halten.. anstatt in einem [9][9] | ||
|
Lesestoff:
gegen Softwarepatente | Netzzensur | brain.exe | Unabhängigkeitserklärung des Internets "Wir müssen die Rechte der Andersdenkenden selbst dann beachten, wenn sie Idioten oder schädlich sind. Wir müssen aufpassen. Wachsamkeit ist der Preis der Freiheit --- Keine Zensur!" stummi.org |
||
|
|
Noobody |
Do, Jul 17, 2008 12:34 Antworten mit Zitat
|
|---|---|---|
|
Ich war wohl etwas müde, als ich meinen Code schrieb...
Als ich ihn heute durchsah, war ich geschockt, dass da so viele Fehler drinsteckten
Ich hab ihn ausgebessert und das Sudoku von Wikipedia löst er jetzt in 59 Ms. Mir fiel noch eine Idee ein, wie ich das ganze beschleunigen könnte, und mit dieser Methode löst er das Sudoku von Wikipedia in 39 Ms. Code: [AUSKLAPPEN] Const VERSION$ = "0.5"
Global coderName$ = "Noobody" AppTitle("SudokuSolver "+VERSION) ;Global Var's Dim sudoku(8,8);sudoku field, 0-8 x 0-8 (=3x3 fields) Global mx#,my#;mouse x and y position Global sudoku_selx%,sudoku_sely%;selected field x and y coordinates Global help%;if it shall show the help menue Global lastAttemp$;used to display last solve attemp time ;################################ ;DEINE GLOBALEN VARIABLEN Type TZero Field X Field Y Field Possibilities Field Done[ 9 ] End Type Dim ZeroX( 80 ) Dim ZeroY( 80 ) Dim ZeroPermitted( 80, 9 ) Global ZeroOffset, ZeroCount ;################################ Main() ;################################ ;Ab hier deine Implementation: ;Löst ein sudoku-Rätsel ;gibt 'true' zurück, wenn eine Lösung gefunden wurde, ansonsten 'false' Function Sudoku_Solve() ;Mit Gross- Kleinschreibung ists doch gleich viel schöner. ZeroOffset = 0 Delete Each TZero For Row = 0 To 8 For Column = 0 To 8 If Sudoku( Column, Row ) = 0 Then Zero.TZero = New TZero Zero\X = Column Zero\Y = Row Zero\Possibilities = 9 For i = 0 To 9 Zero\Done[ i ] = True Next XThird = Floor( Column/3. ) YThird = Floor( Row/3. ) For Y = YThird*3 To YThird*3 + 2 For X = XThird*3 To XThird*3 + 2 Zero\Done[ Sudoku( X, Y ) ] = 0 Next Next For i = 0 To 8 Zero\Done[ Sudoku( Column, i ) ] = 0 Zero\Done[ Sudoku( i, Row ) ] = 0 Next For i = 1 To 9 Zero\Possibilities = Zero\Possibilities - ( Not Zero\Done[ i ] ) Next EndIf Next Next Local Border.TZero[ 9 ] For Zero.TZero = Each TZero If Border[ Zero\Possibilities ] = Null Then Border[ Zero\Possibilities ] = Zero Next For i = 9 To 0 Step -1 If Border[ i ] <> Null Then Insert Border[ i ] Before First TZero Next For Zero.TZero = Each TZero Insert Zero Before Border[ Zero\Possibilities ] Next For Zero.TZero = Each TZero ZeroX( ZeroOffset ) = Zero\X ZeroY( ZeroOffset ) = Zero\Y For i = 1 To 9 ZeroPermitted( ZeroOffset, i ) = Zero\Done[ i ] Next ZeroOffset = ZeroOffset + 1 Next ZeroCount = ZeroOffset ZeroOffset = 0 Return Sgn( Backtrack( ZeroX( 0 ), ZeroY( 0 ) ) ) End Function Function BackTrack( X, Y ) For i = 1 To 9 If ZeroPermitted( ZeroOffset, i ) Then For Row = 0 To 8 If Row <> Y Then If Sudoku( X, Row ) = i Then Permitted = False Exit Else Permitted = True EndIf EndIf Next If Permitted Then For Column = 0 To 8 If Column <> X Then If Sudoku( Column, Y ) = i Then Permitted = False Exit EndIf EndIf Next If Permitted Then XThird = Floor( X/3. ) YThird = Floor( Y/3. ) For Row = YThird*3 To YThird*3 + 2 For Column = XThird*3 To XThird*3 + 2 If Row <> Y And Column <> X Then If Sudoku( Column, Row ) = i Then Permitted = False Exit EndIf EndIf Next If Not Permitted Then Exit Next If Permitted Then Sudoku( X, Y ) = i If ZeroOffset = ZeroCount - 1 Then Return i ZeroOffset = ZeroOffset + 1 If Not BackTrack( ZeroX( ZeroOffset ), ZeroY( ZeroOffset ) ) Then ZeroOffset = ZeroOffset - 1 Sudoku( X, Y ) = 0 Else Return i EndIf EndIf EndIf EndIf EndIf Next Return False End Function ;Ende deiner Implementation ;################################### ;AB HIER BITTE NICHTS MEHR VERÄNDERN Function MAIN() ;INITIALISATION Graphics 310,310,16,2 SetBuffer BackBuffer() ClsColor 255,255,255 SetFont LoadFont("arial", 20,1) ;MAINLOOP Repeat mx = MouseX() my = MouseY() Cls sudoku_draw() sudoku_logic() Flip Until KeyHit(1) End End Function ;LOGIC LOOP Function Sudoku_logic() x = Floor((mx-20)/30.0) y = Floor((my-20)/30.0) If MouseHit(1) ;select field beneath mousepointer If x=>0 And x < 9 If y=>0 And y < 9 sudoku_selx = x sudoku_sely = y EndIf EndIf EndIf If KeyHit(200) And sudoku_sely>0 sudoku_sely = sudoku_sely - 1 ;decrease selected field y - coord If KeyHit(208) And sudoku_sely<9 sudoku_sely = sudoku_sely + 1 ;increase selected field y - coord If KeyHit(203) And sudoku_selx>0 sudoku_selx = sudoku_selx - 1 ;decrease selected field x - coord If KeyHit(205) And sudoku_selx<9 sudoku_selx = sudoku_selx + 1 ;increase selected field x - coord For i=2 To 10 ;write number (1-9) into selected field If KeyHit(i) sudoku(sudoku_selx,sudoku_sely) = i-1 Next If KeyHit(11) Or KeyHit(211) sudoku(sudoku_selx,sudoku_sely) = 0 ;0 or DEL - delete current selected field If KeyHit(57);SPACE solve sudoku Cls Sudoku_draw() Text 135,1,"work in progress..." Flip 0 If sudoku_valid() lastAttemp = MilliSecs() If Sudoku_solve() LastAttemp = "time: "+(MilliSecs() - Int(lastAttemp)) Else LastAttemp = "no solution found" EndIf EndIf EndIf If KeyHit(49) sudoku_clear() ;key "n" - empty sudoku paper If KeyHit(59) help=Not help If KeyHit(38) sudoku_load() If KeyHit(31) sudoku_save() End Function ;RENDER LOOP, shows sudoku and helpmenü Function Sudoku_draw() For x%=0 To 8 For y%=0 To 8 Local posx% = 20 + x * 30 Local posy% = 20 + y * 30 If sudoku_selx = x And sudoku_sely = y Color 255,200,100 Rect posx,posy,31,31,1 EndIf Color 0,0,0 Rect posx,posy,31,31,0 If sudoku(x,y) Text posx+15,posy+15,sudoku(x,y),1,1 Next Next Color 0,0,0 For i=0 To 1 Line 111 + 90*i,20,111+90*i,290 Line 20,111 + 90*i,290,111+90*i Next If Sudoku_solved() Text 20,1,"solved sudoku" ElseIf Sudoku_valid() Text 20,1,"valid sudoku" EndIf If LastAttemp<>"" Text 155,290,LastAttemp,1,0 EndIf If help Color 255,255,255 Rect 40,40,230,230 Color 0,0,0 Rect 39,39,232,232,0 Text 155,50,"Help",1,0 Text 50,80,"Arrow Keys - select field" Text 50,100,"'1'-'9' - write number" Text 50,120,"'0' or 'Del' - clear number" Text 50,140,"'space' - solve sudoku" Text 50,160,"'n' clear sudoku field" Text 50,180,"'F1' toggle helpmenue" Text 155,240,"programmed by "+coderName,1 EndIf End Function ;Functions helping to manage SUDOKU ;Checks, if sudoku is solved ;@ return - true, if sudoku is solved correctly Function Sudoku_solved() If Not Sudoku_valid() Return False For x=0 To 8 For y=0 To 8 If sudoku(x,y) = 0 Return False Next Next Return True End Function ;checks, if sudoku is a valid sudoku ;@return true, if sudoku is valid, false if sudoku is not valid Function Sudoku_valid() Local x[9] Local y[9] For bx=0 To 2 For by=0 To 2 For n=0 To 9 x[n]=0 Next For xi=0 To 2 For yi=0 To 2 Local lx = bx*3 + xi Local ly = by*3 + yi If sudoku(lx,ly) If x[sudoku(lx,ly)] Return False Else x[sudoku(lx,ly)]=True EndIf EndIf Next Next Next Next For i=0 To 8 For n=0 To 9 x[n]=0 y[n]=0 Next For i2=0 To 8 If sudoku(i,i2) If x[sudoku(i,i2)] Return False Else x[sudoku(i,i2)]=True EndIf EndIf If sudoku(i2,i) If y[sudoku(i2,i)] Return False Else y[sudoku(i2,i)]=True EndIf EndIf Next Next Return True End Function ;Clears sudoku field Function sudoku_clear() For x%=0 To 8 For y%=0 To 8 sudoku(x,y) = 0 Next Next End Function ;Loads a sudoku Function sudoku_load() file = ReadFile("save.sud") For x=0 To 8 For y=0 To 8 sudoku(x,y) = ReadInt(file) Next Next CloseFile file End Function ;saves current sudoku Function sudoku_save() file = WriteFile("save.sud") For x=0 To 8 For y=0 To 8 WriteInt file,sudoku(x,y) Next Next CloseFile file End Function |
||
| Man is the best computer we can put aboard a spacecraft ... and the only one that can be mass produced with unskilled labor. -- Wernher von Braun | ||
|
|
SpionAtom |
Do, Jul 17, 2008 13:53 Antworten mit Zitat
|
|---|---|---|
|
Smily0412 hat Folgendes geschrieben: Ich halte es aber für Sinnvoller, das Sudoku-Feld in einem Array[3][3][3][3] zu halten.. anstatt in einem [9][9]
Kannst du ja intern so machen, am Ende rechnest du es in das große zurück. (Kostet natürlich etwas Zeit..) |
||
| os: Windows 10 Home cpu: Intel Core i7 6700K 4.00Ghz gpu: NVIDIA GeForce GTX 1080 | ||
|
|
Firstdeathmaker |
Do, Jul 17, 2008 16:29 Antworten mit Zitat
|
|---|---|---|
|
Zitat: Ich halte es aber für Sinnvoller, das Sudoku-Feld in einem Array[3][3][3][3] zu halten.. anstatt in einem [9][9]
Ich kann direkt mehrere Gründe geben, weshalb ein 9x9 Array zu bevorzugen ist: 1. Man könnte die Basis einfach wechseln, und muss überall nur minimal was ändern. 2. Das durchgehen durch alle Felder verbraucht nur zwei Schleifen statt 4. 2b) Dadurch kann man z.B. bei dem Check auf ein Feld, ob die Spalten und Reihen korrekt sind, nur eine eine einzige For - Schleife benutzen. 3. der Zugriff auf die einzelnen Felder ist vermutlich auch schneller. 4. Das Laden und Abspeichern des Sudokus ist einfacher. Edit: Ich will keinen Entmutigen, deshalb wird meine eigene Lösung nicht am Wettbewerb teilnehmen. Aber ich möchte darauf hinweisen, dass ich bei 3ms für das Wikipedia Sudoku liege (mit Debugger an) und circa 0.5 bis 2.5 ms für jedes Sudoku brauche). Ein paar Performance-Tipps: Benutzt KEINE Types, sondern nur Arrays und Hilfsfunktionen. Dadurch erhöht man die Geschwindigkeit enorm. |
||
|
www.illusion-games.de
Space War 3 | Space Race | Galaxy on Fire | Razoon Gewinner des BCC #57 User posted image |
||
|
|
Noobody |
Do, Jul 17, 2008 17:54 Antworten mit Zitat
|
|---|---|---|
|
Mit Debugger an?
Ich hoffe doch, dass wir vom selben Sudoku reden. Wenn das wirklich stimmt, dann ist das wirklich top. Dann werde ich wohl oder überl nochmal dahintergehen müssen. |
||
| Man is the best computer we can put aboard a spacecraft ... and the only one that can be mass produced with unskilled labor. -- Wernher von Braun | ||
|
|
Firstdeathmaker |
Do, Jul 17, 2008 19:55 Antworten mit Zitat
|
|---|---|---|
| Ja, debugger an, und genau das Sudoku was du da nochmal verlinkt hast. Wie gesagt, Nur Array und Funktionen. | ||
|
www.illusion-games.de
Space War 3 | Space Race | Galaxy on Fire | Razoon Gewinner des BCC #57 User posted image |
||
|
|
Firstdeathmaker |
Fr, Aug 01, 2008 0:03 Antworten mit Zitat
|
|---|---|---|
|
So, dann küre ich wohl Noobody zum Gewinner, da ja leider kein anderer mitgemacht hat.
Trotzdem herzlichen Glückwunsch Noobody, deine Lösung ist ziemlich schnell. Du darfst dich ab jetzt also "King of Sudoku Hacking" nennen!
|
||
|
www.illusion-games.de
Space War 3 | Space Race | Galaxy on Fire | Razoon Gewinner des BCC #57 User posted image |
||
|
|
Noobody |
Fr, Aug 01, 2008 0:28 Antworten mit Zitat
|
|---|---|---|
|
Oh, das ehrt mich
Ehrlich gesagt dachte ich, der Contest ginge noch eine Woche und war deshalb auf der Suche nach einer schnelleren Lösung (deine Umsetzung ist ja leider entmutigend schnell), aber so bin ich einigermassen zufrieden mit dem jetzigen Stand. Ich fände es schön, wenn der Contest hier fortgeführt wird. Sudoku als Thema schien ja nicht unbedingt auf grossen Andrang zu stossen, aber vielleicht würde ein anderer Algorithmus als Aufgabe mehr Teilnehmer anlocken. |
||
| Man is the best computer we can put aboard a spacecraft ... and the only one that can be mass produced with unskilled labor. -- Wernher von Braun | ||
Übersicht
Sonstiges Projekte
Powered by phpBB © 2001 - 2006, phpBB Group