Задача такая: дано парное число N, нужно построить "магический квадрат" порядка N, то есть N и есть длина стороны квадрата. "Магическим квадратом" считается такой квадрат, в который вписаны числа от 1 до N*N по одному разу каждое, причём сумма чисел по всем вертикалям, горизонталям и главным диагонялям одинаковая.
пример:
N=4
1 15 14 4
12 6 7 9
8 10 11 5
13 3 2 16

N=6
36 32 4 3 5 31
12 29 27 10 26 7
19 17 22 21 14 18
13 20 16 15 23 24
25 11 9 28 8 30
6 2 33 34 35 1

Есть готовый алгоритм на Паскале, время выполнения приемлемое, но проблема в том, что максимально можно высчитать квадрат для N=180, если больше, то 'Stack Overflow error'.

Может кто знает более эффективный алгоритм? (желательно на Паскале)

BullDogg
Можно код посмотреть ?
Я думаю там память выделяется на стеке , а можно выделить в heap.
В паскале вроде CreateNew (???)
Тьфу , блин , это в Delphi. А позволяет ли "чистый" Паскаль выделять память в куче (heap)

Тут ИМХО дело не в памяти на стеке (GetMem и New вроде как выделяют в куче), а в переполнении стека во время рекурсии (пусть местные алгоритмисты расскажут, как решить данную задачу итеративно и будет ли это проще, чем рекурсия+backtracking ). Соответственно, если Паскаль - это TP/BP, попытаться увеличить стек.

Рекурсивную задачу всегда можно решить итеративно (хотя бы самостоятельно изображая стек). Обычон итеративное решение много сложнее рекурсивного (в разы, но не в десятки раз). В TP/BP было выделение памяти в куче.

Вот код процедуры. При стандартных настройках Паскаля переполнение стека происходит при N=88, если поставить максимально возможный стек (Options -> Memory sizes... -> Stack Size), тогда результаты можно получать до N=180.



program msquares;
uses crt;
const mn=88
var p:boolean;
f_in,f_out:text;
er1,n:integer;
Sk:real;

procedure magic_square(n:longint);
var i,j,k,s,t,b,r,m:integer;
a:array[1..mn,1..mn] of integer;
begin
p:=true; {default value}
if n>mn then
begin
writeln('Slishkom bolshoi parametr!');
exit
end;
if n mod 2=1 then {n neparnoje chislo}
begin
writeln('Nevernij parametr');
exit
end
else
if n mod 4=0 then
begin k:=1;
for i:=1 to n do
for j:=1 to n do
begin a[i,j]:=k; inc(k)
end;
j:=2; m:=n div 2;
for i:=1 to m do
for k:=1 to m div 2 do
begin if j=m+1 then j:=2 else
if j=m+2 then j:=1;
s:=n-i+1; b:=n-j+1;
t:=a[i,j]; a[i,j]:=a[s,b]; a[s,b]:=t;
t:=a[i,b]; a[i,b]:=a[s,j]; a[s,j]:=t;
j:=j+2;
end;
end
else if n<>2 then
begin k:=1;
for i:=1 to n do
for j:=1 to n do
begin a[i,j]:=k; inc(k)
end;
r:=(n div 2 -1) div 2; m:=n div 2;
{1st type change}
for i:=1 to m do
begin j:=i;
for k:=1 to r do
begin if j>m then j:=1;
s:=n-i+1; b:=n-j+1;
t:=a[i,j]; a[i,j]:=a[s,b]; a[s,b]:=t;
t:=a[i,b]; a[i,b]:=a[s,j]; a[s,j]:=t;
inc(j)
end;
end;
{2nd type change}
i:=1; j:=r+1;
for k :=1 to m do
begin if j>m then j:=1;
s:=n-i+1; t:=a[i,j];
a[i,j]:=a[s,j]; a[s,j]:=t;
inc(i); inc(j)
end;
{3rd type change}
i:=1; j:=r+2;
for k:=1 to m do
begin if j>m then j:=1;
b:=n-j+1;
t:=a[i,j]; a[i,j]:=a[i,b]; a[i,b]:=t;
inc(i); inc(j)
end;
end else p:=false;
if p then
begin
Sk:= ( (1+(n*n))*n )/2;
writeln(f_out,'Magicheskaja summa: ',Sk:3:0);
for i:=1 to n do
begin
for j:=1 to n do
write(a[i,j],' ');
end;
end else
begin
writeln('Magicheskij kvadrat so storonoi 2 ne suschestvujet!');
end

end;

Все ясно... Динамическая память вылечит это дело...

До функции расчета магических квадратов нужно написать нечто вроде этого:

type
subarray = array[1..mn] of longint;
subptr = ^subarray;
var
i: longint;
a = array [1..mn] of subptr;


В основной программе в самом начале нужно добавить эти строки:
for i := 1 to mn do
GetMem(a[i], sizeof(subarray));

В функции расчета нужно убрать локальное определение a и заменить все обращения к a[xxx,yyy] на a[xxx]^[yyy]

По-хорошему, в конце программы должен быть еще цикл
for i:= 1 to mn do
FreeMem(a[i]);

В первый раз забыл - все integer в программе заменить на longint!!!

Еще одно замечание: необходимо в опциях компилятора или в программе через опцию $M указать достаточное количество динамической памяти (максимум - чуть больше 2*mn*mn)