Autor |
Beitrag |
Horst_H
      
Beiträge: 1654
Erhaltene Danke: 244
WIN10,PuppyLinux
FreePascal,Lazarus
|
Verfasst: Di 20.09.05 17:28
Hallo,
Da muss unbedingt ein Begrenzer fuer die Versuchstiefe rein.
Ich habe nach der Reduktion 2 Positionen entfernt und auf loesen gedrueckt.
Bei 2.8Gbyte Auslagerungsdatei (1Gb Hauptspeicher) habe ich die Anwendung gekillt ( das dauert immer...)
Gruss Horst
|
|
Grishnak 
      
Beiträge: 221
Windows XP Home
Delphi 7 PE, Delphi 2005 PE
|
Verfasst: Mi 21.09.05 02:40
Horst_H hat folgendes geschrieben: | Ich habe nach der Reduktion 2 Positionen entfernt und auf loesen gedrueckt. |
Jaja, das kleine Biest sucht dann eben alle möglichen Lösungen zusammen!
Wer allerdings nach dem Reduzieren noch Zahlen entfernt, sollte auch ein wenig Zeit mitbringen!
Anbei eine überarbeitete Version, die - so glaube ich - um einiges schneller ist!
Als nächstes nehme ich mir die Generierungs-Routine vor. Damit man einstellen kann, wie schwer der/die/das Sudoku werden soll!
Einloggen, um Attachments anzusehen!
_________________ Mach' etwas idiotensicher und irgendjemand erfindet einen besseren Idioten!
|
|
Luckie
Ehemaliges Mitglied
Erhaltene Danke: 1
|
Verfasst: Mi 21.09.05 03:02
Das ist schlecht in deiner Klasse:
Delphi-Quelltext 1:
| MainForm.ParanoiaLabel1.Caption := 'Test1 (' + IntToStr(col) + '/' + IntToStr(row) + ')'; |
Ich könnte sie jetzt zum Beispiel nicht einfach nehmen und weiterverwenden ohne in deiner Klasse rumzubasteln.
Auch fehlen jegliche Ressourcenschutzblöcke.
Warum ist es kein Stringgrid, dann könnte man einfach über die Tastatur die Ziffern eingeben. Das per Drag and Drop ist doch mehr als umständlich.
Und ausdrucken wäre auch nicht schlecht.
Verdammt, warum fügt Alt+D keine Delphi-Tags ein, obwohl die Leiste angezeigt wird? Quote-Tags gehen. 
|
|
Horst_H
      
Beiträge: 1654
Erhaltene Danke: 244
WIN10,PuppyLinux
FreePascal,Lazarus
|
Verfasst: Mi 21.09.05 10:06
Hallo,
generate und reduce wird erheblich schneller wenn man eine minimale Aenderung vornimmt:
Delphi-Quelltext 1: 2: 3: 4: 5: 6: 7: 8: 9: 10:
| procedure TSudoku.Solve(SolutionList: TSolutionList;Anzahl:integer);
var S: TSudoku; P: TPossibility; col, row, i: integer; begin IF SolutionList.Count >= Anzahl then exit; .... |
Dann kann man bei generate und reduce und ueberhaupt eine Schranke einbauen, die die Suche beschraenkt.
Bei reduce, generate eben Solve(SolutionList,2); einsetzen und bei den anderen z.B. 1000.
Wer braucht bei reduce schon tausende von Loesungen.
P.S.
Mein main.pas hat einen groben Fehler [col,r] mit [col,row] falsch eingesetzt so dass nur einzelne Werte einsetzen ueberhaupt funktionierte.
Dieses laeuft aber dennoch schneller, da die Bestimmung von isvalid {was anderes wird nicht zugelassen} und possilbleValue durch die Mengenoperationen so einfach ist.
Ich haette auch da abfragen sollen, ob je etwas eingefuegt wird, aber bei dem Tempo faellt das auch nicht auf.
Dadurch sind immer noch bei eigentlich eindeutigen Faellen Rekusionen noetig. Das ist schon unbefriedigend.
Gruss Horst
Moderiert von Tino: Code- durch Delphi-Tags ersetzt
|
|
Grishnak 
      
