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.