Помогите решить задачу по прогграммированию на Pascal

[ROMIK]

Заполните двумерный массив размером 7х7 числами от 1 до 49, расположив их в нем по спирали:
1 2 3 4 5 6 7
^ > > > > > > >8
^ ...............9
^ ..............10
21..............11
20..............12
19181716151413

[AlexDem]

Возможно несколько вариантов решения. Например, самый ужасный - явно присвоить все ячейки. Так что лучше изложите свои идеи...

[agl7r]

Как вариант:

const
  n = 7;
var
  mas : array[1..n,1..n] of integer;
  i, j, k, c, x, y : integer;
  r : real;
begin
  { заполняем массив }
  c := n;
  y := 1;
  k := 1;
  for i:= 1 to 2*n-1 do
  begin
    for j := 1 to c do
    begin
      x := x + round(cos(r));
      y := y + round(sin(r));
      mas[y,x] := k;
      inc(k);
    end;
    r := r + pi/2;
    if odd(i) then dec(c);
  end;
  { выводим массив }
  for i := 1 to n do
  begin
    for j := 1 to n do
      write(mas[i,j]:3);
    writeln;
  end;
end.

[tpc]

i:=1; j:=0; di:=0; dj:=1;
for k:=1 to n*n do 
  begin
  if (i+di<1) or (n<i+di) or (j+dj<1) or (n<j+dj) or (a[i+di,j+dj]<>0) then
    begin t:=di; di:=dj; dj:=-t; end;
  i:=i+di; j:=j+dj; a[i,j]:=k;
  end;

[IBS]

Поясните пожалуйста решение agl7r
Ну или хотя бы объясните почему когда я пишу

r:=cos(pi/2);
writeln(r:4:4);

мне ничего не выдаёт. А в проограмме я так понял с помощью этого порядок ячеек задаётся.

[ewert]

tpc в сообщении #223487 писал(а):

Используется синтаксис Pascal

i:=1; j:=0; di:=0; dj:=1;
for k:=1 to n*n do 
  begin
  if (i+di<1) or (n<i+di) or (j+dj<1) or (n<j+dj) or (a[i+di,j+dj]<>0) then
    begin t:=di; di:=dj; dj:=-t; end;
  i:=i+di; j:=j+dj; a[i,j]:=k;
  end;
 

Только, во-первых, сначала массив надо бы всё же обнулить (надеяться па автоинициалицию вроде и можно, но как-то некультурно). Во-вторых, примерно по тем же причинам надёжнее

Используется синтаксис Pascal

  rotat:=(i+di<1) or (n<i+di) or (j+dj<1) or (n<j+dj);
  if not rotat   then rotat:=a[i+di,j+dj]<>0;
  if rotat then begin . . . . . . . . .
 

(строго говоря, попытка обратиться к запрещённой области памяти бог весть к чему может привести).

-- Чт ноя 05, 2009 21:40:49 --

IBS в сообщении #258693 писал(а):

Ну или хотя бы объясните почему когда я пишу

r:=cos(pi/2);
writeln(r:4:4);

мне ничего не выдаёт.

Что значит "не выдаёт"? Ноль и выдаст. А зачем Вы это пишите?...

(автор таким экзотическим способом -- через синусы и косинусы -- решил организовать повороты на 90 градусов)

[Профессор Снэйп]

ewert в сообщении #258702 писал(а):

(автор таким экзотическим способом -- через синусы и косинусы -- решил организовать повороты на 90 градусов)

Ага! Хорошо хоть в комплексную плоскость не перешёл и на $-i$ не начал умножать

Вообще задачка, конечно, простая. Нужно сначала обнулить массив, а затем идти по нему с шагом 1, заполняя нулевые ячейки положительными числами. Если встречается ненулевая ячейка или граница массива --- поворачивать на $90$ градусов по часовой стрелке.

-- Сб ноя 07, 2009 02:23:58 --

Маленькая подсказка: если вектор $(a,b)$ повернуть на $90$ градусов по часовой стрелке, то получится вектор $(b,-a)$.

[Legioner93]