Beiträge: 221
Windows XP Home
Delphi 7 PE, Delphi 2005 PE
|
Verfasst: Mi 21.09.05 10:07
@ Luckie:
wg. Ausgabe:
Ja, diese Ausgaben sind aber auch nur dazu da, zu sehen, ob sich noch was tut! (deshalb auch die Label-Bezeichnung 'Paranoia'  ) Das kommt später raus!
wg. Schutzblöcke:
Auch hier muss ich auf später vertrösten. Problematik ist mir allerdings bekannt!
wg. StringGrid:
Mit einem TStringGrid habe ich herumprobiert, aber ich war damit nicht zufrieden!
wg. Ausdrucken:
Gute Idee! Werd' ich machen... 
_________________ Mach' etwas idiotensicher und irgendjemand erfindet einen besseren Idioten!
|
|
Grishnak 
      
Beiträge: 221
Windows XP Home
Delphi 7 PE, Delphi 2005 PE
|
Verfasst: Mi 21.09.05 16:33
So hier eine weitere Version:
- mit Eingabe einer maximalen Suchtiefe beim Lösen
- mit Eingabe eines Schwierigkeitsgrades beim Generieren
später mehr..!
@Horst_H: Danke für den Hinweis auf die Reduce-Routine!
Einloggen, um Attachments anzusehen!
|
|
Martin1966
      
Beiträge: 1068
Win 2000, Win XP
Delphi 7, Delphi 2005
|
Verfasst: Fr 23.09.05 09:01
Hallo!
Nettes Programm. Wäre aber schön wenn man in dem "Grid" mit den Cursor-Tasten navgieren könnte um dann direkt eine Zahl einzutragen - also ohne Drag and Drop. Das ist wirklich etwas umständlich.
Schön wäre es auch wenn man beim Generieren einen Abbruch-Button zur Verfügung hat um den Vorgang abzubrechen.
Lg Martin
|
|
Grishnak 
      
Beiträge: 221
Windows XP Home
Delphi 7 PE, Delphi 2005 PE
|
Verfasst: Fr 23.09.05 11:00
Da mir die Forderung von Horst_H nach "mehr Speed" keine Ruhe gelassen hat, habe ich die interne Darstellung komplett geändert - ich denke mit Erfolg! Das Programm sollte jetzt um einiges schneller laufen. (Allerdings können die .sud-Dateien der Vorgängerversionen nicht mehr geladen werden!)
Da meine anfängliche Meinung, dass das Programm so eigentlich fertig wäre, sich als falsch herausgestellt hat, habe ich auch die Versionsnummer geändert. Die aktuelle Version ist jetzt 0.9.3!
Die Generierung von Sudokus läuft (einwandfrei), allerdings bin ich hier noch am schrauben!
Eventuell überdenke ich auch noch die Steuerung (Stichwort: StringGrid statt Drag-n-Drop). Ebenfalls ausstehend ist eine Druck-Funktion sowie der Export als Text-Datei.
Einloggen, um Attachments anzusehen!
_________________ Mach' etwas idiotensicher und irgendjemand erfindet einen besseren Idioten!
|
|
Horst_H
      
Beiträge: 1654
Erhaltene Danke: 244
WIN10,PuppyLinux
FreePascal,Lazarus
|
Verfasst: Fr 23.09.05 12:20
Hallo,
Du hast ein Speicherleckproblem:
Du erzeugst wahnsinnig viele Objekte, aber gibst sie nicht mehr frei.
wenn du einfach eine FreeAndNil nach dem Test einfuehrst ist alles wieder gut.
8 MB konstant.
Statt immer zusaetzlich 6MB fuer jedes loesen des 15327.sud
Delphi-Quelltext 1: 2: 3: 4: 5: 6: 7: 8:
| For ... S:=TSudoku.Create; S.CopyFrom(self); S.FCells[col, row]:=$001 ShL i; minDepth:=S.Solve(Solutions, maxDepth-1, FindMulti)+1; >>>freeAndNil(S); if (minDepth > 0) and (minDepth < Result) then Result:=minDepth;Deine |
Gruss Horst
Moderiert von raziel: Code- durch Delphi-Tags ersetzt
|
|
GTA-Place
      

