Использовать подпрограммы (ввода, вывода, обрабатывающей части). Дан массив целых чисел А[M,N], где M,N<=10. Удалить столбцы, в которых есть минимальный элемент - Pascal(Паскаль)

uses crt;
const nmax=20;
type mas=array[1..nmax,1..nmax] of integer;
procedure Vvod(var a:mas;var n,m:byte);
var i,j:byte;
begin
repeat
write('Количество строк до ',nmax,' n=');
readln(n);
until n in [1..nmax];
repeat
write('Количество столбцов до ',nmax,' m=');
readln(m);
until m in [1..nmax];
for i:=1 to n do
for j:=1 to m do
a[i,j]:=random(10);
end;
procedure Vyvod(var a:mas;n,m:byte);
var i,j:byte;
begin
for i:=1 to n do
 begin
  for j:=1 to m do
  write(a[i,j]:3);
  writeln;
 end;
writeln;
end;
function Min(a:mas;n,m:byte):integer;
var i,j:byte;
    mn:integer;
begin
mn:=a[1,1];
for i:=1 to n do
for j:=1 to m do
if a[i,j]<mn then mn:=a[i,j];
Min:=mn;
end;
procedure Udal(var a:mas;n:byte;mn:integer;var m:byte);
var i,j,f,k,p:byte;
begin
f:=m;{начнем с конца}
for j:=m downto 1 do
 begin
  k:=0;
  for i:=1 to n do
  if a[i,j]=mn then k:=1;{если есть мин.}
  if k=1 then
   begin
    if j=f then{последний на данный момент}
      begin
       m:=m-1;
       f:=f-1;
      end
    else {если не последний}
     begin
      for k:=j to m-1 do
      for p:=1 to n do
      a[p,k]:=a[p,k+1];
      m:=m-1;
     end;
   end;
 end;
end;
var a:mas;
    b:array[1..9] of byte;
    m,n,i,j,f,p,k:byte;
begin
clrscr;
randomize;
Vvod(a,n,m);
writeln('Исходная матрица:');
Vyvod(a,n,m);
writeln('Минимальный элемент=',Min(a,n,m));
Udal(a,n,Min(a,n,m),m);
if m=0 then writeln('Все столбцы удалены!')
else
 begin
  writeln('Матрица после сжатия:');
  Vyvod(a,n,m);
 end;
readln
end.

Leave a Comment

19 − = 11