Версия для печати темы
Нажмите сюда для просмотра этой темы в обычном формате
Форум «Всё о Паскале» _ Задачи _ Квадратная матрица
Автор: Pautina 23.03.2007 1:11
Доброго времени суток! очень нужна ваша помощь. Помогите решить задачу.
Начиная с центра. обойти по спирали все элементы квадратной матрицы размером 13х13 (распечатывая их в порядке обхода).
Заранее огромное спасибо!
Автор: Tan 23.03.2007 3:22
Поиск, подобное задание есть.
Автор: St@senk@ 23.03.2007 3:52
Я попытался найти, но не нашел. Вот мое решение, проверял на таблице 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.
Автор: Алена 23.03.2007 4:03
St@senk@, задание было:
Автор: St@senk@ 23.03.2007 4:20
Если я приведу полностью работающий код, то не будет обучательного процесса.
Автор: Алена 23.03.2007 4:23
А ты и так привел нерабочий код. Во всяком случае, у тех, кто попробует его скомпилировать в TP, будут проблему... А на будущее - начни процесс обучения с себя (например, с использования поиска, я насчитала сейчас там по меньшей мере 10 вариантов решения задачи).
Автор: St@senk@ 23.03.2007 4:29
с поиском, согласен, искать совсем не умею.
вот код проверенный и работающий, но помоему для человека от этого толку будет мало.
Автор: Pautina 24.03.2007 1:41
В поиске не смогла ничего найти.. 
Автор: Pautina 24.03.2007 3:01
Так и не смогла понять, в чем смысл данной проги.. В результате ее работы на экране появилась непонятная мне последовательность цифр:
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
Прикрепленные файлы
Z1.PAS ( 1.16 килобайт )
Кол-во скачиваний: 254
Автор: St@senk@ 24.03.2007 3:13
скажи честно, ты хоть взглянула на код? Думаю, если ты на него чуть-чуть посмотришь, то тебе станет понятно, что это за последовательность.
Автор: -Pautina- 24.03.2007 13:58
Конечно,смотрела.. если не заметил, там даже файл прикрепленный с прогой есть.. только вот почему-то работает она совершенно по-другому, нежели у тебя..
Автор: St@senk@ 24.03.2007 14:19
Работает она так же как и у меня.
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 27.03.2007 3:14
а не мог бы ты прикрепить саму прогу?
Автор: Pautina 28.03.2007 1:58
Попробовала написать по-другому.. но все равно есть проблемы.. подскажите пожалуйста. На вас одна надежда
Прикрепленные файлы
Z1.PAS ( 1.16 килобайт )
Кол-во скачиваний: 265
Автор: volvo 28.03.2007 15:00
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 ... В начале распечатывается матрица, чтобы можно было проверить правильность работы программы...
Автор: @лё][@ 31.03.2010 20:03
Всё-таки порядок обхода в выше написанной программе: из центра влево, вниз, вправо, вверх... Правда программист мог сидеть и спиной к монитору Спасибо этому программисту, мне его программа тоже пригодится 