IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

 
 Ответить  Открыть новую тему 
> Помогите решить задачу про двумерные массивы
сообщение
Сообщение #1





Группа: Пользователи
Сообщений: 3
Пол: Мужской

Репутация: -  0  +


Помогите решить задачу
Матрицу А(m,n) заполнить следующим образом. Для заданных k и l элементу аkl присвоить значение 1 ; элементам , окаймляющим его (соседним с ним по вертикали, горизонтали и диагоналям) – значение 2; элементам следующего окаймление – значение 3 и так далее до заполнения всей матрицы. Результат вывести на экран ,раскрасив слой разными цветами. Примечание : алгоритм не изменится ,если координаты элемента (несуществующего ) k и l находятся за пределами матрицы.

Сообщение отредактировано: Voivod -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Perl. Just code it!
******

Группа: Пользователи
Сообщений: 4 100
Пол: Мужской
Реальное имя: Андрей

Репутация: -  44  +


Вот на вскидку ...

uses crt;

const

n = 5;

type
TMx = array [1..n, 1..n] of Integer;

function IsOk(const a, b: Integer): Boolean;
begin
isOk := (a >= 1) AND (a <= n) AND (b >= 1) AND (b <= n);
end;

function CreateMatrix(const k, l: Integer): TMx;
var
delta, i, count: LongInt;
mx: TMx;
begin

for i := 1 to n do
FillChar(mx[i], sizeof(mx[i]), 0);

count := 0;
delta := 0;

while (count < n * n) do begin

for i := l - delta to l + delta do begin

if IsOk(k - delta, i) then begin
if mx[k - delta, i] = 0 then inc(count);
mx[k - delta, i] := delta + 1;
end;

if IsOk(k + delta, i) then begin
if mx[k + delta, i] = 0 then inc(count);
mx[k + delta, i] := delta + 1;
end;

end;

for i := k - delta to k + delta do begin

if IsOk(i, l - delta) then begin
if mx[i, l - delta] = 0 then inc(count);
mx[i, l - delta] := delta + 1;
end;

if IsOk(i, l + delta) then begin
if mx[i, l + delta] = 0 then inc(count);
mx[i, l + delta] := delta + 1;
end;

end;

inc(delta);
end;

CreateMatrix := mx;
end;

procedure PrintMatrix(const mx: TMx);
var
i, j: Integer;
begin
for i := 1 to n do begin
writeln;
for j := 1 to n do begin
TextColor(mx[i, j] + 1);
write(mx[i, j]:3);
end;
end;
end;

begin
clrscr;
PrintMatrix(CreateMatrix(2, 2));
readln;
end.


--------------------
perl -e 'print for (map{chr(hex)}("4861707079204E6577205965617221"=~/(.{2})/g)), "\n";'
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Гость






klem4: во-первых, твоя программа в TP не откомпилируется ... Это только для 32-бит (из-за возвращаемого значения CreateMatrix), а во-вторых, однообразные циклы вполне можно сократить blum.gif

Добавлено позже...
Вот так, например:

uses crt;

const
n = 10;

type
TMx = array [1..n, 1..n] of Integer;

function IsOk(const a, b: Integer): Boolean;
begin
isOk := (a >= 1) AND (a <= n) AND (b >= 1) AND (b <= n);
end;

function CreateMatrix(const k, l: Integer): TMx;
var
delta, count: LongInt;
mx: TMx;

procedure loop(i_first: boolean; X, Y: integer);
var
i, pm: integer;
first, second: integer;
begin
for i := X - delta to X + delta do

for pm := -1 to 1 do begin

first := byte(not i_first)*(Y + pm * delta) + byte(i_first)*i;
second := byte(not i_first)*i + byte(i_first)*(Y + pm * delta);

if (pm <> 0) and IsOk(first, second) then begin
if mx[first, second] = 0 then inc(count);
mx[first, second] := delta + 1;
end;

end;

end;

begin
FillChar(mx, sizeof(mx), 0);

count := 0;
delta := 0;

while (count < n * n) do begin

loop(false, L, K); loop(true, K, L);
inc(delta);

end;

CreateMatrix := mx;
end;

procedure PrintMatrix(const mx: TMx);
var
i, j: Integer;
begin
for i := 1 to n do begin
writeln;
for j := 1 to n do begin
TextColor(mx[i, j] + 1);
write(mx[i, j]:3);
end;
end;
end;

begin
clrscr;
PrintMatrix(CreateMatrix(2, 2));
readln;
end.
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Perl. Just code it!
******

Группа: Пользователи
Сообщений: 4 100
Пол: Мужской
Реальное имя: Андрей

Репутация: -  44  +


Вот переделал под TP. По поводу сократить щас подумаю smile.gif


Прикрепленные файлы
Прикрепленный файл  FORUM.PAS ( 1.45 килобайт ) Кол-во скачиваний: 171


--------------------
perl -e 'print for (map{chr(hex)}("4861707079204E6577205965617221"=~/(.{2})/g)), "\n";'
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5





Группа: Пользователи
Сообщений: 3
Пол: Мужской

Репутация: -  0  +


Спасибо большое за вложенный вариант задачи , а то какой день бьюсь над решением
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 26.10.2020 20:08
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name