Помощь - Поиск - Пользователи - Календарь
Полная версия: Задачка с матрицей.
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
Rom1k
Дан двумерный массив А.Заменить нулями элементы массива.СТОЯЩИЕ В СТРОКАХ ИЛИ СТОЛБЦАХ,ГДЕ ИМЕЮТСЯ НУЛИ.

Вот.Создал,заполнил,а дальше что делать? Создавать новый массив? И как Мне выполнить условие задачи?!
Program z_2;
const
Nmax=10;{Максимальное значение строк и столбцов матрицы}
type
mas=array[1..Nmax,1..Nmax] of integer;
{Процедура ввода массива}
Procedure vvod(var A:mas;var N,M:integer);
{A-матрица, N,M-Строка и столбец в матрице}
var
i,j:integer;{Номер строки и столбца в матрице}
begin
repeat
Write('Задайте число строк в матрице (1..',nmax,'): ');
ReadLn(N);
If (N<=0) and (N>Nmax) then
WriteLn('Ошибка! Повторите!');
until (N>0) and (N<=Nmax);
repeat
Write('Задайте число столбцов в матрице (1..',nmax,'): ');
ReadLn(M);
If (M<=0) and (M>Nmax) then
WriteLn('Ошибка! Повторите!');
until (M>0) and (M<=Nmax);
WriteLn('Задайте элементы матрицы строкам через пробел ');
For i:=1 to N do
begin
Write('Строка: ');
for j:=1 to M do
Read(A[i,j]);
ReadLn;
end;
end;
procedure vivod(A:mas;N,M:byte);
{A-матрица,N,M-строка и столбец}
var
i,j:integer;{Номер очередного элемента в массиве}
begin
WriteLn('Результат: ');
for i:=1 to N do
begin
for J:=1 to M do
Write(a[i,j]:4);
WriteLn;
end;
end;
Var
NA:mas;{Исходный массив}
NN,NM:integer;{Кол-во cтрок и столбцов в матрице}
NI,NJ:integer;{Элементы строки и столбца в матрице}
begin{main}
WriteLn('Ввод матрицы: ');
Vvod(NA,NN,NM);
WriteLn('Матрица ');
Vivod(NA,NN,NM);
end.

Tan
Ну я бы сделал так : скопировал главный массив в другой, потом в главном проверил бы все строки, и если находим нулевой элемент, то все элементы строки обращаем в 0. Потом по скопированной матрице прошёлся по колоннам, и если там напарываемся на 0, то в основной матрице этот столбик тоже обнуляем. По - моему без копии основной матрицы тяжело, та как если мы сразу будем обнулять столбцы и колонны, это будет ошибочно.
klem4
Или вот такой вариант, если матрица не более 255*255
const
n = 5;

type
TArray = array [1..n] of Integer;
TMatrix = array [1..n] of TArray;

var
mx: TMatrix = (
(1, 2, 3, 0, 4),
(0, 2, 1, 4, 1),
(1, 0, 2, 2, 0),
(1, 2, 3, 4, 5),
(1, 2, 3, 4, 5)
);

rows, cols: Set of Byte;
i, j: Integer;

begin
rows := []; cols := [];

for i := 1 to n do
for j := 1 to n do
if mx[i, j] = 0 then begin
include(rows, i);
include(cols, j);
end;

for i := 1 to n do begin
if i in rows then for j := 1 to n do mx[i, j] := 0;
if i in cols then for j := 1 to n do mx[j, i] := 0;
end;


for i := 1 to n do begin
writeln;
for j := 1 to n do write(mx[i, j]:2);
end;
end.
Tan
Если я правильно понял условие, то вот мой вариант (пардон что без процедур) :
uses crt;
Const N = 4;
M = 4;
var ms,copyms : array [1..N,1..M] of integer;
i,j,k : Integer;
begin
ClrScr;
randomize;
for i := 1 To N do
Begin
writeln;
For j := 1 to M do
begin
ms[i,j] := random(7) - 1;
copyms[i,j] := ms[i,j];
write (ms[i,j]:3);
end;
end;
for i:= 1 to N do
for j:= 1 to M do
If ms[i,j] = 0 then for k := 1 to M do ms[i,k] :=0;
for i := 1 to N do
for j := 1 to M do if copyms [i,j] = 0 then for k:= 1 to N do ms[k,j] := 0;
writeln;
writeln;
for i:= 1 to N do
begin
for j:= 1 to M do write (ms[i,j]:3);
writeln;
end;
readkey;
end.



P.S. Klem4, скорей всего матрица будет ещё меньше, чем вы предположили, так как автор в своём исходнике просит ввести элементы, иначе преподу который будет проверять "нефортануло" smile.gif
klem4
Еще вот так wacko.gif

const
n = 5;

type
TArray = array [1..n] of Integer;
TMatrix = array [1..n] of TArray;

var
i: Integer = 1; j: Integer = 1;

procedure Reform(var mx: TMatrix);
var
r, c, T: Integer;
begin

if (i <= n) and (j <= n) then begin
r := 0; c := 0;

if mx[i, j] = 0 then begin
r := i; c := j;
end;

if (j = n) and (i < n)then begin
inc(i); j := 1;
end else inc(j);

if (i <= n) and (j <= n) then Reform(mx);
end;

if (i = n) and (j > n) then begin
if r <> 0 then for T := 1 to n do mx[r, T] := 0;
if c <> 0 then for T := 1 to n do mx[T, c] := 0;
end;

end;

var
mx: TMatrix = (
(1, 2, 3, 0, 4),
(0, 2, 1, 4, 1),
(1, 0, 2, 2, 0),
(1, 2, 3, 4, 5),
(1, 2, 3, 4, 5)
);

p, q: Integer;
begin
Reform(mx);

for p := 1 to n do begin
writeln;
for q := 1 to n do write(mx[p, q]:2);
end;
end.
Rom1k
спасибо Вам большое,я подумал и разобрался.Нашёл очень лёгкий выход.Надеюсь препод не придерётся) как Вам?:
Program z_2;
uses crt;
const
Nmax=10;{Максимальное значение строк и столбцов матрицы}
type
mas=array[1..Nmax,1..Nmax] of integer;
var
A:mas;
N,M:byte;{Кол-во строк и столбцов}
i,j:integer;{Номер строки и столбца в матрице}
b:array[1..nmax] of integer;{Вспомогат массив}
BEGIN
clrscr;
repeat
Write('Задайте число строк в матрице (1..',nmax,'): ');
ReadLn(N);
If (N<=0) and (N>Nmax) then
WriteLn('Ошибка! Повторите!');
until (N>0) and (N<=Nmax);
repeat
Write('Задайте число столбцов в матрице (1..',nmax,'): ');
ReadLn(M);
If (M<=0) and (M>Nmax) then
WriteLn('Ошибка! Повторите!');
until (M>0) and (M<=Nmax);
WriteLn('Задайте элементы матрицы строкам через пробел ');
For i:=1 to N do
begin
b[i]:=0;
Write('Строка ',i,': ');
for j:=1 to M do
begin
Read(A[i,j]);
if a[i,j]=0 then
b[i]:=b[i]*10+j;
end;
end;
For i:=1 to N do
if b[i]<>0 then
begin
{Обнуление строки,содержащей 0}
For j:=1 to m do
a[i,j]:=0;
{Обнуление столбца,содержащего 0}
For j:=1 to n do
a[j,b[i] mod 10]:=0;
b[i]:=b[i] div 10;
end;
WriteLn('Результат: ');
for i:=1 to N do
begin
for J:=1 to M do
Write(a[i,j]:4);
WriteLn;
end;
readkey;
end.

Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.