Zauberquadrat ermitteln

[Schokohase]

Das nennt sich Permutation und eben nicht Kombination (Kombinatorik).

Statt alles irgendwie zu durchlaufen und dann auf eine gültige Permutation zu prüfen, kann man auch direkt die Permutationen erzeugen lassen, was erheblich schneller geht.

Ein Beipiel:

Delphi-Quellcode:

program Project1;

{$APPTYPE CONSOLE}
{$R *.res}

uses
  System.SysUtils, System.Generics.Collections;

type
  TArray = class abstract( System.Generics.Collections.TArray )
  private
    class procedure InternalPermute<T>( const Values: TArray<T>; const Current: TArray<T>; const Callback: TProc < TArray < T >> );
  public
    class procedure Permute<T>( const Values: TArray<T>; const Callback: TProc < TArray < T >> );
  end;

  { TArray }

class procedure TArray.InternalPermute<T>( const Values: TArray<T>; const Current: TArray<T>; const Callback: TProc < TArray < T >> );
var
  validx:                  Integer;
  nextValues, nextCurrent: TArray<T>;
begin
  if Length( Values ) = 0
  then
    Callback( Current )
  else
    begin
      for validx := Low( Values ) to High( Values ) do
        begin
          SetLength( nextValues, Length( Values ) );
          TArray.Copy<T>( Values, nextValues, Length( Values ) );
          Delete( nextValues, validx, 1 );
          nextCurrent := Current + [Values[validx]];

          InternalPermute( nextValues, nextCurrent, Callback );
        end;
    end;
end;

class procedure TArray.Permute<T>( const Values: TArray<T>; const Callback: TProc < TArray < T >> );
begin
  InternalPermute<T>( Values, [], Callback );
end;

function IsMagicSquare( const Values: TArray<Integer> ): Boolean;
var
  v:     Integer;
  size:  Integer;
  row:   Integer;
  col:   Integer;
  csums: TArray<Integer>;
  rsums: TArray<Integer>;
  dsums: TArray<Integer>;
begin
  size := Round( Sqrt( Length( Values ) ) );
  if size * size <> Length( Values )
  then
    raise Exception.Create( 'Fehlermeldung' );

  SetLength( rsums, size );
  SetLength( csums, size );
  SetLength( dsums, 2 );

  dsums[0] := 0;
  dsums[1] := 0;

  for row := 0 to size - 1 do
    begin
      v := Values[row * size + row];
      Inc( dsums[0], v );
      v := Values[row * size + size - 1 - row];
      Inc( dsums[1], v );
      rsums[row] := 0;
      csums[row] := 0;
      for col    := 0 to size - 1 do
        begin
          v := Values[row * size + col];
          Inc( rsums[row], v );
          v := Values[col * size + row];
          Inc( csums[row], v );
        end;
    end;

  if dsums[0] <> dsums[1]
  then
    Exit( false );

  for row := 0 to size - 1 do
    if ( rsums[row] <> dsums[0] ) or ( csums[row] <> dsums[0] )
    then
      Exit( false );

  Result := True;
end;

procedure WriteSquare( const Values: TArray<Integer> );
var
  size:     Integer;
  row, col: Integer;
begin
  size := Round( Sqrt( Length( Values ) ) );
  if size * size <> Length( Values )
  then
    raise Exception.Create( 'Fehlermeldung' );

  for row := 0 to size - 1 do
    begin
      for col := 0 to size - 1 do
        begin
          Write( Values[row * size + col], ' ' );
        end;
      WriteLn;
    end;
end;

var
  counter, cmagic: Integer;

begin
  try
    counter := 0;
    cmagic  := 0;
    TArray.Permute<Integer>( [1, 2, 3, 4, 5, 6, 7, 8, 9],
        procedure( v: TArray<Integer> )
      begin
        Inc( counter );

        if IsMagicSquare( v )
        then
          begin
            Inc( cmagic );
            WriteSquare( v );
            WriteLn;
          end;
      end );
    WriteLn( counter, ' - ', cmagic );
  except
    on E: Exception do
      WriteLn( E.ClassName, ': ', E.Message );
  end;
  ReadLn;

end.

Eine Zeitmessung ist quasi überflüssig, denn das Ergebnis ist quasi sofort da.

Code:

2 7 6
9 5 1
4 3 8

2 9 4
7 5 3
6 1 8

4 3 8
9 5 1
2 7 6

4 9 2
3 5 7
8 1 6

6 1 8
7 5 3
2 9 4

6 7 2
1 5 9
8 3 4

8 1 6
3 5 7
4 9 2

8 3 4
1 5 9
6 7 2

362880 - 8