Zauberquadrat ermitteln

[Amateurprofi]

So vielleicht?
Ist recht langsam, scheint aber zu funktionieren.
Wenn du es laufen lässt: Nicht die Geduld verlieren, braucht ein paar Sekunden.

Meines Wissens gibt es für die Kantenlänge 3 insgesamt 8 Lösungen, eigentlich nur eine, die anderen sind Spiegelungen / Drehungen.
Für andere Kantenlängen brauchst Du nur die Konstante "Size" ändern. Aber dann dauert es richtig lange.

Delphi-Quellcode:

PROCEDURE GetMagicSquares;
const
   Size=3;
   Numbers=Size*Size;
   RowSum=(1+Numbers)*Numbers div 2 div Size;
var
   Combi:Array[0..Numbers-1] of Byte;
   Square:Array[0..Size-1,0..Size-1] of Byte absolute Combi;
FUNCTION NextCombi:Boolean;
var I,J:Integer;
begin
   for I:=High(Combi) downto 0 do
      if Combi[I]<Numbers then begin
         Inc(Combi[I]);
         for J:=I+1 to High(Combi) do Combi[J]:=1;
         Exit(True);
      end;
   Result:=False;
end;

FUNCTION CheckCombi:Boolean;
var I:Integer; Entries:Set of 1..Numbers;
begin
   Entries:=[];
   for I:=High(Combi) downto 0 do Include(Entries,Combi[I]);
   Result:=Entries=[1..Numbers];
end;

FUNCTION CheckMagic:Boolean;
var I,J,RSum,CSum,D1Sum,D2Sum:Integer;
begin
   D1Sum:=0;
   D2Sum:=0;
   for I:=0 to Size-1 do begin
      Inc(D1Sum,Square[I,I]);
      Inc(D2Sum,Square[I,Size-1-I]);
      RSum:=0;
      CSum:=0;
      for J:=0 to Size-1 do begin
         Inc(RSum,Square[I,J]);
         Inc(CSum,Square[J,I]);
      end;
      if (RSum<>RowSum) or (CSum<>RowSum) then Exit(False);
   end;
   Result:=(D1Sum=RowSum) and (D2Sum=RowSum);
end;

PROCEDURE WriteSquare(var F:TextFile; Count:Integer);
var R,C:Integer; S:String;
begin
   S:=IntToStr(Count)+') ';
   for R:=0 to Size-1 do begin
      for C:=0 to Size-1 do S:=S+IntToStr(Square[R,C])+' ';
      if R<Size-1 then S:=S+'- ';
   end;
   Writeln(F,S);
end;

var I,Count:Integer; F:TextFile; Dsn:String;
begin
   Dsn:=ExtractFilePath(ParamStr(0))+'MagicalSquares_'+IntToStr(Size)+'.txt';
   AssignFile(F,Dsn);
   Rewrite(F);
   Count:=0;
   for I:=0 to High(Combi) do Combi[I]:=I+1;
   while NextCombi do
      if CheckCombi then
         if CheckMagic then begin
            Inc(Count);
            WriteSquare(F,Count);
         end;
   CloseFile(F);
   ShowMessage('Datei "'+Dsn+'" erstellt, '+IntToStr(Count)+' Lösungen.');
end;