magisches quadrat, brauch ne idee...

[glkgereon]

moin, ich hab folgendes programm zur lösung eines magischen quadrats geschrieben...
es soll ein 4x4-großes quadrat mit den zahlen 1-16 gefüllt werden, sodass die summen (spalten, zeilen, diagonale) 34 ergeben

ich wollte einfach alle kombinationen ausprobiern, und immer testen obs funzt

doch mir fehlt noch eine idee, wie ich es schaffe, das jede zahl nur einmal eingesetz wird...

hier meine prozedur, ist rekursiv (worauf ich sehr stolz bin :mrgreen: )

Delphi-Quellcode:

procedure TForm1.setfield(recursion:byte);
var i:integer;
begin
  for i:=1 to 16 do
    begin
//Hierum Gehts, es muss statt i irgendwas anderes eingesetzt werden....
    quadrat[(recursion div 4)+1, (recursion mod 4)+1]:=i;
    if iscorrect
    then solutions.Add( inttostr(
                        quadrat[1,1]+quadrat[1,2]+quadrat[1,3]+quadrat[1,4]+
                        quadrat[2,1]+quadrat[2,2]+quadrat[2,3]+quadrat[2,4]+
                        quadrat[3,1]+quadrat[3,2]+quadrat[3,3]+quadrat[3,4]+
                        quadrat[4,1]+quadrat[4,2]+quadrat[4,3]+quadrat[4,4]));
    if recurse<15
    then setfield(recursion+1);
    end;
end;

zur erklärung:
quadrat is ein array[1..4,1..4] of byte
iscorrect eine function die prüft ob die lösung korrekt ist

hat da einer idee wie man das machen könnte?

PS: ausserdem bekomme ich noch einen abstrakten fehler....weiss aber nicht wann, irgendwann bei der rekursion...

[Matze]

Für was braucht man bei der Rekursion eine for-Schleife? :gruebel:

Edit: Du könntest die Zahlen 1-16 in ein Array geben, das zufällig mischen und dann die Indizes in die Felder geben.

[Jelly]

Bei Quadraten mit ungerader Seitenlänge kenn ich einen Algorithmus. Bei 4x4 klappt der leider nicht...

1. Die Zahl schreibst du ein Feld unter die Mitte
2. Die nächste Zahl steht eine Zeile tiefer und eine Spalte weiter rechts. Verläßt du dabei das Quadrat, so tauchst du an der anderen Seite wieder auf
3. Wenn das mit dem eins nach unten diagonal nicht klappt, weil da schon eine Zahl steht, dann (und nur dann) bewegst du dich einfach 2 Zeilen nach unten, ohne in der Spalte zu wechseln.

Das ziehst du durch bis zum Schluss und wenn du dich nicht vertan hast, stehen alle Zahle drin... Hier mal am Bsp. von 5x5.

Code:

11 24  7 20  3
 4 12 25  8 16
17  5 13 21  9
10 18  1 14 22
23  6 19  2 15

Das Umsetzen in Delphi dürfte ein Kinderspiel sein

[glkgereon]

also, ich hab mir das so gedacht:

als erstes wird ne eins eingetragen, dann "weitergeleitet"
wenn man wieder am anfang ist ne zwei, und so weiter...
sodass man in der ersten ebene 1-16 durch hat

für jede zahl (1-16) wird die "zweite ebene" aufgerufen, hier wird dasselbe gemacht
und immer so weiter

Edit: Ich will aber 4x4 haben! *trotz*
nee, die "aufgabenstellung" war 4x4 (keine hausaufgabe, rätsel von nem freund)

[himitsu]

> magisches Quadrat 4x4

zu magischen Quadraten mit ungerader Seitenlänge:
wenn man z.B. nach Jelly's Art rechnet, dann braucht man schon ein bissl viel Quellcode.
> http://www.buha.info/board/showthread.php?t=42053 (hier ist z.B. so ein Code)

aber wenn man sich den ursprünglichen Aufbau eines sochen einfachen MQuadrates ansieht (siehe Anhang)
und den Code wieder auf dieses zurückführt, dann benötigt man nur noch eine Schleife und eine Zuweisung.

Diesen Code hatte ich mir mal mittels Überlaufberechnung (oder wie man das nennen soll) erstellt.
(kürzer/schneller geht es eigentlich nicht mehr, es sei den man mach noch 'ne 2. Variable rein)

Delphi-Quellcode:

For i := 0 to Sqr(a) - 1 do
  StringGrid1.Cells[((i mod a - i div a) + a div 2 + a) mod a,
    (i mod a + i div a + a) mod a] := IntToStr(i + 1);

[glkgereon]

also, ich machs doch nicht rekursiv....
das is mein aktueller versuch, funzt wahrscheinlich auch, aber
erstens: muss ich einbauen das jede zahl nur einmal verwendet werden kann (wie???)
zweitens muss ich noch anner performance arbeiten (es gibt 16^16=18446744073709551616 :) )

