удалить строки с столбцы в матрице Опции

[deniska]

Добрый день! Очень прошу помочь со следующей задачей: в заданной квадратной матрице 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.

[deniska]

хотя нет, вру. программа работает корректно только в случае если два нуля не стоят на одной строке или в одном столбце, иначе при как только встречается первый ноль, то программа удаляет всю строку целиком и поэтому при втором просмотре матрицы этого нуля уже нет и соответственно нужный столбец не удаляется.
Например
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
Попробую доработать программу для такого случая

Сообщение отредактировано: deniska - 21.03.2010 0:42

[Lapp]

программа работает корректно только в случае если два нуля не стоят на одной строке или в одном столбце

Да, согласен. Извиняюсь за дезу..

Попробую доработать программу для такого случая

Начать советую с того, что отказаться от квадратности матрицы - ввести отдельные размеры по строкам и столбцам.
И алгоритм просмотра нужно полностью менять. Нельзя удалять в процессе поиска нулей. Нужно сначала найти и запомнить (или пометить) все содержащие нули строки и столбцы. Запоминать (метить) можно по-разному - можно в двух одномерных массивах, например. Ниже я привел свой вариант с запоминаниями в двух переменных типа множество. В процессе удаления нельзя забывать, что номера строк меняются при удалении (я делаю коррекцию прямо в процедурах удаления).

Надеюсь, оно работает верно на этот раз . Главное - надо обязательно разделять процесс поиска нулей и процесс удаления.

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.

Еще раз извиняюсь, и спасибо за указание на ошибку.

Добавлено через 57 сек.

по-моему, надо запомнить номера всех строк и столбцов, в которых есть 0 и удалить что надо

Ага