Magic Square Maker - Free Pascal version

{ Magic Square Maker }
{ The use of artifitial inteligence for the discovery of magic squares}
{ Free Pascal Source }
program MSMFPC;
{ created by Joao Paulo Schwarz Schuler }
{ http://www.schulers.com/jpss/pascal/msmfpc.htm }

{ interface }

{ CHANGE THIS LINE \/  \/  \/  \/  \/  \/ }
const GRAU = 5;     { DIMENSION }
{ CHANGE THIS LINE  /\  /\  /\  /\  /\  /\ }

const CGRAU2= ((GRAU)*(GRAU-1)) div 2;
const GRAU2 = GRAU*GRAU;
const NTROCA= (GRAU2*(GRAU2-1)) div 2;
const TOTLIN = (((1+GRAU2)*GRAU2) div 2) div GRAU;

const QueroArq = false;

type TAQUAD = array[1..GRAU2] of word;

type TTROCA = record
               A:word;
               B:word;
             end;

type TATROCA = array[1..NTROCA] of TTROCA;

type TALTROCA = array[1..CGRAU2] of TTROCA;

type TQUAD = object                    { Magic Square Class }
                FOUND:boolean;
                QUAD:TAQUAD;        {square} 
                TROCA:TATROCA;
                LTROCA:TALTROCA;
                CICLOS:longint;     {cicles }
                NFOUND:longint;
                WantQuit:boolean;

                constructor Init;
                destructor Done;

                procedure Mostra;   { show }
                procedure Gera(var Q:TAQUAD); {generate a square }
                procedure PTroca(var Q:TAQUAD;N:longint);  {exchange cells}
                procedure Run;
                procedure Try03;
              end;


{ implementation }

  function EvalQuad(Q:TAQUAD):longint;
  var COUNT,COUNT2:word;
      POS,POS2:word;
      SOMLIN,SOMCOL: array[1..GRAU] of longint;
      COLPRIN,COLSEC:longint;
      DIFTOTAL:longint;
  begin
  DIFTOTAL:=0;

  for COUNT:=1 to GRAU do
      begin
      SOMLIN[COUNT]:=0;
      SOMCOL[COUNT]:=0;
      end;

  COLPRIN:=0;
  COLSEC:=0;

  for COUNT:=1 to GRAU do  { soma linhas e colunas }
      for COUNT2:=1 to GRAU do
          begin
          SOMLIN[COUNT2]:=SOMLIN[COUNT2]+Q[GRAU*pred(COUNT )+COUNT2];
          SOMCOL[COUNT2]:=SOMCOL[COUNT2]+Q[GRAU*pred(COUNT2)+COUNT ];
          end;

  POS:=1;
  POS2:=GRAU;

  for COUNT:=1 to GRAU do   {soma diagonais}
      begin
      COLPRIN:=COLPRIN+Q[POS];
      COLSEC:=COLSEC+Q[POS2];
      POS:=POS+succ(GRAU);
      POS2:=POS2+pred(GRAU);
      end;

  DIFTOTAL:=abs(COLPRIN-TOTLIN)+abs(COLSEC-TOTLIN);

  for COUNT:=1 to GRAU do
      DIFTOTAL:=DIFTOTAL+abs(TOTLIN-SOMLIN[COUNT])+
                         abs(TOTLIN-SOMCOL[COUNT]);


  EvalQuad:=DIFTOTAL;
  end; { of procedure }


  constructor TQUAD.Init;
  var COUNT,COUNT2:longint;
      POS:longint;
  begin
  WantQuit:=false;
  Writeln('Output:');
  Writeln('Dimension(Grau):',GRAU);
  Writeln('Cells:(Celulas):',GRAU2);
  Writeln('Level 1(Nivel 1):',NTROCA);
  Writeln('Sum(Total por linha):',TOTLIN);
  CICLOS:=0;
  NFOUND:=0;
  Randomize;
  POS:=0;
  for COUNT:=1 to GRAU2 do  {gera tabela de trocas}
      for COUNT2:=succ(COUNT) to GRAU2 do
          begin
          inc(POS);
          TROCA[POS].A:=COUNT;
          TROCA[POS].B:=COUNT2;
          end;
  Gera(QUAD);
  Writeln('--------------------------------------');

  POS:=0;
  for COUNT:=1 to GRAU do
      for COUNT2:=succ(COUNT) to GRAU do
          begin                       { combinations }
          inc(POS);
          LTROCA[POS].A:=COUNT;
          LTROCA[POS].B:=COUNT2;
          end;

  end;

  destructor TQUAD.Done;
  begin
  end;

  procedure TQUAD.Gera(var Q:TAQUAD);
  var COUNT:longint;
  begin;
  for COUNT:=1 to GRAU2 do
      Q[COUNT]:=COUNT;
  for COUNT:=1 to NTROCA do
      PTROCA(Q,succ(round(random(NTROCA))));
  end;

  procedure TQUAD.Mostra;
  var COUNT,COUNT2:longint;
      POS:longint;
  begin;
  POS:=0;
  for COUNT:=1 to GRAU do
      begin
      for COUNT2:=1 to GRAU do
          begin
          inc(POS);
          Write(QUAD[POS]:4);
          end;
      Writeln;
      end;
  {Application.ProcessMessages;}
  end;

  procedure TQUAD.PTroca(var Q:TAQUAD;N:longint);
  var AUX:word;
  begin;
  AUX:=Q[TROCA[N].A];
  Q[TROCA[N].A]:=Q[TROCA[N].B];
  Q[TROCA[N].B]:=AUX;
  end;

  procedure TQUAD.Try03;
  var USE:TAQUAD;
      OLDEVAL,EVAL:longint;
      COUNT,COUNT3:longint;
      BESTPOS1,BESTEVAL:longint;
      ATUAL1:longint;
      MAX:longint;
      LA:boolean; {local achei}
  begin
  BESTPOS1:=1;
  BESTEVAL:=NTROCA{EvalQuad(QUAD)};
  OLDEVAL:=EvalQuad(QUAD);{BESTEVAL;}
  EVAL:=OLDEVAL;
  USE:=QUAD;
  COUNT:=0;
  LA:=false;
  MAX:=round(NTROCA/1.5);
  while (COUNT<MAX) and not(LA) do
      begin
      inc(COUNT);
      USE:=QUAD;
      ATUAL1:=succ(round(random(NTROCA)));
      PTROCA(USE,ATUAL1);        {troca}
      EVAL:=EvalQuad(USE);
      if EVAL<=BESTEVAL then
         begin
         BESTEVAL:=EVAL;
         BESTPOS1:=ATUAL1;
         end; { of if}

      if EVAL<=OLDEVAL then
         LA:=true;
      end;{ of FOR }

  PTROCA(QUAD,BESTPOS1);
  if Random(100)>8 then
        begin
        {Application.ProcessMessages;}
        {writeln(BESTEVAL);}
        end;

  if BESTEVAL=0 then
     begin
     inc(NFOUND);
     writeln;
     writeln('achei quadrado magico:',NFOUND);
     MOSTRA;
     Gera(Quad);
     end;
  end;


  procedure TQUAD.Run;
  var Count:longint;
  begin
  Count:=0;
  while not(WantQuit) do
      begin
      Try03;
      end;
  end;


 var MS:TQUAD;  { Magic Square Object }

begin
  MS.Init;
  MS.Run;
  MS.Done;
end.