Quadrado Mágico - Parte 1

Irei publicar uma série de postagens sobre algoritmos para resolução dos Quadrados Mágicos. A postagem de hoje é bem simples e tem algumas limitações (por exemplo, só aceita quadrados de grau 3). Mas minha intenção é justamente essa: pegar o algoritmo e ir tornando-o mais complexo e mais genérico. No futuro, tentarei adaptar esse algoritmo para resolução de outro quebra-cabeças que gosto muito: SUDOKU. Mas vamos ao que interessa, que é o código do programa. Desenvolvi em Delphi, mas ele é simples e facilmente adaptável a outras linguagens:

{$APPTYPE CONSOLE}
program qm;

uses
SysUtils, Windows, Dialogs, Math, Forms;

const
GRAU  = 3;  // Grau do quadrado
GRAU2 = GRAU*GRAU;  // Total de elementos do quadrado                             
TOTAL = (((1 + GRAU2) * GRAU2) div 2) div GRAU; // Soma total a ser alcançada

type
  TAQuad = array[1..GRAU2] of integer;  // Tipo Quadrado

var
  q: TAQuad;
  limite: int64;
      
// --------------------------------------------------------
// Mostra o resultado na tela
// --------------------------------------------------------
procedure Show();
var
  lin, col: integer;
  pos: integer;
begin;
  pos := 0;
  for lin := 1 to GRAU do begin
    for col := 1 to GRAU do begin
      inc(pos);
      Write(q[pos]:4);
    end;
    Writeln;
  end;
end;


// --------------------------------------------------
// avalia meta
// --------------------------------------------------
function goal(): boolean;
var
  x, y: integer;
  px, py, dp, ds: integer;
  sl, sc: array[1..GRAU] of integer;

begin      
  result := false;

  FillChar(sl, sizeof(sl), 0);
  FillChar(sc, sizeof(sc), 0);

  dp := 0;
  ds := 0;

  px := 1;
  py := GRAU;

  for x := 1 to GRAU do begin
    // soma diagonais
    inc(dp, q[px]);
    inc(ds, q[py]);
    inc(px, succ(GRAU));
    inc(py, pred(GRAU));

    // soma linhas e colunas
    for y := 1 to GRAU do begin
     inc(sl[y], q[GRAU * pred(x) + y]);
     inc(sc[y], q[GRAU * pred(y) + x]);
    end;
  end;

  // verifica se cada linha e coluna são válidas
  for x := 1 to GRAU do
    if (sl[x] <> TOTAL) or (sc[x] <> TOTAL) then exit;

  // verifica se as diagonais são válidas
  if (dp <> TOTAL) or (ds <> TOTAL) then exit;

  result := true;
end;



// --------------------------------------------------
// retorna próximo número
// --------------------------------------------------
function next(n: int64): int64;
var
  i:   integer;
  s:   string;
  erro: boolean;
  rep:  TAquad;

begin         
  repeat
    inc(n);

    // transforma o número em string
    s := inttostr(n);

    // inicialmente, não tem erro
    erro := false;

    // inicializa array de repetições
    FillChar(rep, sizeOf(rep), 0);

    // não permite números repetidos
    for i := 1 to GRAU2 do begin
      // não permite zeros
      if s[i] = '0' then begin
        erro := true;
        break;
      end;      

      // joga o número para o array
      q[i] := ord(s[i])-48;

      // conta número de repetições
      inc(rep[q[i]]);

      // verifica se repetiu o número
      if rep[q[i]] > 1 then begin
        erro := true;
        break;
      end;  
    end;
 
    // erro encontrado, avança para o próximo número
    if erro then continue;

    // sai do laço
    break;
  until n > limite;// executa no máximo até o limite de 10^GRAU2-1

  result := n;
end;



// --------------------------------------------------
// Rotina principal
// --------------------------------------------------
var
  inicio: int64;
  n:   int64;

begin
  // início do processamento
  inicio := GetTickCount;   

  // primeiro número válido
  n := round(power(10, GRAU2-1)) - 1;

  // útimo número válido
  limite := round(power(10, GRAU2)) - 1;       

  // laço principal
  repeat
    //Processa mensagens pendentes do Windows
    Application.ProcessMessages;

    // próximo número a ser testado
    n := next(n);

    // verifica se atingiu a meta
    if goal() then begin    
      show(); // mostra o quadrado
      break;
    end;
  until n > limite;// executa no máximo até o limite de 10^GRAU2-1

  // mostra o tempo de processamento
  writeln('Tempo (s): ' + inttostr((GetTickCount - inicio) div 1000));
  readln;
end.