Заполнение массива по спирали Опции

[Alexdel]

Всем привет! требуется написать прогу для заполнения прямоугольной таблицы размерами n*n по спирали числами от 1 до n*n. Я вот тут кое-что написал но работает не так, как надо... Мозги уже кипят... Помогите плиз кто чем может... Хотя бы намёк сделайте=)

[RathaR]

Забавно
Буквально вчера, сидел в кабинете информатики, пересматривал задания старых олимпиад, и наткнулся на первую(!) олимпиаду по программированию, что проводились у нас, год точно не скажу, девяносто какой то, так это была первая задача в той олимпиаде))) Просто ради интереса сел, сделал её, за урок, правда там матрица прямоугольная была.
Вот, собственно, мое решение, особо долго не думал над ней(просто обходил матрицу определяя куда ставить след номер)...

const
        max_size=10;

type
        tMove=(up,down,left,right);
var
        m,n:integer;
        A:array[0..max_size+1,0..max_size] of integer;
        I:integer;
        K:integer;
        x,y:integer;

procedure Input(var x,y:integer);
var
        F1:text;
begin
assign(F1,'spiral.dat');
reset(F1);
read(F1,N,M);
close(F1);
end;

procedure Output;
var
        I,J:integer;
        F2:text;
begin
assign(F2,'spiral.sol');
rewrite(F2);
for I:=0 to m+1 do
  begin
  for J:=0 to n+1 do
    write(F2,A[I,J]:3);
  writeln(F2);
  end;
close(F2);
end;
function move(x,y:integer):tMove;
var
        left_z,right_z,up_z,down_z:boolean;
begin
if A[x+1,y]=0 then right_z:=true else right_z:=false;
if A[x-1,y]=0 then left_z:=true else left_z:=false;
if A[x,y+1]=0 then down_z:=true else down_z:=false;
if A[x,y-1]=0 then up_z:=true else up_z:=false;
if right_z and not down_z then move:=right;
if left_z and not up_z then move:=left;
if up_z and not right_z then move:=up;
if down_z and not left_z then move:=down;
end;

begin
Input(m,n);
fillchar(A,sizeof(A),0);
for I:=0 to N+1 do
  begin
  A[0,I]:=-1;
  A[M+1,I]:=-1;
  end;
for I:=0 to M+1 do
  begin
  A[I,0]:=-1;
  A[I,N+1]:=-1;
  end;

K:=1;
x:=m;
y:=1;
A[x,y]:=K;
while K<>m*n do
begin
case move(x,y) of
  right:begin
        inc(K);
        inc(x);
        A[x,y]:=K;
  end;
  left:begin
        inc(K);
        dec(x);
        A[x,y]:=K;
  end;
  up:begin
     inc(K);
     dec(y);
     A[x,y]:=K;
  end;
  down:begin
       inc(K);
       inc(y);
       A[x,y]:=K;
  end;   end;
end;
Output;
end.

Заядло я её не тестировал, но вроде работает, файлы прикрепляю.

Сообщение отредактировано: RathaR - 10.02.2010 19:34

[Lapp]

сел, сделал её, за урок, правда там матрица прямоугольная была.

За урок такое сделать - респект!

Rathar, идея твоя интересная. Я ее реализовал тут.. Вот, что вышло:

const
  max= 20;
var
  a: array[1..max, 1..max] of integer;
  m,n,i,j,di,dj,b,k: integer;
begin
  FillChar(a,SizeOf(a),0);  // инициализация, вставлено позже
  k:=1;
  write('введите количество строк (не больше ',max,'): ');
  ReadLn(m);
  write('введите количество столбцов (не больше ',max,'): ');
  ReadLn(n);
  k:=1;
  i:=1;
  j:=1;
  di:=0;
  dj:=1;
  repeat
    a[i,j]:=k;
    Inc(k);
    if (i+di>m)or(i+di<1)or(j+dj>n)or(j+dj<1)or(a[i+di,j+dj]>0) then begin
      b:=dj;
      dj:=-di;
      di:=b
    end;
    i:=i+di;
    j:=j+dj;
  until a[i,j]>0;

  for i:=1 to m do begin
    for j:=1 to n do Write(a[i,j]:5);
    WriteLn
  end;
  readln;
end.

Тут главное - что для смены направления не нужно знать направление. Формулы предельно просты:
di = dj
dj = -di
Проверь их.


Сообщение отредактировано: Lapp - 11.02.2010 14:51