Хитромудрое заполнение матрицы, придумают же... :) Опции

[Флогримм]

кто какой предложит алгоритм? вот мой:

Код

program pseudospiral;
{
программа, заполняющая матрицу следующим образом:
10 11 12 13 14
25  2  3  4 15
24  9  1  5 16
23  8  7  6 17
22 21 20 19 18
}
uses crt;

const max=20;       {максимальная размерность матрицы; n<=max}

var matr          :array[1..max,1..max] of byte;
   i,j,n,c       :byte;


function Free(a,b:byte):boolean; {проверяет на существование и пустоту ячейку matr[a,b]}
begin
 Free:= (a>0)    and (b>0)    and
    (a<=max) and (b<=max) and
    (matr[a,b]=0);
end;

BEGIN
ClrScr;

repeat
write('Введите нечетную размерность квадратной матрицы: ');
readln(n);
until (n<=max) and (n>0) and (odd(n));
writeln;

matr[(n div 2)+1,(n div 2)+1]:=1;
i:=n div 2; j:=n div 2; matr[i,j]:=2;

for c:=3 to sqr(n) do begin
 if (Free(i-2,j-1))   and
    (not Free(i+1,j)) and
    (not Free(i-1,j)) then
 begin
   dec(i,2); dec(j); matr[i,j]:=c;     {перескок}
 end else
 if (Free(i,j-1)) and
    (not Free(i-1,j)) then
 begin
   dec(j); matr[i,j]:=c;               {<-}
 end else
 if (Free(i+1,j)) and
    ((not Free(i-1,j)) or
     (not Free(i,j-1))) and
     (j-1>0) then
 begin
   inc(i); matr[i,j]:=c;               {\/}
 end else
 if  Free(i,j+1) then
 begin
   inc(j); matr[i,j]:=c;
 end
     else                              {->}
 if  Free(i-1,j) then
 begin
   dec(i); matr[i,j]:=c;
 end;
                                       {/\}
end;

for i:=1 to n do begin
 for j:=1 to n do write(matr[i,j]:4);
 writeln;
end;
readln;

END.

вам может показаться громоздким и неэффективным... но мне нравится