Добрый день! Очень прошу помочь со следующей задачей: в заданной квадратной матрице NxN удалить все строки и столбцы, которые содержат нулевой элемент (то есть если находится 0, то надо удалить сразу и строку и столбец). Для одного нуля моя программа работает, но как сделать для большего количества, я не могу понять. Очень прошу помощи, заранее спасибо!
Вот то что я написал:
program Project1;
{$APPTYPE CONSOLE}
uses
SysUtils;
const n=4;
type telem=integer;
mas=array[1..n] of telem;
matr=array[1..n] of mas;
var i,j,k,p,m:integer;
a:matr;
procedure delstroka(var a:matr; k:integer);
var i,j:integer;
begin
for i:=k to n-1 do
for j:=1 to n do
a[i,j]:=a[i+1,j]
end;
procedure delstolbec(var a:matr; p:integer);
var i,j:integer;
begin
for i:=1 to n do
for j:=p to n-1 do
a[i,j]:=a[i,j+1]
end;
procedure vvod(var a:matr);
var i,j:integer;
begin
writeln('vvedite massiv');
for i:=1 to n do
for j:=1 to n do
read(a[i,j]);
end;
procedure delnyli(var a:matr);
var i,j,p,k,m:integer;
begin
for i:=1 to n do
for j:=1 to n do
if a[i,j]=0 then
begin
k:=i;
p:=j;
delstroka(a,k);
delstolbec(a,p);
end;
end;
procedure print(var a:matr);
var i,j:integer;
begin
for i:=1 to n do
begin
writeln;
for j:=1 to n do
write(a[i,j],' ');
end;
end;
begin
vvod(a);
delnyli(a);
print(a);
readln;
readln;
end.
program Project1;
{$APPTYPE CONSOLE}
uses
SysUtils;
const
m=5;
type
telem= integer;
mas= array[1..m] of telem;
matr= array[1..m] of mas;
var
n: integer;
const
a: matr=(
(11, 12, 13, 0, 15),
(21, 22, 23, 24, 0),
(31, 32, 33, 34, 35),
(41, 42, 0, 44, 45),
( 0, 52, 53, 54, 55)
);
procedure print(var a:matr);
var
i,j:integer;
begin
WriteLn;
for i:=1 to n do begin
for j:=1 to n do write(a[i,j]:5,' ');
writeln;
end;
end;
procedure DelStroka(var a:matr; k:integer);
var
i: integer;
begin
// достаточно одного цикла, если перемещать целые строки
for i:=k to n-1 do a[i]:=a[i+1]
end;
procedure DelStolbec(var a:matr; p:integer);
var
i,j:integer;
begin
for i:=1 to n do for j:=p to n-1 do a[i,j]:=a[i,j+1]
end;
procedure vvod(var a:matr);
var
i,j:integer;
begin
writeln('vvedite massiv');
for i:=1 to n do begin
for j:=1 to n do read(a[i,j]);
ReadLn
end
end;
procedure DelNyli(var a:matr);
var
i,j: integer;
begin
i:=1;
while i<=n do begin // for - нельзя
j:=1;
while j<=n do begin // for - нельзя
if a[i,j]=0 then begin
DelStroka(a,i);
DelStolbec(a,j);
Dec(n); // уменьшаем размер матрицы
Print(a); // промежуточная печать - убери ее
j:=1 // проходим по строке снова с самого начала
end
else Inc(j)
end;
Inc(i);
end
end;
begin
n:=m;
Print(a);
//vvod(a);
delnyli(a);
print(a);
readln;
end.
Со всем разобрался. Большое спасибо за помощь =)
хотя нет, вру. программа работает корректно только в случае если два нуля не стоят на одной строке или в одном столбце, иначе при как только встречается первый ноль, то программа удаляет всю строку целиком и поэтому при втором просмотре матрицы этого нуля уже нет и соответственно нужный столбец не удаляется.
Например
5 0 0 6
8 2 3 5
8 8 2 3
7 9 1 3
В данном случае программа выдаст
8 3 5
8 2 3
7 1 3
хотя должно быть
8 5
8 3
7 3
Попробую доработать программу для такого случая
по-моему, надо запомнить номера всех строк и столбцов, в которых есть 0 и удалить что надо
program Project1;
{$APPTYPE CONSOLE}
uses
SysUtils;
const
max= 5;
Debug= true;
type
tElem= integer;
tRow= array[1..max] of tElem;
tMatrix= array[1..max] of tRow;
var
m,n: integer;
zi,zj: set of byte;
procedure print(var a:tMatrix; m,n: integer);
var
i,j:integer;
begin
WriteLn;
if m*n=0 then WriteLn('Matrix is empty')
else for i:=1 to m do begin
for j:=1 to n do write(a[i,j]:5,' ');
writeln;
end;
end;
procedure DelRow(var a:tMatrix; var m,n: integer; k:integer);
var
i: integer;
begin
for i:=k to m-1 do a[i]:=a[i+1];
zi:=zi-[k];
for i:=k+1 to m do if i in zi then begin
zi:=zi-[i];
zi:=zi+[i-1]
end;
Dec(m);
if Debug then Print(a,m,n)
end;
procedure DelCol(var a:tMatrix; var m,n: integer; k :integer);
var
i,j:integer;
begin
for i:=1 to m do for j:=k to n-1 do a[i,j]:=a[i,j+1];
zj:=zj-[k];
for j:=k+1 to n do if j in zj then begin
zj:=zj-[j];
zj:=zj+[j-1]
end;
Dec(n);
if Debug then Print(a,m,n)
end;
var
i,j: integer;
a: tMatrix;
begin
m:=max;
n:=max;
// заполнение случайными величинами
Randomize;
for i:=1 to m do for j:=1 to n do a[i,j]:=Random(max);
Print(a,m,n);
// просмотр и поиск нулей
zi:=[]; // подготовка множеств меченых строк,
zj:=[]; // сначала они пустые
for i:=1 to m do for j:=1 to n do if a[i,j]=0 then begin // если найден нуль, то
zi:=zi+[i]; // запоминаем номер строки
zj:=zj+[j] // и номер столбца
end;
// цикл удаления
for i:=max downto 1 do if i in zi then DelRow(a,m,n,i); // строк
for j:=max downto 1 do if j in zj then DelCol(a,m,n,j); // столбцов
print(a,m,n);
readln;
end.
Lapp спасибо большое еще раз , программа работает нормально, ошибок не обнаружил больше=)