Из массива 10х9 удалить строки и столбцы, содержащие хотя бы один 0 элемент- Pascal(Паскаль)

uses crt;
var a:array[1..10,1..9] of integer;
    b:array[1..9] of byte;
    m,n,i,j,f,p,k:byte;
begin
clrscr;
randomize;
n:=10;
m:=9;
writeln('Исходная матрица:');
for i:=1 to n do
 begin
  for j:=1 to m do
   begin
    a[i,j]:=random(10);
    write(a[i,j]:3);
   end;
  writeln;
 end;
writeln;
{номера столбцов с нолями}
f:=0;
for j:=1 to m do
 begin
  k:=0;
  for i:=1 to n do
  if a[i,j]=0 then
   begin
    k:=1;
    f:=1;
   end;
  b[j]:=k;
 end;
if f=0 then write('В матрице нет нолей!')
else
 begin
  {удаление строк с нолем}
  i:=n;{начнем с конца}
  while(i>=1)and(n>0) do
   begin
    k:=0;
    j:=1;
    while(j<=m)and(k=0) do
    if a[i,j]=0 then k:=1
    else j:=j+1;
    if k=1 then{если есть ноль}
     begin
      f:=f-1;{вычитаем строку}
      if i=n then {если строка на этот момент последняя}
       begin
        n:=n-1;{обрезаем}
        i:=i-1;{верх}
       end
      else {если не последняя}
       begin
        for k:=i to n-1 do{от этой строки до предпоследней}
        for p:=1 to m do{всем элементам строк}
        a[k,p]:=a[k+1,p];{присваиваем значения нижней}
        n:=n-1;{уменьшаем количество}
       end;
     end
    else i:=i-1;{если нет нолей, вверх}
   end;
if n=0 then writeln('Все строки и столбцы удалены!')
else{если остались строки, удаляем столбцы}
 begin
  f:=m;{начнем с конца}
  for i:=m downto 1 do{в обратном порядке читаем массив номеров}
  if b[i]=1 then{если есть ноль}
   begin
    if i=f then{и последний на данный момент, также как строки}
      begin
       m:=m-1;
       f:=f-1;
      end
    else {если не последний, тоже как строки}
     begin
      for k:=i to m-1 do
      for p:=1 to n do
      a[p,k]:=a[p,k+1];
      m:=m-1;
     end;
   end;
  writeln('Матрица после сжатия:');
  for i:=1 to n do
   begin
    for j:=1 to m do
    write(a[i,j]:3);
    writeln;
   end;
 end;
 end;
readln
end.

Leave a Comment

+ 51 = 53