проблема с задачей

[sasha1993]

во входном фойле одно число - размер квадратной матрицы
необходимо заполнить эту матрицу Спиралью.
Допустим если дано число 5 ,результат должен быть таким
1 2 3 4 5
16 17 18 19 6
15 24 25 20 7
14 23 22 21 8
13 12 11 10 9
между числами может быть любое количество пробелов.

Я уже придумал 2 робочих программы ,но они выполняются слишком долго...

1) просто в цыкле увеличивать число на 1 каждый раз и записывать его в нужный элемент двухмерного массива,а потом просто вывести массив.

2)почти так само,но числа в масив записывал сразу с четырех сторон...

хотя вторая задача почти в 4 раза быстрее этого не достаточно
пожалуйста подскажите как решать эту задачу ?

[Serge_Bliznykov]

попробуйте такой код (заполняется матрица 100 на 100)
и выдаётся количество прошедших тиков... (правда, у меня выполняется быстрее, чем успеет пройти один тик...

const
  MaxArray = 100;
type
  MyArrayType = array [1..MaxArray, 1..MaxArray] of word;
var
  Ticks      : LongInt  absolute 0:$46c;
  OldTick    : LongInt;

procedure Spiral(var M : MyArrayType);
var
  k, MaxStep, PosX, PosY : integer;
  i: integer;
BEGIN
  i := 1;
  PosX := 1;
  PosY := 0;
  MaxStep := MaxArray;

  while i <= MaxArray*MaxArray do
  begin
    {движение вправо}
    for k:=1 to MaxStep do
    begin
      Inc(PosY);
      M[PosX, PosY] := i;
      Inc(i);
    end;
    Dec(MaxStep);
    {движение вниз по спирали}
    for k:=1 to MaxStep do 
    begin     
      Inc(PosX);
      M[PosX, PosY] := i;
      Inc(i);
    end;
    {движение влево по спирали}
    for k:=1 to MaxStep do 
    begin
      Dec(PosY);
      M[PosX, PosY] := i;
      Inc(i);
    end;
    Dec(MaxStep);
    {движение вверх по спирали}
    for k:=1 to MaxStep do 
    begin     
      Dec(PosX);
      M[PosX, PosY] := i;
      Inc(i);
    end;
  end;
end;

var
  Matrix : MyArrayType;
  i, j, k   : integer;

BEGIN
  OldTick := Ticks;
  Spiral(Matrix);
  WriteLn('Matrica zapolnena za ', Ticks - OldTick, ' tickov.');
{  for i:=1 to MaxArray do
    begin
      for j:=1 to MaxArray do
        Write(Matrix[i,j]:4);
      WriteLn;
    end;}
END.

[sasha1993]

большое спосибо...ето почти то что я делал в первой программе,но теперь я уверен что проблема не с моим решением .
я тестировал ету задачу здес если будет интерестно
http://www.acmp.ru/index.asp?main=task&id_task=196


при тестирование ( 100-максимум) пказало времмя 1.5 сек...
Я очень удивился когда задача не прошла .
Кстати завта выложу исходник который роботает на много быстрее(по крайне мере на моем компе)
я над ним почти целый день думал

[LeBron]

Сообщение от sasha1993

большое спосибо...ето почти то что я делал в первой программе,но теперь я уверен что проблема не с моим решением .
я тестировал ету задачу здес если будет интерестно
http://www.acmp.ru/index.asp?main=task&id_task=196


при тестирование ( 100-максимум) пказало времмя 1.5 сек...
Я очень удивился когда задача не прошла .
Кстати завта выложу изходник который роботает на много быстрее(по крайне мере на моем компе)
я над ним почти целый день думал

Если ТЛ на первом, то может быть РЕ или кривое подстраивание под систему (самый простой пример - дописали задержку в конце). По поводу скорости работы - задача решается за О(n^2) и не может быть сделана быстрее хотя бы потому, что надо вывести весь массив. Если делать без массива, а выводить на ходу, то формулой, если "быть проще", то заполняем массив, как в условии, и все дела, там константа в пределах полдесятка Не знаю, как надо написать с первого раза, чтоб потом получилось в 4 раза лучше со второго.
Так на каком тесте ТЛ?
И можно взгялнуть Ваш профиль на АСМП?
По поводу решения - я "в древности" решал без формулы, простой симуляцией заполнения и выводом массива. Вот мой АС (0.029 с) код:

var input,output:text; imin,imax,jmin,i,j,jmax,s,a,q:longint;ar:array[1..100,1..100] of longint;
begin
assign(input,'input.txt'); reset(input);
assign(output,'output.txt');rewrite(output);
readln(input,a);
jmin:=1;jmax:=a;imin:=1;imax:=a;i:=1;j:=1;
while q<a*a do begin
for s:=jmin to jmax do begin inc(q);ar[imin,s]:=q;end;inc(imin);
for s:=imin to imax do begin inc(q);ar[s,jmax]:=q;end;dec(jmax);
for s:=jmax downto jmin do begin inc(q);ar[imax,s]:=q;end;dec(imax);
for s:=imax downto imin do begin inc(q);ar[s,jmin]:=q;end;inc(jmin);
 end;
 for i:=1 to a do begin for j:=1 to a do begin 
write(output,ar[i,j],' ');end;writeln(output);end;
close(output);
close(input);
end.

З.Ы. Перечитал посты выше - мое решение аналогично решению Serge_Bliznykov.

[sasha1993]

прошу прощение ,но можно перевести О(n^2) в секунды для матрецы 100*100
И задержки я не ставел...на моем компе масив 1000*1000 перебирается за одну секунду

[Анатоль]

O(n*n) это верхний порог затраченных операций.
если n до 100 то верхний 100*100=10000 операций.
На олимпиадах учат считать, что комп выполняет 10^6 операций за секунду. Но это было давно сча компы стали сильнее, так что можно спокойно считать 10^7. На некоторых задачах может быть даже 5*10^7.
Ну а верхний предел на сильном компе это 10^8. Но там операции должны быть не сложнее a+b. Сложение, вычитание,умножение простые операции, а всё остальное включая делеение сложные.
Вроде всё те рассказал, что знал сам. Вопросы будут?

[sasha1993]

вопросов почти нету
я просмотрел вашы программы и не могу понять чем моя на столько отличается???

var q,n,m,i,i2,lic:integer;
mas:array [1..100,1..100] of integer;
begin
assignfile(input,'input.txt');
reset(input);
readln(q);
n:=q;
m:=1;
lic:=0;
while lic<q*q do
 begin
    for i:= m to n do
    begin
      inc(lic)  ;
      mas[m,i]:=lic;
    end;

    for i:= m+1 to n do
    begin
      inc(lic)  ;
      mas[i,n]:=lic;
    end;


    for i:= n-1 downto m do
    begin
      inc(lic)  ;
      mas[n,i]:=lic;
    end;

     for i:= n-1 downto m+1 do
    begin
      inc(lic)  ;
      mas[i,m]:=lic;
    end;

    inc(m);
    dec(n);



 end;

 inc(lic);
 if n=m then
 mas[m,n]:=lic;
 assignfile (output,'output.txt');
 rewrite(output);
 for i:=1 to q do
 for i2:=1 to q do
 if i2=q then
 writeln(mas[i,i2]) else
 write(mas[i,i2],' ');
end.

проверел ваши программы ,они прошли