uses crt;
const max=20;
type stb=array[1..max] of integer;//1 столбец
matr=array[1..max] of stb;//массив столбцов=матрица
procedure Sort(var s:stb;m:byte);//сортировка столбца
var i,j:byte;
b:integer;
begin
for i:=1 to m-1 do
for j:=i+1 to m do
if s[i]>s[j] then**по возрастаеию, хотя это без разницы
begin
b:=s[i];
s[i]:=s[j];
s[j]:=b;
end;
end;
function Ravn(s1,s2:stb;n:byte):boolean;//проверка на равность
var i:byte;
f:boolean;
begin
f:=true;
i:=1;
while (i<=n) and f do
if s2[i]<>s1[i] then f:=false//если не совпал элемент
else i:=i+1;
Ravn:=f;
end;
var a:matr;
x,y:stb;
m,n,i,j,k,p:byte;
begin
clrscr;
randomize;
repeat
write('Количество строк до ',max,' n=');
readln(n);
until n in [1..max];
repeat
write('Количество столбцов до ',max div 2,' m=');
readln(m);
until m in [1..max div 2];
writeln('Введите элементы последнего столбца:');
for i:=1 to n do
begin
write('a[',m,',',i,']=');
readln(a[m,i]);
end;
writeln('Введите элементы остальных столбцов:');
for j:=1 to m-1 do
for i:=1 to n do
begin
write('a[',j,',',i,']=');
readln(a[j,i]);
end;
clrscr;
writeln('Исходная матрица:');
for i:=1 to n do
begin
for j:=1 to m do
write(a[j,i]:4);//вывод транспонировано по строкам
writeln;
end;
j:=1;p:=0;//начнем с первого
while j<=m-1 do//пока не предпослебний
begin
x:=a[m];//последний на данный момент столбец
Sort(x,n);//сортируем
y:=a[j];//текущий
Sort(y,n);//сортируем
if Ravn(x,y,n) then//сравниваем
begin
m:=m+1;//если равны, добавляем столбец
p:=1;//фиксируем наличие совпадений
x:=a[j];//запомним столбец
for k:=m downto j+2 do//сдвинем вправо на 1
for i:=1 to n do
a[k,i]:=a[k-1,i];
a[j+1]:=x;//вставим столбец
j:=j+2;//перешагнем
end
else j:=j+1;//иначе вперед
end;
if p=0 then write('Столбцов-перестановок последнего нет!')
else
begin
writeln('Дублирование столбцов:');
for i:=1 to n do
begin
for j:=1 to m do
write(a[j,i]:4);//вывод по строкам
writeln;
end;
end;
readln
end.