Autor Beitrag
Fiete
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starontopic star
Beiträge: 538
Erhaltene Danke: 240

W7
Delphi 6 pro
BeitragVerfasst: Mi 23.10.19 16:15 
Moin,
das Programm berechnet Euler Quadrate REKURSIV.
Da beginnt das Problem bei mir, für die Längen 1-5 liefert es wenigstens eine Lösung,
bei 6 existiert KEINE Lösung(wurde 1901 von Gaston Tarry gezeigt),
ab Länge 7 dauern die Berechnungen. :?:
Für einen Tipp zur Beschleunigung wäre ich dankbar.
Lösung_4x4
Meine Datentypen:
ausblenden Delphi-Quelltext
1:
2:
3:
4:
MatrixE:Array[1..MaxN,1..MaxN]of String[2];
MatrixL,MatrixG:Array[1..MaxN,1..MaxN]of Char; // Lateinisch, Griechisch
Feld:Array[1..MaxN,1..MaxN]of Record L,G:Integer end;
Karte:Array[1..MaxN*MaxN]of TKarte; // Record L,G:Integer;Benutzt:Boolean end;

Suchprozedur
ausblenden volle Höhe 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:
function TEulerQU.Passt(X,Y,N:Integer):Boolean;
  var K:Integer;
  begin
   Passt:=True;
   for K:=1 to X-1 do // Zeilentest
    begin
     if Feld[K,Y].L=Karte[N].L then begin Passt:=False;exit end;
     if Feld[K,Y].G=Karte[N].G then begin Passt:=False;exit end;
    end;
   for K:=1 to Y-1 do // Spaltentest
    begin
     if Feld[X,K].L=Karte[N].L then begin Passt:=False;exit end;
     if Feld[X,K].G=Karte[N].G then begin Passt:=False;exit end;
    end;
  end;

procedure TEulerQU.Setz(Tiefe,X,Y:Integer);
  var K,XNeu,YNeu:Integer;
  begin
   for K:=1 to KN do
    begin
     inc(Count);
     if not Karte[K].Benutzt then
      if Passt(X,Y,K) then
       begin
        Feld[X,Y].L:=Karte[K].L;Feld[X,Y].G:=Karte[K].G;
        Karte[K].Benutzt:=True;XNeu:=X;YNeu:=Y;
        inc(XNeu);
        Application.ProcessMessages;
        if GetAsyncKeyState(VK_Escape)<0 then
         begin
          Abbruch:=True;
          exit;
         end;
        if XNeu>N then begin XNeu:=1;inc(YNeu) end;
        if Tiefe<KN then Setz(Tiefe+1,XNeu,YNeu)
        else begin inc(GesamtAnzahl);Anzeigen end;
        if Abbruch then exit;
        Feld[X,Y].L:=0;Feld[X,Y].G:=0;Karte[K].Benutzt:=False
       end
    end
  end;
// Initialisierung
   KN:=N*N;GesamtAnzahl:=0// N ist die Seitenlänge des Eulerquadrates
   for Y:=1 to N do
    for X:=1 to N do
     begin
      Karte[(Y-1)*N+X].L:=Y;
      Karte[(Y-1)*N+X].G:=X;
      Karte[(Y-1)*N+X].Benutzt:=False;
      Feld[X,Y].L:=0;Feld[X,Y].G:=0;
     end;
   Abbruch:=False;Count:=0;
   Screen.Cursor:=crHourGlass;
   TSek:=TimeSekunden;
   Setz(1,1,1);
   TSek:=TimeSekunden-TSek;
   Screen.Cursor:=crDefault;

In Erwartung eines guten Hinweises
Gruß Fiete
Einloggen, um Attachments anzusehen!
_________________
Fietes Gesetz: use your brain (THINK)
Horst_H
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starofftopic star
Beiträge: 1647
Erhaltene Danke: 237

WIN10,PuppyLinux
FreePascal,Lazarus
BeitragVerfasst: Fr 25.10.19 06:28 
Hallo,

ich habe mir das Programm von Dir noch nicht angeschaut.
Das buzzard.ups.edu/squares.html könnte mal einen Einblick geben
Zitat:
Euler knew (c. 1780) that there was not a Graeco-Latin square of order 2 and knew constructions when n is odd or divisible by 4

Wie er das gemacht hat, habe ich noch nicht gefunden.
Zitat:
It can be proved that the size of the set of mutually pairwise orthogonal Latin squares of order n cannot exceed n - 1

Also 6912 Lösungen für 4 ist unwahrscheinlich.
Man kann Zeilen und Spalten permutieren.
de.wikipedia.org/wiki/Lateinisches_Quadrat
Uups :-> mathr.co.uk/blog/201...t_latin_squares.html dann schalte ich mal den Rechner aus

Gruß Horst
Fiete Threadstarter
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starontopic star
Beiträge: 538
Erhaltene Danke: 240

W7
Delphi 6 pro
BeitragVerfasst: Fr 25.10.19 15:34 
Moin Horst,

für Seitenlänge = 4n habe ich 10 Tage rumgebastelt, aber noch keinen Algorithmus gefunden.
Zitat:
Wie er das gemacht hat, habe ich noch nicht gefunden.

Da bin ich ebenso noch nicht weiter gekommen.

Es gibt im Netz Lösung für 4 und 10, sind alle identisch.
1989 ist auf einer Cray in ca.2000 Stunden die Lösung für das 10-er Quadrat gefunden worden.

Zitat:
Also 6912 Lösungen für 4 ist unwahrscheinlich.
Man kann Zeilen und Spalten permutieren.

Da hast Du recht, 6912 div (4!^2)=12.
12 Lösungen halte ich für richtig.

Gruß Fiete

_________________
Fietes Gesetz: use your brain (THINK)