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