genau solch einen Code habe ich geschrieben, jedoch muss noch ein Fehler drin sein, denn manchmal klappt es nicht, ein Rätsel zu erzeugen und das Programm bleibt irgendwo hängen. Erstmal zum groben Ablauf des Algorithmus (zum späteren Verständnis meines Codes): Um das Sudoku-Rätsel zu erzeugen, wird der Reihe nach (Zeilenweise von oben nach unten und von links nach rechts) jede Zelle des 9x9 Felder großen Rätsels mit einer Ziffer befüllt. Dabei wird eine zufällige Zahl zwischen 1 und 9 erzeugt und eingetragen. Kommt es durch diese Zahl zu einem Regelverstoß, wird eine andere probiert. Bei Erfolg geht's zur nächsten Zelle und wenn keine Zahl mehr passt, dann wird eine Zelle zurückgegangen und in dieser eine neue, zuvor noch nicht probierte Zahl, eingetragen. Für jede Zelle gibt es einen String, in welchem die bereits probierten Zahlen gelöscht werden.
Letztlich ergibt sich ein vollständig gefülltes Zahlengitter aus welchem anschließend einige Zahlen wieder entfernt werden.
Die Routine, die für das Entfernen der Zahlen zuständig ist, scheint zu funktionieren. Beim Debuggen hängt er dort nie drin, wenn's mal wieder hängengeblieben ist. Das Problem muss in der/den anderen Programmroutinen stecken.
Wäre jemand so nett und würde meinen Code mal auf dieses Problem hin untersuchen? Ich weiß, dass dies eigentlich schon eine Zumutung ist aber vielleicht hat jemand zufällig Lust, sich damit zu befassen. Ich kann den Fehler einfach nicht finden.
Vielen Dank schonmal im Voraus.
Code: Alles auswählen
Global Dim Matrix.l(9,9),Dim FreeNumbers.s(81),CellX.b,CellY.b,SquareX.b,SquareY.b
;Matrix = speichert die Ziffern des 9x9 Felder großen Puzzles.
;FreeNumbers = jeder String enthält die für die entsprechende Zelle noch zur Verfügung
; stehenden Ziffern
;CellX,CellY = aktuelle Position im 9x9er Puzzle (Zeile, Spalte)
;SquareX,SquareY = Zeile und Spalte der oberen linken Ecke des aktuellen 3x3er Miniquadrats
Procedure SetValues() ;Setzen der Ausgangswerte für die Erstellung eines neuen Puzzles
For a=1 To 9
For b=1 To 9
Matrix(a,b)=0
FreeNumbers(a*b)="123456789"
Next
Next
CellX=1
CellY=1
SquareX=1
SquareY=1
EndProcedure
Procedure.b Legality() ;Prüfen, ob die zuletzt eingetragene Ziffer einen Regelverstoß verursacht
Result.b=1
For a=1 To 9
String1$=String1$+Str(Matrix(CellX,a))
String2$=String2$+Str(Matrix(a,CellY))
Next
If CountString(String1$,Str(Matrix(CellX,CellY)))>1 Or CountString(String2$,Str(Matrix(CellX,CellY)))>1
Result=0
EndIf
For a=1 To 3
For b=1 To 3
String$=String$+Str(Matrix(SquareX+a-1,SquareY+b-1))
Next
Next
If CountString(String$,Str(Matrix(CellX,CellY)))>1
Result=0
EndIf
ProcedureReturn Result
EndProcedure
Procedure DetectSquare() ;Anhand von Zeilen- und Spaltenposition (CellX, CellY) ermitteln, in
Select CellX ;welchem 3x3er Miniquadrat sich die aktualle Zelle befindet und die
Case 1 To 3 ;Zeilen- und Spaltenposition dessen setzen.
SquareX=1
Case 4 To 6
SquareX=4
Default
SquareX=7
EndSelect
Select CellY
Case 1 To 3
SquareY=1
Case 4 To 6
SquareY=4
Default
SquareY=7
EndSelect
EndProcedure
Procedure PreviousStep()
If CellY>1
CellY=CellY-1
Else
CellY=9
CellX=CellX-1
EndIf
DetectSquare()
EndProcedure
Procedure NextStep()
If CellY<9
CellY=CellY+1
Else
CellY=1
CellX=CellX+1
EndIf
DetectSquare()
EndProcedure
Procedure GenerateNumber() ;Erzeugen einer zufälligen Zahl zwischen 1 und 9, um diese in
Repeat ;die aktuelle Zelle einzusetzen. Bei Regelverstoß die nächste
If FreeNumbers(CellX*CellY)="" ;noch nicht probierte Ziffer einsetzen und bei Erfolg in die
Matrix(CellX,CellY)=0 ;nächste Zelle gehen. Wenn keine Ziffer passt, eine Zelle zurück.
FreeNumbers(CellX*CellY)="123456789"
PreviousStep()
Break
EndIf
Matrix(CellX,CellY)=Val(Mid(FreeNumbers(CellX*CellY),Random(Len(FreeNumbers(CellX*CellY))-1)+1,1))
FreeNumbers(CellX*CellY)=RemoveString(FreeNumbers(CellX*CellY),Str(Matrix(CellX,CellY)))
If Legality()=1
NextStep()
Break
EndIf
ForEver
EndProcedure
Procedure.b CheckRows() ;Überprüfen, wieviele Zahlen sich noch in der Zeile und Spalte der
Result.b=0 ;Zelle befinden, aus welcher eine Zahl entfernt werden soll.
For a=1 To 9
String1$=String1$+Str(Matrix(CellX,a))
String2$=String2$+Str(Matrix(a,CellY))
String3$=String3$+Str(Matrix(5+(5-CellX),a))
String4$=String4$+Str(Matrix(a,5+(5-CellY)))
Next
If CountString(String1$,"0")<5 Or CountString(String2$,"0")<5 Or CountString(String3$,"0")<5 Or CountString(String4$,"0")<5
Result=1
EndIf
ProcedureReturn Result
EndProcedure
Procedure RemoveNumbers() ;Entfernen von Zahlen aus dem fertigen Puzzle in einem
NumbersToRemove.b=Random(12)+45 ;symmetrischen Verfahren
NumbersRemoved.b=0
Counter.w=0
Repeat
Counter=Counter+1
If Counter>10000:Break:EndIf
CellX=Random(8)+1
CellY=Random(8)+1
If Matrix(CellX,CellY)<>0 And CheckRows()=1
Matrix(CellX,CellY)=0
Matrix(5+(5-CellX),5+(5-CellY))=0
If CellX=5 And CellY=5
NumbersRemoved=NumbersRemoved+1
Else
NumbersRemoved=NumbersRemoved+2
EndIf
EndIf
Until NumbersRemoved>NumbersToRemove
EndProcedure
Procedure CreateOutputImage() ;Das Rätsel in ein Bild zeichnen und dieses anschließend öffnen
CreateImage(0,288,288,24)
LoadFont(0,"Arial",16,#PB_Font_Bold)
StartDrawing(ImageOutput(0))
Box(0,0,288,288,$FFFFFF)
Box(8,8,90,90,$FFFFFF)
Box(188,8,90,90,$FFFFFF)
Box(98,98,90,90,$FFFFFF)
Box(8,188,90,90,$FFFFFF)
Box(188,188,90,90,$FFFFFF)
Box(98,8,90,90,$EEEEEE)
Box(8,98,90,90,$EEEEEE)
Box(188,98,90,90,$EEEEEE)
Box(98,188,90,90,$EEEEEE)
DrawingMode(#PB_2DDrawing_Outlined)
For a=0 To 2
For b=0 To 2
For c=7 To 9
Box(a*90+c,b*90+c,91,91,$000000)
Next
Next
Next
For a=0 To 8
For b=0 To 8
Box(a*30+8,b*30+8,31,31,$000000)
Next
Next
DrawingFont(FontID(0))
DrawingMode(#PB_2DDrawing_Transparent)
For a=0 To 8
For b=0 To 8
If Matrix(a+1,b+1)>0
DrawText(b*30+17,a*30+12,Str(Matrix(a+1,b+1)))
EndIf
Next
Next
StopDrawing()
SaveImage(0,"Sudoku.bmp")
RunProgram("Sudoku.bmp")
EndProcedure
Procedure CreatePuzzle()
SetValues()
Repeat
GenerateNumber()
If CellX>9:Break:EndIf
ForEver
RemoveNumbers()
CreateOutputImage()
EndProcedure
CreatePuzzle()
)