Версия для печати темы
Нажмите сюда для просмотра этой темы в обычном формате
Форум «Всё о Паскале» _ Задачи _ Матрица
Автор: Tauka 21.08.2004 21:20
Матрицу А(m,n) заполнить следующим образом:
Для заданных k и l элементу akl присвоить значение 1, элементам, окаймляющим его (соседним с ним по вертикали, горизонтали и диагонали) - значение 2; элементам следующего окаймления - значение 3 и так далее до заполнения всей матрицы.
Примечание: Алгоритм не изменится, если координаты элемента (несуществующего k и l) находятся за пределами матрицы.
Спасибо за внимание! 
Автор: APAL 21.08.2004 22:52
Код
Const
m = 5;
n = 8;
Var
K,L,i,q : Integer;
tmp : Integer;
A : Array [1..m,1..n] of Byte;
Procedure PutNum(kk,ll,ii : Integer);
Begin
If ((kk>0) and (kk<=m)) and ((ll>0) and (ll<=n)) then A[kk,ll]:=ii;
End;
Begin
Write('A(',m,',',n,') Enter K and L : '); Readln(K,L);
If K>L then tmp:=abs(K) else tmp:=abs(L);
If tmp<m then tmp:=m;
If tmp<n then tmp:=n;
For q:=1 to tmp do
For i:=k-(q-1) to k+(q-1) do
Begin
PutNum(i,l-(q-1),q);
PutNum(i,l+(q-1),q);
PutNum(k-(q-1),i,q);
PutNum(k+(q-1),i,q);
End;
Writeln('Result:');
For i:=1 to m do
Begin
For q:=1 to n do
Write(A[i,q]);
Writeln;
End;
End.
m = 5;
n = 8;
Var
K,L,i,q : Integer;
tmp : Integer;
A : Array [1..m,1..n] of Byte;
Procedure PutNum(kk,ll,ii : Integer);
Begin
If ((kk>0) and (kk<=m)) and ((ll>0) and (ll<=n)) then A[kk,ll]:=ii;
End;
Begin
Write('A(',m,',',n,') Enter K and L : '); Readln(K,L);
If K>L then tmp:=abs(K) else tmp:=abs(L);
If tmp<m then tmp:=m;
If tmp<n then tmp:=n;
For q:=1 to tmp do
For i:=k-(q-1) to k+(q-1) do
Begin
PutNum(i,l-(q-1),q);
PutNum(i,l+(q-1),q);
PutNum(k-(q-1),i,q);
PutNum(k+(q-1),i,q);
End;
Writeln('Result:');
For i:=1 to m do
Begin
For q:=1 to n do
Write(A[i,q]);
Writeln;
End;
End.
Не забудьте подредактировать способ вывода результата... (чтобы не было проблем с числами больших или равных 10 - т.е. с дву-трех-....значными)
Автор: Guest 22.08.2004 0:07
Сложновато. Вот попроще.
Код
for i := 1 to n do
for j := 1 to m do
begin
x := abs (i - k);
y := abs (j - l);
if x > y then
a [i, j] := x + 1
else
a [i, j] := y + 1
end;
Автор: APAL 22.08.2004 0:40
Я привел тот вариант, котрый сразу напросился в голову... ;)
Любую прогу можно упростить...