Beiträge: 5248
Erhaltene Danke: 2
WIN XP, IE 7, FF 2.0
Delphi 7, Lazarus
|
Verfasst: Fr 23.09.05 13:10
Grishnak hat folgendes geschrieben: | Ich verstehe zwar nicht warum, aber bitte: |
Warum wohl? Vielleicht weil ich keine Lust habe, das erst zu entpacken, um
es dann mit Delphi öffnen und compilieren zu können. Ich will einfach nur gucken,
ob das Programm funktioniert und nicht wie der Source aussieht.
_________________ "Wer Ego-Shooter Killerspiele nennt, muss konsequenterweise jeden Horrorstreifen als Killerfilm bezeichnen." (Zeit.de)
|
|
Grishnak 
      
Beiträge: 221
Windows XP Home
Delphi 7 PE, Delphi 2005 PE
|
Verfasst: Fr 23.09.05 13:51
@GTA-Place: War nicht böse gemeint, aber mir ist der Quelltext lieber. Er ist 1.) kleiner und schneller heruntergeladen und 2.) brauch' ich nicht noch nach Viren/Würmern/Trojanern zu suchen! Allerdings habe ich deine Bitte zu Herzen genommen und immer beides (Source + EXE) hochgeladen!
@Horst_H: Danke! Ich versuche zwar, darauf zu achten, alles was nicht mehr benötigt wird auch wieder freizugeben, aber da hat man schnell mal was übersehen! 
_________________ Mach' etwas idiotensicher und irgendjemand erfindet einen besseren Idioten!
|
|
Horst_H
      
Beiträge: 1654
Erhaltene Danke: 244
WIN10,PuppyLinux
FreePascal,Lazarus
|
Verfasst: Sa 24.09.05 14:20
Hallo,
ich hatte da so eine Idee den Generator anders zu gestalten.
Ich erzeuge 3 mal eine beliebige Anordnung der n Zahlen in einem Quadrat.
Delphi-Quelltext 1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25:
| procedure Wirbeln(var outW:tArrValue); var n_Fak,i : Cardinal; j,Pos,hilf : Tvalue; begin n_Fak := 1; For i := 0 to 8 do begin n_Fak := n_Fak*i; outW[i] := i+1; end; i := Random(n_Fak); For j := high(TValue) downto 1 do begin Pos := i mod j; i := i div j; If Pos<> j then begin hilf := outW[Pos]; outW[Pos] := outW[j]; outW[j] := hilf; end; end; |
und trage diese Werte in die Quadrate 1,4,9
1,2,3
4,5,6
7,8,9
Delphi-Quelltext 1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14:
| i := 0; repeat Pos := 0; Wirbeln(WirbelFeld); for col := i to i+conSqr-1 do for row := i to i+conSqr-1 do begin inc(pos); InsertValAt(WirbelFeld[pos],col,row); end; inc(i,conSqr); until i = ConSide; |
das ergibt ein garantiert loesbares Sudoku.Eindeutig vielleicht nicht, aber try and error setzt Du ohnehin ein.
Jetzt reduzieren und fertig ist die Kiste.
Vielleicht nochmals eine der 18432 kongruenten Anordnungen erzeugen, da Reduzieren immer in einer Ecke anfaengt und dann Zeilenweise vorgeht.
Mich wundert nur, warum Du nicht mit set's arbeitest.
i := word(FreeplaceSet); funktioniert fuer deine Case Anweisung
Optimal arbeitet Delphi mit set = [0..31] intern eben integer.
Dann fallen die bei mit vorkommenenden AND BX,$01FF weg, um mein set genau auf 9 bit zu trimmen.
Gruss Horst
Moderiert von raziel: Code- durch Delphi-Tags ersetzt
|
|
Grishnak 
      