Delphi-Quellcode:

procedure TForm1.setfield;
var i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16:integer;
begin
  for i1:=1 to 16 do
   begin
   quadrat[1,1]:=i1;
   for i2:=1 to 16 do
    begin
    quadrat[1,2]:=i2;
    for i3:=1 to 16 do
     begin
     quadrat[1,3]:=i3;
     for i4:=1 to 16 do
      begin
      quadrat[1,4]:=i4;
      for i5:=1 to 16 do
       begin
       quadrat[2,1]:=i5;
       for i6:=1 to 16 do
        begin
        quadrat[2,2]:=i6;
        for i7:=1 to 16 do
         begin
         quadrat[2,3]:=i7;
         for i8:=1 to 16 do
          begin
          quadrat[2,4]:=i8;
          for i9:=1 to 16 do
           begin
           quadrat[3,1]:=i9;
           for i10:=1 to 16 do
            begin
            quadrat[3,2]:=i10;
            for i11:=1 to 16 do
             begin
             quadrat[3,3]:=i11;
             for i12:=1 to 16 do
              begin
              quadrat[3,4]:=i12;
              for i13:=1 to 16 do
               begin
               quadrat[4,1]:=i13;
               for i14:=1 to 16 do
                begin
                quadrat[4,2]:=i14;
                for i15:=1 to 16 do
                 begin
                 quadrat[4,3]:=i15;
                 for i16:=1 to 16 do
                  begin
                  quadrat[4,4]:=i16;
                  if isCorrect
                  then ListBox1.Items.Add(getfieldstring);
                  end;
                 end;
                end;
               end;
              end;
             ProgressBar6.Position:=trunc(i11/16*100);
             Application.ProcessMessages;
             end;
            end;
           ProgressBar5.Position:=trunc(i9/16*100);
           end;
          end;
         ProgressBar4.Position:=trunc(i7/16*100);
         end;
        end;
       ProgressBar3.Position:=trunc(i5/16*100);
       end;
      end;
     ProgressBar2.Position:=trunc(i3/16*100);
     end;
    end;
   ProgressBar1.Position:=trunc(i1/16*100);
   end;
end;

so, und dann meine prüffunciton

Delphi-Quellcode:

function TForm1.isCorrect:boolean;
var
  i:integer;
  correct:boolean;
begin
  correct:=true;
  i:=0;
  while (correct) and (i<4) do
    begin
    inc(i);
    if quadrat[i,1]+quadrat[i,2]+quadrat[i,3]+quadrat[i,4]<>34
    then correct:=false;
    if quadrat[1,i]+quadrat[2,i]+quadrat[3,i]+quadrat[4,i]<>34
    then correct:=false;
    end;
  if quadrat[1,1]+quadrat[2,2]+quadrat[3,3]+quadrat[4,4]<>34
  then correct:=false;
  if quadrat[1,4]+quadrat[2,3]+quadrat[3,2]+quadrat[4,1]<>34
  then correct:=false;
  isCorrect:=correct;
end;

was kann man noch anders/besser machen?
getfieldstring gibt einfach nur die werte, durch semikolons getrennt in einem string zurück:

Delphi-Quellcode:

function TForm1.getfieldstring:string;
begin
  result:=inttostr(quadrat[1,1])+'; '+inttostr(quadrat[1,2])+'; '+inttostr(quadrat[1,3])+'; '+inttostr(quadrat[1,4])+
     '; '+inttostr(quadrat[2,1])+'; '+inttostr(quadrat[2,2])+'; '+inttostr(quadrat[2,3])+'; '+inttostr(quadrat[2,4])+
     '; '+inttostr(quadrat[3,1])+'; '+inttostr(quadrat[3,2])+'; '+inttostr(quadrat[3,3])+'; '+inttostr(quadrat[3,4])+
     '; '+inttostr(quadrat[4,1])+'; '+inttostr(quadrat[4,2])+'; '+inttostr(quadrat[4,3])+'; '+inttostr(quadrat[4,4]);
end;

[zappel]

Ein magisches Quadrat 4. Ordnung lässt sich folgendermaßen erstellen:

1. Du trägst die Zahlen in das Feld in der natürlichen Reihenfolge ein.

