Sudoku Generator

Luzzifus · Beiträge: 200 Win2K D6 Prof

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:

markieren

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:
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
  // wählt drei unabhängige Blöcke aus (dafür existieren 6 Möglichkeiten):
  // (Die obere Grenze von RandomRange ist entgegen der DOH nicht inklusive.)
  block := RandomRange(0,6);
  x := nthPerm('147', block);

  // Schreibt 3 zufällige Permutationen der Ziffernfolge 1..9 in
  // die drei oben ausgewählten Blöcke:
  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
          // CheckPossible gibt die möglichen Belegungen eines Feldes in 
          // Form gesetzter Bits in einem Word-Wert zurück:
          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;
                // CheckConsistent überprüft ob es an der angegebenen 
                // Stelle Widersprüche im Sudoku gibt:
                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 · 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

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

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 · 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

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! :oops:

Ich weiß, ist nicht so toll, aber ich bin ja auch nicht so gut in Delphi.

sebjensen · Verfasst: Sa 26.11.05 10:01

Hallo,

ich habe mich schon mal drangesetzt und zwei Punkte realisisert. Zum einen das Menü und zum anderen die Möglichkeit sich sein Sudoku auszudrucken. Bei den restlichen Verbesserungen von mir, weiß ich leider nicht, wie ich die realisieren soll. Ich hoffe, dass mir dabei einer Helfen kann.

Einloggen, um Attachments anzusehen!

Miri · Beiträge: 657 Delphi 3 Prof., Delphi 2005 PE

hmm...also, seit ich diese paranoia-anzeige entdeckt hab, find ich das ganze ziemlich witzlos... kannst du die nicht ausschaltbar machen?? so machts irgendwie keinen spaß und so sehr man sich bemüht, nicht hinzugucken, das springt einem immer ins auge, wenn mans weiß...

sebjensen · Verfasst: Di 29.11.05 19:11

Hier eine Variante mit der Möglichkeit das Paranoia auszuschalten!

Einloggen, um Attachments anzusehen!

Grishnak · Beiträge: 221 Windows XP Home Delphi 7 PE, Delphi 2005 PE

Jaja, mein Generator ist (immer noch) nur im Beta-Stadium! Aber bei dem Druck hier, werde ich mich wohl mal wieder dransetzten müssen...

_________________
Mach' etwas idiotensicher und irgendjemand erfindet einen besseren Idioten!

MagicT · Hält's aus hier Beiträge: 1

Ich habe auch einen Generator + Solver für Sudokus geschrieben. Leider ist's ein Java-Applet geworden, ausnahmsweise mal nicht mit Delphi. Vielleicht interessiert's jemanden.

Sudoku: Generieren, lösen, spielen
Gruß, Timo

Luzzifus · Beiträge: 200 Win2K D6 Prof

Ich habe meinen Sudoku Solver & Generator nun auch soweit fertig (mit einigen Denkpausen

). Source (D6 Pro) und Binary sind im Anhang.

Sudokus lösen:

Ich benutze wie an anderer Stelle schon erwähnt keinen Brute-Force-Algorithmus sondern eine Lösungsheuristik, die dem Lösen durch logisches Denken sehr nahe kommt. Die Lösung wird durch eindeutig bestimmbare Felder und ein Ausschlussverfahren bestimmt. Der Algorithmus löst jedes eindeutig lösbare Sudoku komplett, bei nicht eindeutigen bleiben die entsprechenden Felder unbestimmt, bei Sudokus ohne Lösung werden die verantwortlichen Konflikte bestimmt und angezeigt (Drittes Beispiel-Sudoku testen!! -> Orange bedeutet unbestimmtes Feld, rot bedeutet Konflikt).

Sudokus generieren:

Alle generierten Sudokus sind mit Sicherheit eindeutig lösbar, sprich sie besitzen genau eine Lösung. Zuerst werden (nach Idee von Horst H.) in drei unabhängige Blöcke, d.h. paarweise ohne gemeinsame Zeilen/Spalten, jeweils die Zahlen von 1-9 in zufälliger Reihenfolge eingetragen (genauer: n-te Permutation, neue Permutation für jeden Block). Dann wird das Sudoku per Brute-Force vervollständigt bzw. darauf getestet ob es widerspruchsfrei ist. Zum Schluss werden Ziffern entfernt unter der Bedingung dass das Sudoku nach jedem Schritt weiterhin eindeutig lösbar ist. Dies wird solange gemacht bis entweder die der gewählten Schwierigkeit entsprechende Anzahl Ziffern entfernt wurde oder keine weitere Ziffer mehr entfernt werden kann ohne die Eindeutigkeit zu zerstören. Letztere Abbruchbedingung dürfte hauptsächlich bei maximaler Schwierigkeit greifen, denn auf dieser können bis zu 64 Ziffern entfernt werden (da das theoretische Minimum für ein eindeutig lösbares Sudoku 17 vorhandene Ziffern sind).

Ich bin empirisch zu der Überzeugung gekommen, dass nach diesem Algorithmus zur Generierung die Schwierigkeit der entstandenen Sudokus ziemlich stark mit der Anzahl der entfernten Ziffern korreliert. Das verwundert eigentlich nicht, denn gerade auf maximaler Schwierigkeit hört der Algorithmus ja erst auf wenn's nicht mehr schwerer geht. Und diese Sudokus sind dann nach meinem Empfinden schon wirklich richtig schwer. Ausserdem entstehen in keiner Schwierigkeit triviale Sudokus.

Auf meinem Rechner (Athlon XP 2600+) benötigt der Generierungsalgorithmus für die Schwierigkeiten einfach, mittel, schwer 0-15ms und für sehr schwere Sudokus 70-150ms (durchschnittlich etwa 90ms).

Fazit: Nicht die einfachste Lösung, aber die langsamste ist sie auch nicht grade. Es werden eindeutig lösbare Sudokus durchweg in Sekundenbruchteilen erstellt und die Schwierigkeit der generierten Sudokus stimmt recht gut mit der gewählten Schwierigkeit überein.

Druckfunktion und eine Möglichkeit zum Speichern von Sudokus folgen auch noch. Vielleicht..

so long,
Luzzi

Einloggen, um Attachments anzusehen!

Larus · Beiträge: 431

kannst ned in deine 1.2er version (die find ich am besten) nich ne Drucken fkt. einbauen^^

edit hat sich schon erledigt...^^ hatte nicht bis zum ende gelesen

Alni · Verfasst: Mo 24.07.06 20:08

@Luzzifus

Hier ein Beispiel das eindeutig (mit Logik aber ohne raten und probieren) lösbar ist und dennoch von deinem Programm nicht gelöst wird

markieren

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:
26:

000 060 128
001 000 094
003 001 000

200 400 060
706 000 903
030 006 002

300 200 456
852 600 700
164 050 200  


einzige Lösung:

475 963 128
681 725 394
923 841 675

218 439 567
746 582 913
539 176 842

397 218 456
852 694 731
164 357 289

_________________
MfG Alex

Coachless · Hält's aus hier Beiträge: 1

@ grishnak ...wie kann ich deinen namen oben aus der leiste entfernen?

Ich bräuchte das mal für nen Info Projekt, zumindest die struktur

Eike89 · Hält's aus hier Beiträge: 14 Win XP Delphi 5

ich finde, es ist ein echt tolles prog, auch wenns schon welche dieser art gibt. nur bei der letzten version könnte man eventuel noch die vorgegebenen zahlen fixieren, dass ich sie nicht einfach ändern kann....readonly unso

eike

	Mitgliederliste
	Gruppen
	Das Team
	Richtlinien
	Synonyme