Beiträge: 221
Windows XP Home
Delphi 7 PE, Delphi 2005 PE
|
Verfasst: So 25.09.05 10:01
@Horst_H: Sorry, aber ich blicke deinen Code nicht! Da ich mir momentan aber ebenfalls Gedanken über ein effizienteres Generieren mache, bin ich für Vorschläge offen. Könntest du deinen Algorithmus vielleicht mir Worten/Bildern beschreiben?
Eine Idee von mir ist folgende: Es wird solange eine bestimmte Anzahl (ca. 27-33) Zufallszahlen in einen leeren Sudoku geschrieben, bis dieser mindestens eine Lösung hat. Hat er mehrere Lösungen wird davon eine ausgesucht und solange Zahlen dieser Lösung eingesetzt, bis es nur noch ebendiese Lösung gibt.
|
|
Horst_H
      
Beiträge: 1654
Erhaltene Danke: 244
WIN10,PuppyLinux
FreePascal,Lazarus
|
Verfasst: So 25.09.05 12:11
Hallo,
Mein Vorschlag kurz beschrieben:
Es geht einfach darum, ein fertiges Sudoku zu reduzieren.
Um moeglichst schnell, ohne irgendeinen Test (isValid etc) ein besonders zufaelliges und sofort loesbares Sudoku zu erzeugen, wende ich eben folgendes Verfahren an.
Es sind alle Ziffern von 1 bis 9 in jedem 3x3 Quadrat unterzubringen.
Ich erzeuge mit wirbeln genau eine von den 9! (1*2*3*4*5*6*7*8*9 =362880) Moeglichkeiten der Anordnung von 9 verschiedenen Ziffern
z.B.: (Hier aufsteigened bei mir nicht)
123456789,123456798,123456879,..,987654321
Diese zufaeligen Abfolgen packe ich ich dann in Quadrate die weder zeilen- noch spaltenmaessig etwas miteinander zu tun haben.(1,5,9 oder 2,4,9...)
Bsp:
127xxxxxx
543xxxxxx
968xxxxxx
xxx753xxx
xxx842xxx
xxx196xxx
xxxxxx486
xxxxxx529
xxxxxx713
mit der einer Loesung von 127787(8.38 Sekunden ohne paranoia Ausgabe(70% Kernel CPU))
127985634
543671892
968324175
896753241
315842967
274196358
732519486
681437529
459268713
Jetzt die erste Loesung davon nehmen, alle moeglicherweise folgenden interessieren jetzt nicht mehr.
Jetzt geht es ans reduzieren.
Jede zweite Ziffer auf dem Feld kann sowieso weg( Die hoechste Rekursionstiefe fuer solve war 39 bei einem komplett leeren Feld und die niedrigtse (bisher ) 19 um eien eindeutige(und keine 127787) Loesung zu haben.)
Das heisst minimal sind 19 Felder zu belegen um nach Irrungen und Wirrungen an die einzig moegliche Loesung zu kommen und maximal 39 (fast untere Dreiecksmatrix mit ein paar Luecken)
Ich stelle mir verschiedene Muster vor die man entfernt und dann erst reduziert, damit nach der Reduzierung nicht immer etwas Aehnliches herauskommt.
Alternativ betrachtest Du das FCells Feld als linear von 0..80 und entfernst nach der Methode Zufall
Delphi-Quelltext 1: 2: 3: 4: 5: 6: 7:
| Pos := random(2); while Pos < 81 do begin Sudoku.Fcells[Pos Div 9,Pos mod 9]=$000; inc(pos,random(2)+1); end; |
Nach der Reduzierung bleiben meist nur 23 uebrig.
Jetzt muss die Reduzierung die Entscheidung uber schwer oder leicht treffen
Genug gefaselt, ich esse erst mal was
Gruss Horst
|
|
Luzzifus
      