1 2 3 4
5 6 ...

2. Nun vertauscht du die Zahlen in den 4 Ecken mit dem jeweiligen diagonalen Gegenüber.

16 2 3 13
...

3. Das gleiche machst du mit den 4 Zahlen in der Mitte.

Es ergibt sich also folgendes mageische Quadrat:

16 2 3 13
5 11 10 8
9 7 6 12
4 14 15 1

Das System funktioniert bei allen Quadraten einer durch 4 teilbaren Ordnung in ähnlicher Weise. (Man nimmt nicht nur das eine Feld der Ecken beim Vertauschen, sondern die Ecken haben die Seitenlänge von n/4, wobei n dann die Ordnungszahl des Quadrates ist.)

Ich denke, das müsste so verständlich sein. Zumindest beim magischen Quadrat der 4. Ordnung.

[glkgereon]

damit bekomm ich aber nur 1 lösung...

ich hätte aber gerne alle

[ibp]

.. ansatzversuch...
n X n matrix


1. array[1..m]:=m mit m=n*n
2. a=1, b=n
3. summe(array[a..b])=gesuchte zahl
ja: a=a+n, b=b+n, weiter bei 3. solange b<m danach ausgabe des arrays
nein: weiter bei 4.
4. vertausche zahlen im array nach einem algorythmus der alle permutationen darstellt ( wie hab gerade noch keine ahnung schaue aber mal)
5. weiter bei 3.

[glkgereon]

deine punkte 2/3 testen obs ne gültige lösung ist (Form1.isCorrect)

die 4 is mein problem....mann könnte sagen:

x,y is nurn beispiel...

Delphi-Quellcode:

....for i:=1 to 16 do
quadrat[x,y]:= "kleinste zahl >=i die noch nicht vorkommt" (statt i)
......

aber das verschleudert wieder ressourcen, bzw verschlechtert die performance...

[zappel]

A pro pos "Performance":

Gibt es nicht 880 verschiedene magische Quadrate 4. Ordnung?

[glkgereon]

och menno, ich will sie selber rauskriegen

[ibp]

hab noch ne idee:
mit folgender prozedur bekommst du alle möglichen kombinationen von 4 elementen, die der summe entsprechen

Delphi-Quellcode:

procedure TForm1.Perm(AnzElem,summe:word);
var i1,i2,i3,i4:word;
begin
  memo1.Clear;

  for i1:=1 to AnzElem  do
    for i2:=1 to AnzElem do
      if not(i1=i2) and 
         (i1+i2<summe) then
        for i3:=1 to AnzElem do
          if not((i3=i1) or 
                 (i3=i2)) 
             and 
             (i1+i2+i3<summe) then
          for i4:=1 to AnzElem do
            if not((i4=i1) or 
                   (i4=i2) or 
                   (i4=i3)) 
               and 
               (i1+i2+i3+i4=summe) then
              memo1.Lines.Add(format('%3d + %3d + %3d + %3d = %3d',
                                     [i1,i2,i3,i4,(i1+i2+i3+i4)]));
end;

kannst du dir ja die parmutationen in ein array speichern, dann brauchst du nur noch jeweils 4 von sich verschiedene auswählen und diese zu einem quadrat kombinieren, dann mußt du nur noch auf senkrechte und diagonale prüfen!

[glkgereon]

Sooo...nach einigem überlegen, um- und neuschreiben ist nun folgender code rausgekommen:

Delphi-Quellcode:

procedure TForm1.setfield;
var i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16:integer;
begin
  for i1:=1 to 16 do begin
   quadrat[1,1]:=getunusedzahl(1,i1);
   for i2:=1 to 15 do begin
    quadrat[1,2]:=getunusedzahl(2,i2);
    for i3:=1 to 14 do begin
     quadrat[1,3]:=getunusedzahl(3,i3);
     for i4:=1 to 13 do begin
      quadrat[1,4]:=getunusedzahl(4,i4);
//vorzeitiger stop bei falscher reihe für bessere performance
      if (quadrat[1,1]+quadrat[1,2]+quadrat[1,3]+quadrat[1,4]=34) then
       begin
       for i5:=1 to 12 do begin
        quadrat[2,1]:=getunusedzahl(5,i5);
        for i6:=1 to 11 do begin
         quadrat[2,2]:=getunusedzahl(6,i6);
         for i7:=1 to 10 do begin
          quadrat[2,3]:=getunusedzahl(7,i7);
          for i8:=1 to 9 do begin
           quadrat[2,4]:=getunusedzahl(8,i8);
