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

[Флогримм]

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

Код

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.

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

[Флогримм]

кто может предложить другой алгоритм, а то мне че-то в голову ничего кроме этого не лезет...

[volvo]

кто может предложить другой алгоритм, а то мне че-то в голову ничего кроме этого не лезет...

Ну, держи

Код

const
 max_n = 19;
type
 matrix = array[1 .. max_n, 1 .. max_n] of integer;
var
 matr: matrix;
const
 next: integer = 1;

function incr(var x: integer): integer; far;
 begin incr := x; inc(x); end;
function decr(var x: integer): integer; far;
 begin decr := x; dec(x); end;

procedure make_square(start, count: integer);
 var i, j, k: integer;
 begin
   i := start; j := start;
   for k := 1 to count do
     matr[i, incr(j)] := incr(next);
   dec(j); inc(i);

   for k := 1 to pred(count) do
     matr[incr(i), j] := incr(next);
   dec(i); dec(j);

   for k := 1 to pred(count) do
     matr[i, decr(j)] := incr(next);
   inc(j); dec(i);

   for k := 1 to pred(pred(count)) do
     matr[decr(i), j] := incr(next);
 end;

var n, center, i, j: integer;
begin
 repeat
   write('n = '); readln(n)
 until (n <= max_n) and (n > 0) and (odd(n));

 center := Succ(n div 2);
 matr[center, center] := incr(next);

 for i := center - 1 downto 1 do
   make_square(i, Succ(2 * (center - i)) );

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