Beiträge: 200
Win2K
D6 Prof
|
Verfasst: Sa 29.10.05 14:12
Horst_H hat folgendes geschrieben: | Um moeglichst schnell, ohne irgendeinen Test (isValid etc) ein besonders zufaelliges und sofort loesbares Sudoku zu erzeugen, wende ich eben folgendes Verfahren an.
Es sind alle Ziffern von 1 bis 9 in jedem 3x3 Quadrat unterzubringen.
Ich erzeuge mit wirbeln genau eine von den 9! (1*2*3*4*5*6*7*8*9 =362880) Moeglichkeiten der Anordnung von 9 verschiedenen Ziffern
z.B.: (Hier aufsteigened bei mir nicht)
123456789,123456798,123456879,..,987654321
Diese zufaeligen Abfolgen packe ich ich dann in Quadrate die weder zeilen- noch spaltenmaessig etwas miteinander zu tun haben.(1,5,9 oder 2,4,9...)
Bsp:
127xxxxxx
543xxxxxx
968xxxxxx
xxx753xxx
xxx842xxx
xxx196xxx
xxxxxx486
xxxxxx529
xxxxxx713
mit der einer Loesung von 127787(8.38 Sekunden ohne paranoia Ausgabe(70% Kernel CPU))
127985634
543671892
968324175
896753241
315842967
274196358
732519486
681437529
459268713
Jetzt die erste Loesung davon nehmen, alle moeglicherweise folgenden interessieren jetzt nicht mehr. |
Ich hab das mal ausprobiert, also 3 zufällige Permutationen in 3 unabhängige Blöcke gepackt und dann per Backtracking-Algorithmus die erste Lösung gesucht. Das findet in 9/10 Fällen ein gültiges Sudoku in 15-30 Millisekunden (@2,066GHz), aber etwa alle 10 Mal dauert's deutlich länger. Das maximale waren bei mir fast 50 Sekunden nur um die erste Lösung zu finden.. Oo
Source für die die's interessiert:
1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66: 67: 68: 69:
| procedure Perm3x(); var i,j,block : Byte; x : String; tmp : Integer; tmpS : String; begin block := RandomRange(0,6); x := nthPerm('147', block);
for i := 1 to 3 do begin tmp := RandomRange(0, 362800); tmpS := nthPerm('123456789', tmp); for j := 0 to 8 do begin doneAr[StrToInt(x[i])+(j mod 3),(i*3)-2+(j div 3)] := StrToInt(tmpS[j+1]); end; end; end;
procedure BTsolve(var xxAr: TdoneAr); var ex2 : Boolean;
procedure BTsolveInt(xAr: TdoneAr; y, count: Integer); var i,j,k,p,q : Byte; x : Word; ex : Boolean; begin inc(count); Form1.ProgressBar1.Position := count; for i:=y to 9 do for j:=1 to 9 do if xAr[i,j]=0 then begin x := CheckPossible(i,j,xAr); for k:=1 to 9 do if not (x and (1 shl k) = 0) then begin ex := false; if ex2 then exit; if count < 55 then begin xAr[i,j] := k; doneAr[i,j] := k; for p:=1 to 9 do for q:=1 to 9 do if not CheckConsistent(p,q,xAr) then ex:=true; if not ex then BTsolveInt(xAr, i, count); end else ex2 := true; end else if k=9 then exit; end else if (i=9) and (j=9) then ex2 := true; end;
begin ex2 := false; BTsolveInt(xxAr, 1, 0); end; |
|
|
Horst_H
      