//s.o.
           if (quadrat[2,1]+quadrat[2,2]+quadrat[2,3]+quadrat[2,4]=34) then
            begin
            for i9:=1 to 8 do begin
             quadrat[3,1]:=getunusedzahl(9,i9);
             for i10:=1 to 7 do begin
              quadrat[3,2]:=getunusedzahl(10,i10);
              for i11:=1 to 6 do begin
               quadrat[3,3]:=getunusedzahl(11,i11);
               for i12:=1 to 5 do begin
                quadrat[3,4]:=getunusedzahl(12,i12);
//s.o.
                if (quadrat[3,1]+quadrat[3,2]+quadrat[3,3]+quadrat[3,4]=34) then
                 begin
                 for i13:=1 to 4 do begin
                  quadrat[4,1]:=getunusedzahl(13,i13);
                  for i14:=1 to 3 do begin
                   quadrat[4,2]:=getunusedzahl(14,i14);
                   for i15:=1 to 2 do begin
                    quadrat[4,3]:=getunusedzahl(15,i15);
                    for i16:=1 to 1 do begin
                     quadrat[4,4]:=getunusedzahl(16,i16);
//s.o.
                     if (quadrat[4,1]+quadrat[4,2]+quadrat[4,3]+quadrat[4,4]=34) then
                      begin
                      if (isCorrect) and (ListBox1.Items.IndexOf(getfieldstring)=-1)
                      then ListBox1.Items.Add(getfieldstring);
                      end;
                     end;
                    end;
                   end;
//status
                  Label2.Caption:=getfieldstring;
                  Application.ProcessMessages;                  
                  end;
                 end;
                end;
               end;
              end;
             end;
            end;
           end;
          end;
         end;
        end;
       end;
      end;
     end;
    end;
   end;
end;

sieht schlimm aus, isses aber nicht :wink:

hat einer noch vorschläge wies noch schneller geht?
oder wie mans doch rekursiv machen kann?

[*weg damit*] und noch was: ich hab irgendwie mal ergebnisse bis zu 20fach bekommen....
[*weg damit*] weiss einer warum? (oder war das noch ein anderer code? :gruebel: )
es war ein anderer code :mrgreen:

[dizzy]

Auf jeden Fall ist das die 20. Schachtelungstiefe :shock: das hab ich im Leben noch nicht brauchen können. Mein Maximum war bei einer recht komplexen Anwendung 9-fach...

Folgerndermaßen müsste es rekursiv gehen:

Delphi-Quellcode:

type
  TMyArray = array[1..16] of Integer;

var
  i: TMyArray;
.
.
.

procedure setfield(var arr: TMyArray; index: Integer);
begin
  if index < 17 then
  begin
    for arr[index] := 1 to 17-index do
    begin
      quadrat[1+((index-1) div 4), 1+((index+3) mod 4)] := getunusedzahl(index, arr[index]);
      setfield(arr, index+1);
    end; 
  end
  else
    if isCorrect and (ListBox1.Items.IndexOf(getfieldstring) = -1) then ListBox1.Items.Add(getfieldstring);
end;

Ist aber im Texteditor geschrieben, ungetestet, und ohne jede Kompilier-/Lauf-/Sontige Garantie :mrgreen:.
\\edit: Die Optimierungen mit den if-Abfragen fallen hier raus. Kann man bestimmt auch irgendwie machen...

[I.P.]

4x4

die 2 felder die jeweils über der mitte stehen
diametral zur mitte also asymetrisch swappen.

wenn man eine array verwendet und die Elemente nur vertauscht
so werden immer nur die zahlen drin sein die eingefüllt wurden
so entgeht man dem problem recht elegant.

was bei 4x4 geht geht auch bei 8x8 alle MOD 4 = 0 gehen so

Noch ein Tip für sowas benützt man keine Listbox sondern
wenn schon dann eine StringGrid und eine Dynamische Array
ob 1 oder 2 Dimensional hängt vom Geschmack ab ich empfehle
aber eine 1 Dimensionale Hauptarray und eine 2 D Array um
zbs. obere und untere Hälfte des Quadrates zu teilen.

Ich erstelle gerade ein Delphi Tool mit dem man alle
Ordnungen dieser Quadrate erstellen und dann weitere mittels
optimierten Algorythmen suchen kann.

Sollte einer denken das er mittels Bruteforce also wie hier irgendwo steht
mittels alle permutationen suchen usw. was machen kann der irrt es ist sinnlos
ab Ordnung 5 findet man so nichts mehr ohne speziell optimierten für die jeweilige
Ordnung gemachten Algorythmen.