program MagicSquares;

{ Borland Pascal 7.

  An example solution to the magic squares question from the
  1995 British Informatics Olympiad.

  See the end of this file for copyright notice and disclaimer. }

{-------------------- The Problem ------------------------} {

Write a program to find n by n magic squares for a given n.
A magic square is defined as having all rows and all columns
sum to the same total.

}
{-------------------- The Solution -----------------------}

{ Simplistic exhaustive search, grows as (n^2)!. }
   
{ Data type used to represent the grid.  Unallocated places
within the nxn part of the grid that is used are marked with
zeros to give a simple test of whether a partial solution
is valid by adding up the row and column whenever an
insertion is made.
}

type
  Tgrid = array[1..10, 1..10] of Integer;

var
  n,                { grid size }
  n2,               { n squared }
  tot,              { total sum of all elements }
  line: Integer;    { required sum of any row or column }
  grid: Tgrid;

procedure Setup;
var i,j: Integer;
begin
  Write('Enter number n:');
  ReadLn(n);
  n2 := n * n;
  tot := n2 * (n2 + 1) div 2;
  line := tot div n;
  for i := 1 to n do for j := 1 to n do grid[1,j] := 0;
end;

{ for simplicity, places are given an index from 1 to n^2,
  which must be decoded by the following functions. }

function Col(p: Integer): Integer;
begin
  Col := ((p - 1) mod n) + 1;
end;

function Row(p: Integer): Integer;
begin
  Row := ((p - 1) div n) + 1;
end;

function CanPlace(p: Integer; var grid: Tgrid): Boolean;
begin
  CanPlace := grid[Row(p), Col(p)] = 0;
end;

{ This function adds the number and then checks that the
  board is still OK by adding up the row and column - a
  simple but effective optimisation. }

function ValidPlace(p, i: Integer; var grid: Tgrid): Boolean;
var
  k, s: Integer;
  Valid, InEq: Boolean;
begin
  Valid := True;
  grid[Row(p), Col(p)] := i;
  InEq := False;
  s := 0;
  for k := 1 to n do
  begin
    if grid[k, Col(p)] = 0 then
      InEq := True
    else
      s := s + grid[k, Col(p)];
  end;
  { flag as invalid if the total exceeds the requirements }
  Valid := Valid and
    ((InEq and (s < line)) or ((not InEq) and (s = line)));
  InEq := False;
  s := 0;
  for k := 1 to n do
  begin
    if grid[Row(p), k] = 0 then
      InEq := True
    else
      s := s + grid[Row(p), k];
  end;
  Valid := Valid and
    ((InEq and (s < line)) or ((not InEq) and (s = line)));
  if not Valid then
    grid[Row(p), Col(p)] := 0;
  ValidPlace := Valid;
end;

procedure OutGrid(var grid: Tgrid); { prints the grid }
var i,j: Integer;
begin
  for i := 1 to n do
  begin
    for j := 1 to n do Write(grid[i, j]:3);
    WriteLn;
  end;
  WriteLn;
end;

{ The backtracking procedure which finds the magic squares. }
{ This procedure calls itself to place the next number, trys
  all possible places, is started from 16 and uses ValidPlace
  for optimisation. }

procedure Place(i: Integer; var grid: Tgrid);
var
  p: Integer;
  agrid: Tgrid;
begin
  if i > 0 then
    for p := 1 to n2 do
    begin
      if CanPlace(p, grid) then
      begin
        agrid := grid;
        if ValidPlace(p, i, agrid) then
          Place(i - 1, agrid);
      end;
    end
  else
    { all grids found are output - there will be many for n > 3 }
    OutGrid(grid);
end;

begin
  Setup;
  Place(n2, grid);
end.
{ END OF EXAMPLE SOLUTION TO BIO 1995 ROUND ONE QUESTION TWO }
{ Program copyright (c) 1997 The British Informatics Olympiad (BIO).

  This program may be freely copied by persons or organisations
  involved in the British Informatics Olympiad or the International
  Olympiad in Informatics, on condition that no changes are made and
  this notice is not altered. Distribution for profit is forbidden
  unless permission is first obtained in writing from the BIO.

  This program is for educational purposes only and comes with no
  warranty, implied or otherwise, as to its fitness for any purpose.

  Author:   Antony Rix
  Internet: http://www.christs.cam.ac.uk/bio/
  E-mail:   a.rix@lineone.net
  S-mail:   The British Informatics Olympiad
            Christ's College
            Cambridge CB2 3BU
            United Kingdom
}