Квадратная матрица Опции

[Pautina]

Доброго времени суток! очень нужна ваша помощь. Помогите решить задачу.
Начиная с центра. обойти по спирали все элементы квадратной матрицы размером 13х13 (распечатывая их в порядке обхода).
Заранее огромное спасибо!

[Tan]

Поиск, подобное задание есть.

[St@senk@]

Я попытался найти, но не нашел. Вот мое решение, проверял на таблице 5 на 5, но должно и на 13 на 13 работать.

Код

program Project2;

{$APPTYPE CONSOLE}

uses
  SysUtils;
const xl = 13;
yl = 13;
var ar : array [1..xl,1..yl] of integer;
var arr : array [1..xl,1..yl] of boolean;
var dir : integer;
var x,y,i,j : integer;
label CS;
begin
  for i:= 1 to yl do begin
    for j:= 1 to xl do begin
      ar[j,i]:=(i-1)*xl+j;
      arr[j,i]:=false;
    end;
  end;
  x:=1;
  y:=1;
  dir:=0;
  repeat
    arr[x,y]:=true;
    write(ar[x,y],' ');
    CS:
    case dir of
      0:if (x=xl) or arr[x+1,y] then  begin
        dir:=1;
        goto CS;
        end
        else
        inc(x);
      1:if (y=yl) or arr[x,y+1] then begin
        dir:=2;
        goto CS;
        end
        else
        inc(y);
      2:if (x=1) or arr[x-1,y] then begin
        dir:=3;
        goto CS;
        end
        else
        dec(x);
      3:if (y=0) or arr[x,y-1] then begin
        dir:=0;
        goto CS;
        end
        else
        dec(y);
    end;

  until (y=(yl div 2)+1) and (x=(xl div 2)+1);
  readln;
  { TODO -oUser -cConsole Main : Insert code here }
end.

Сообщение отредактировано: St@senk@ - 23.03.2007 3:52

[Алена]

St@senk@, задание было:

Начиная с центра. обойти по спирали

А у тебя - как раз с левого верхнего угла вниз, и к центру начинается...

[St@senk@]

Если я приведу полностью работающий код, то не будет обучательного процесса.

Сообщение отредактировано: St@senk@ - 23.03.2007 4:20

[Алена]

А ты и так привел нерабочий код. Во всяком случае, у тех, кто попробует его скомпилировать в TP, будут проблему... А на будущее - начни процесс обучения с себя (например, с использования поиска, я насчитала сейчас там по меньшей мере 10 вариантов решения задачи).

[St@senk@]

с поиском, согласен, искать совсем не умею.

Спойлер (Показать/Скрыть)

program Project2;
const xl = 13;
yl = 13;
var ar : array [1..xl,1..yl] of integer;
var arr : array [1..xl,1..yl] of boolean;
var posl : array [1..xl*yl] of integer;
var dir : integer;
var x,y,i,j : integer;
label CS;
begin
for i:= 1 to yl do begin
for j:= 1 to xl do begin
ar[j,i]:=(i-1)*xl+j;
arr[j,i]:=false;
end;
end;
x:=1;
y:=1;
dir:=0;
posl[1]:=(yl div 2)*xl+(yl div 2)+1;
i:=xl*yl;
repeat
arr[x,y]:=true;
posl[i]:=ar[x,y];
dec(i);
CS:
case dir of
0:if (x=xl) or arr[x+1,y] then begin
dir:=1;
goto CS;
end
else
inc(x);
1:if (y=yl) or arr[x,y+1] then begin
dir:=2;
goto CS;
end
else
inc(y);
2:if (x=1) or arr[x-1,y] then begin
dir:=3;
goto CS;
end
else
dec(x);
3:if (y=0) or arr[x,y-1] then begin
dir:=0;
goto CS;
end
else
dec(y);
end;

until (y=(yl div 2)+1) and (x=(xl div 2)+1);
for i:= 1 to xl*yl do
write(posl[i],' ');
readln;
{ TODO -oUser -cConsole Main : Insert code here }
end.

вот код проверенный и работающий, но помоему для человека от этого толку будет мало.

[Pautina]

В поиске не смогла ничего найти..

[Pautina]

Так и не смогла понять, в чем смысл данной проги.. В результате ее работы на экране появилась непонятная мне последовательность цифр:

