Помогите решить задачу Матрицу А(m,n) заполнить следующим образом. Для заданных k и l элементу аkl присвоить значение 1 ; элементам , окаймляющим его (соседним с ним по вертикали, горизонтали и диагоналям) – значение 2; элементам следующего окаймление – значение 3 и так далее до заполнения всей матрицы. Результат вывести на экран ,раскрасив слой разными цветами. Примечание : алгоритм не изменится ,если координаты элемента (несуществующего ) k и l находятся за пределами матрицы.
klem4
17.11.2006 22:06
Вот на вскидку ...
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.
volvo
17.11.2006 22:42
klem4: во-первых, твоя программа в TP не откомпилируется ... Это только для 32-бит (из-за возвращаемого значения CreateMatrix), а во-вторых, однообразные циклы вполне можно сократить
Добавлено позже... Вот так, например:
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.
klem4
17.11.2006 22:54
Вот переделал под TP. По поводу сократить щас подумаю
Voivod
18.11.2006 4:00
Спасибо большое за вложенный вариант задачи , а то какой день бьюсь над решением
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.