Вот нашел свою программу старую, может нужно еще:)
uses crt;
const n=12; m=19; sm:array[1..4,1..2] of integer=((0,1),(1,0),(0,-1),(-1,0));
var
a:array[0..n+1,0..m+1] of integer;
t,i,k,i1,k1,nap,q:integer;
begin
clrscr;
For i:=0 to n+1 do
For k:=0 to m+1 do a[i,k]:=1;
For i:=1 to n do
For k:=1 to m do a[i,k]:=0;
i:=1; k:=1; t:=0; nap:=1; q:=8;
repeat
inc(t); a[i,k]:=t; gotoxy(4*k,2*i); inc(q); If q=16 then q:=8;
textcolor(q); write(a[i,k]); delay(30000);
i1:=i+sm[nap,1]; k1:=k+sm[nap,2];
If a[i1,k1]<>0 then
begin
inc(nap);
If nap=5 then nap:=1;
i:=i+sm[nap,1]; k:=k+sm[nap,2];
end
else
begin
i:=i1; k:=k1;
end;
until t=n*m;
readkey;
end.

[Circiter]

Сканирующая (построчная) генерация искомой матрицы:

Используется синтаксис Pascal

const Order=7;

var
    Top, Left: Byte;

    (* Just O(n) memory complexity. *)
    Row: array[1..Order] of Byte;

begin
    (* Generate all rows consecutively. *)
    for Top:=0 to Order-1 do
    begin
        (* Find values at the tips of the row. *)
        for Left:=1 to Top do
        begin
            (* Work on the left... *)
            Row[Left]:=
                3*Order-4*Left-2*Top+2
                +Row[Order-Left+1];
            (* ...and on the right. *)
            Inc(Row[Order-Left+1]);
        end;

        (* Fill up current row's interior. *)
        if Top <= Order div 2 then
            (* Walk left to right. *)
            for Left:=Top+1 to Order-Top do
                if Left=0 then
                    (* Prevent memory access troubles. *)
                    Row[1]:=1
                else
                    Row[Left]:=Row[Left-1]+1
        else
            (* Walk right to left. *)
            for Left:=Order-Top+1 to Top do
                Row[Left]:=Row[Left-1]-1;

        (* Now current row is ready. *)
        Yield(Row);
    end;
end.
 

Я, кажется, начал забывать паскаль, думал в строчек в пять уложусь...

[Профессор Снэйп]

Эх, блин! Так хочется свой вариант сейчас взять и написать, а подруга из кухни кричит, чтоб немедлено шёл картошку чистить. Ну что за жизнь

[Профессор Снэйп]

Так, картошка кончилась. Поехали...

Используется синтаксис Pascal

program Mine;
var A: array[1..7, 1..7] of integer;
      i,j,x.y,a,b: integer;
procedure rotate(var x,y: integer);
var z: integer:
begin
  z := x; x := y; y := -z
end;
begin
  for i := 1 to 7 do
    for j := 1 to 7 do A[i,j] := 0;
  x := 1; y := 0; a := 1; b := 1;
  for i := 1 to 49 do
    begin
      A[a,b] := i;
      if (a + x < 1) or (a + x > 7) or (b + y > 7) then rotate(x,y)
        else if A[a+x,b+y] > 0 then rotate(x,y);
      a := a + x; b := b + y
    end
end.

[ewert]

Плагиат:

tpc в сообщении #223487 писал(а):

<то же самое>

И ещё раз настоятельно рекомендую: последнее OR всё же лучше вынести в отдельный оператор. Хотя борландовский транслятор и обрывает (насколько я помню) проверку по достижении гарантированного результата, но в стандарт языка это вроде не входит, да и у самого Борланда (опять же насколько помню) эту опцию можно отключать.

[Профессор Снэйп]

ewert в сообщении #259451 писал(а):

Плагиат

Да ну не плагиат, а очевидное, сразу напрашивающееся решение

Вы меня простите, товарищи программисты, я не писал програмки на паскале лет 10 Разве что для машины Тьюринга

-- Сб ноя 07, 2009 19:54:03 --

ewert в сообщении #259451 писал(а):

последнее OR всё же лучше вынести в отдельный оператор.

А смысл? Оптимизация по времени?

[ewert]

я совсем не программист, поэтому -- низачто непрощу!

[Профессор Снэйп]

На самом деле там в проверке условия первые 4 сработают всего три первых раза, а затем начнёт работать последнее условие. Всё это можно расписать... Проверку $b + y < 1$ можно вообще убрать.