85 84 97 98 99 86 73 72 71 70 83 96 109 110 111 112 113 100 87 74 61 60 59 58 57
56 69 82 95 108 121 122 123 124 125 126 127 114 101 88 75 62 49 48 47 46 45 44
43 42 55 68 81 94 107 120 133 134 135 136 137 138 139 140 141 128 115 102 89 76
63 50 37 36 35 34 33 32 31 30 29 28 41 54 67 80 93 106 119 132 145 146 147 148 1
49 150 151 152 153 154 155 142 129 116 103 90 77 64 51 38 25 24 23 22 21 20 19 1
8 17 16 15 14 27 40 53 66 79 92 105 118 131 144 157 158 159 160 161 162 163 164
165 166 167 168 169 156 143 130 117 104 91 78 65 52 39 26 13 12 11 10 9 8 7 6 5
4 3 2 1

[St@senk@]

скажи честно, ты хоть взглянула на код? Думаю, если ты на него чуть-чуть посмотришь, то тебе станет понятно, что это за последовательность.

Спойлер (Показать/Скрыть)

матрица в самом начале работы программы заполняется таким методом:
1 2 3 4 5 ... 13
14 15 16 ... 26
...

[-Pautina-]

Конечно,смотрела.. если не заметил, там даже файл прикрепленный с прогой есть.. только вот почему-то работает она совершенно по-другому, нежели у тебя..

[St@senk@]

Работает она так же как и у меня.

for i:=1 to yl do
    begin
    for j:=1 to xl do
        begin
        a1[j,i]:=(i-1)*xl+j;
        a2[j,i]:=false;
        end;
    end;

Вот тут мы заполняем матрицу.

for i:=1 to yl do
    begin
    for j:=1 to xl do
        begin
        read(a1[j,i]);
        a2[j,i]:=false;
        end;
    end;

Вот так мы будем её считывать с клавиатуры.
А дальше

x:=1;
y:=1;
dir:=0;
posl[1]:=a1[(xl div 2)+1,(yl div 2)+1];
i:=xl*yl;
repeat
a2[x,y]:=true;
posl[i]:=a1[x,y];
dec(i);
CS:case dir of
0:if (x=xl) or a2[x+1,y] then
            begin
            dir:=1;
            goto CS;
            end
                        else inc(x);
1:if (y=yl) or a2[x,y+1] then
            begin
            dir:=2;
            goto CS;
            end
                        else inc(y);
2:if (x=1) or a2[x-1,y] then
            begin
            dir:=3;
            goto CS;
            end
                        else dec(x);
3:if (y=0) or a2[x,y-1] then
            begin
            dir:=0;
            goto CS;
            end
                        else dec(y);
end;
until (y=(yl div 2)+1) and (x=(xl div 2)+1);

Это сам обход матрицы

Код

for i:=1 to xl*yl do
write(posl[i],' ');

Это выпечатывание элементов том порядке, в котором тебе нужно.

[Pautina]

а не мог бы ты прикрепить саму прогу?

[Pautina]

Попробовала написать по-другому.. но все равно есть проблемы.. подскажите пожалуйста. На вас одна надежда

[volvo]

const
  size = 13;

var
  X, Y: integer;
  square: array[1 .. size, 1 .. size] of integer;

function check(X, Y: integer): boolean;
begin
  check := ((X > 0) and (X <= size) and
            (Y > 0) and (Y <= size))
end;

type
  dirs = (_up, _down, _left, _right);
  axis = (_X, _Y);
const
  offset: array[dirs, axis] of integer = (
    (0, -1), (0, 1), (1, 0), (-1, 0)
  );

function go(where: dirs; delta: integer): boolean;
var i: integer;
begin
  go := false;
  for i := 1 to delta do
    if check(Y + offset[where, _Y], X + offset[where, _X]) then begin
      X := X + offset[where, _X];
      Y := Y + offset[where, _Y];
      write(square[Y, X]:4);
    end
    else exit;
  go := true;
end;

var
  i, j, plus: integer;
  status: boolean;
begin
  for i := 1 to size do
    for j := 1 to size do
      square[i, j] := (i - 1)*size + j;

  for i := 1 to size do begin
    for j := 1 to size do write(square[i, j]:4);
    writeln;
  end;


  plus := 0;
  X := size div 2 + 1; Y := size div 2 + 1;
  write(square[Y, X]:4);
  status := true;
  repeat
    inc(plus);
    status := status and go(_right, plus);
    status := status and go(_down, plus);
    inc(plus);
    status := status and go(_left, plus);
    status := status and go(_up, plus);
  until not status;

end.

Порядок обхода из центра: влево, вниз, вправо, вверх... Если надо по-другому, меняй направления в цикле repeat/until ... В начале распечатывается матрица, чтобы можно было проверить правильность работы программы...

[@лё][@]

Всё-таки порядок обхода в выше написанной программе: из центра влево, вниз, вправо, вверх... Правда программист мог сидеть и спиной к монитору Спасибо этому программисту, мне его программа тоже пригодится