Дана матрица размера 5 x 10. Удалить все столбцы, содержащие только положительные элементы — Pascal(Паскаль)

uses crt;
const nmax=20;
var a:array[1..nmax,1..nmax] of integer;
    m,n,i,j,f,p,k,kp:byte;
begin
clrscr;
randomize;
repeat
write('Количество строк до ',nmax,' n=');
readln(n);
until n in [1..nmax];
repeat
write('Количество столбцов до ',nmax,' m=');
readln(m);
until m in [1..nmax];
writeln('Исходная матрица:');
for i:=1 to n do
 begin
   for j:=1 to m do
    begin
     a[i,j]:=random(30)-5;
     write(a[i,j]:4);
    end;
   writeln;
 end;
writeln;
j:=m;//начнем с последнего столбца
f:=0;//пока столбцов для удаления нет
while (j>=1)and(m>0) do//пока есть столбцы
 begin
  k:=0;//количество положительных
  for i:=1 to n do
  if a[i,j]>0 then k:=k+1;//считаем
  if k=n then//если все
   begin
    f:=1;//фиксируем удаление
    if j=m then//если столбец последний
     begin
      m:=m-1;//просто уменьшаем число столбцов
      j:=j-1;//к следующему
     end
    else//иначе
     begin
      for i:=1 to n do//всем элементам столбцов
      for p:=j to m-1 do//от данного до предпоследнего
      a[i,p]:=a[i,p+1];//присваиваем значения соседа справа
      m:=m-1;//этот столбец исчезает, уменьшаем размер
     end;
   end
  else j:=j-1;//если не все положительные, дальше
 end;
if m=0  then write('Все столбцы удалены!')
else if f=0 then write('Столбцов только с положительными элементами нет!')
else
 begin
  writeln('Удалены столбцы из положительных элементов:');
  for i:=1 to n do
   begin
    for j:=1 to m do
    write(a[i,j]:4);
    writeln;
   end;
 end;
readln
end.

Следующий вариант

uses crt;
const nmax=20;
type matr= array[1..nmax,1..nmax] of integer;
Procedure DelPol(var a:matr;m,n:byte);
var i,j,f,p,k,kp:byte;
begin
j:=m;//начнем с последнего столбца
f:=0;//пока столбцов для удаления нет
while (j>=1)and(m>0) do//пока есть столбцы
 begin
  k:=0;//количество положительных
  for i:=1 to n do
  if a[i,j]>0 then k:=k+1;//считаем
  if k=n then//если все
   begin
    f:=1;//фиксируем удаление
    if j=m then//если столбец последний
     begin
      m:=m-1;//просто уменьшаем число столбцов
      j:=j-1;//к следующему
     end
    else//иначе
     begin
      for i:=1 to n do//всем элементам столбцов
      for p:=j to m-1 do//от данного до предпоследнего
      a[i,p]:=a[i,p+1];//присваиваем значения соседа справа
      m:=m-1;//этот столбец исчезает, уменьшаем размер
     end;
   end
  else j:=j-1;//если не все положительные, дальше
 end;
if m=0  then write('Все столбцы удалены!')
else if f=0 then write('Столбцов только с положительными элементами нет!')
else
 begin
  writeln('Удалены столбцы из положительных элементов:');
  for i:=1 to n do
   begin
    for j:=1 to m do
    write(a[i,j]:4);
    writeln;
   end;
 end;
end;
var a:matr;
    m,n,i,j:byte;
begin
clrscr;
randomize;
repeat
write('Количество строк до ',nmax,' n=');
readln(n);
until n in [1..nmax];
repeat
write('Количество столбцов до ',nmax,' m=');
readln(m);
until m in [1..nmax];
writeln('Исходная матрица:');
for i:=1 to n do
 begin
   for j:=1 to m do
    begin
     a[i,j]:=random(30)-5;
     write(a[i,j]:4);
    end;
   writeln;
 end;
writeln;
DelPol(a,m,n);
readln
end.

Leave a Comment

− 2 = 5