Beiträge: 1654
Erhaltene Danke: 244
WIN10,PuppyLinux
FreePascal,Lazarus
|
Verfasst: Sa 29.10.05 16:16
Hallo,
15..30 ms...
Grishnak-Variante ist einfach viel schneller mit ca. 10000..20000 Loesungen/s statt mit viel Gehirnschmalz diese Einschraenkungen zu machen.
Um in einer Position herauszufinden, welche simpel moeglich ist, braucht es nur die Differenzmenge Aller Belegungen(1..9)- Vereinigungsmenge(inZeileBelegt,inSPalteBelegt,inCarreeBelegr), was sich sehr schnell pflegen und machen laesst.
Um eine eindeutige Belegung zu bestimmen muss man feststellen welche Belegungen in jeder Position fuer die Nachbar Spalten,Zeilen,Carreepositioen moeglich sind. Also jedesmal 8 aufwendige Test's .
Da aber eigentlich nur eine paar Belegungen an einer Position zur Auswahl stehen sind dieser schneller eingesetzt und trivial getestet als aufwaendig, da jedes einsetzen sofort ein paar Moeglickeiten in anderen Feldern beschraenkt.
Zu Perm3:
Das ein recht unsinniger Vorschlag von mir,da ueber 280000 Loesungen entstehen koennen
(3.7 Sekunden AMD64 3000).
Grishnak hat doch eine Variante die nur eindeutige Loesungen sucht, was aber sehr lange dauern kann.Falls man mehrere ,z.B 5 Loesungen zulaesst, entsteht ein neues Sudoku waehrend eines Wimperschlages.
Gruss Horst
|
|
Max711
Hält's aus hier
Beiträge: 8
|
Verfasst: Fr 25.11.05 17:45
Hi,
kann irgendwer mal eine einfachere Möglichkeit, mit Array und Stringgrid programmieren? Durch diese hier blicke ich leider nicht durch. Muss ja auch nicht soviele funktinen haben, wenigstens, das man keine Falscheingaben machen kann und vielleicht lösen!
Wäre euch sehr dankbar, denn ich versuche es schon seit längerem ohne Erfolg.
|
|
Martin1966
      
Beiträge: 1068
Win 2000, Win XP
Delphi 7, Delphi 2005
|
Verfasst: Fr 25.11.05 17:59
Max711 hat folgendes geschrieben: | Wäre euch sehr dankbar, denn ich versuche es schon seit längerem ohne Erfolg. |
Zeig doch mal was genau du schon gemacht hast. Darauf können wir vielleicht aufbauen und dir helfen. 
_________________ Ein Nutzer der Ecke
|
|
sebjensen
Hält's aus hier
Beiträge: 14
Win XP, Suse Linux 9.3
Dephi 6.0
|
Verfasst: Fr 25.11.05 22:20
Hallo,
zuerst muss ich euch alle mal loben! Das Programm ist echt super. Trotzdem habe ich einige Verbesserungsvorschläge, die vielleicht jemand von euch realisieren kann. Da meine Delphikenntnisse für solche mathematischen Algorithmen nicht ausreichen.
1.) Ich würde eine Druckfunktion hinzufügen. Damit man sein erzeugtes Sudoku auch mitnehmen kann. Da man ja auch unterwegs gerne eine Runde spielen möchte.
2.) Delphi bringt doch die Funktion zum Erstellen von Menüs mit. So etwas würde ich auch noch einbauen, da jedes Programm über ein Menü verfügt, dass natürlich die gleiche Funktionen wie die Buttons liefert.
3.) Ein "ABOUT"-Knopf mit Angaben über den Programmierer
4.) Wieder das Einführen von der Auswahlfläche, welche Art von Sudoku man erstellen möchte (leicht - mittel - schwer) --> abhänging wie viele Zahlen man vorgibt
5.) Die Auswahlmöglichkeit die Anzahl der Nummer, die bereits eingetragen sind (mindestens 20 maximal 30 bis 40) vorher einzugeben.
Ich hoffe, dass mir jemand dabei helfen kann dieses Programm weiterzuentwickeln.
Vielen Dank schon einmal.
Sebastian Jensen
|
|
Max711
Hält's aus hier
Beiträge: 8
|
Verfasst: Sa 26.11.05 00:10
Hab bisher nur ein Grid und ein Array. In dem werden per for-Schleife Zahlen eingefügt, aber noch nicht korrekt, so dass nur jede Zahl einmal in jeder Spalte, Zeile und jedem unter Quadrat erscheint. Aber zumindestt schonmal von 1 - 9!
Ich weiß, ist nicht so toll, aber ich bin ja auch nicht so gut in Delphi.
|
|
|