magisches quadrat, brauch ne idee...

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