Отсортировать строки матрицы по возрастанию количества одинаковых элементов в каждой строке

uses crt;
type Tmatr=array[1..20,1..20]of integer;
function KolOdin(x,y:integer;a:Tmatr):integer;//функция подсчета одинаковых в строках
var i,j,k,t,l:integer;             //параметры х-номер строки, у-длина строки(размер матрицы, если квадратная)
begin
i:=1;t:=0;
while i<=y do
   begin
    k:=1;
    for j:=y downto i+1 do //смотрим строку с конца до числа которое проверяем+1
    if a[x,j]=a[x,i] then  //если находим одинаковое
      begin
        k:=k+1;  //считаем его
        for l:=j to y-1 do //сдвигом влево удаляем его
        a[x,l]:=a[x,l+1];
        y:=y-1; //уменьшаем длину строки
      end;
    if k>1 then t:=t+k; //если число больше раза, прибавляем его к общему количеству
    i:=i+1; //переходим к следующему числу
   end;
KolOdin:=t; //значение функции
end;
var a:Tmatr;  //раздел переменных основной программы
    n,i,j,l,x:integer;
begin
clrscr;
write('Vvedite razmernost matricy n= ');readln(n);
randomize;
Writeln('Matrica:');
for i:=1 to n do
   begin
     for j:=1 to n  do
       begin
         a[i,j]:=random(5);
         write(a[i,j]:4);
       end;
     writeln;
   end;
for i:=1 to n do
a[i,n+1]:=KolOdin(i,n,a);//в дополнительный столбец справа заносим значения количеств одинаковых чисел
for i:=1 to n-1 do
for l:=1 to n-1 do
if a[l,n+1]>a[l+1,n+1] then //переставляем строки по возрастанию в последнем столбце
    begin
      for j:=1 to n+1 do
        begin
          x:=a[l,j];
          a[l,j]:=a[l+1,j];
          a[l+1,j]:=x;
       end;
    end;
writeln('Rezultat:                 kol');//выводим результат с количествами(можно убрать)
for i:=1 to n do
    begin
      for j:=1 to n+1 do //если убрать, for j:=1 to n do 
      write(a[i,j]:4);
      writeln;
    end;
readln
end.

program Project2;
 
var d:array[1..30,1..30] of integer;
    i,j,l,k,n,sum:integer;
    x,y:integer;
    m:boolean;
begin
     WriteLn('vvedi x(strok) and y(stolbcov)=');
     ReadLn(x,y);
 
    for n:=1 to x do
    for i:=1 to y do
      begin
         Write('d[',n,',',i,']=');
         Readln(d[n,i]);
      end;
 
for n:=1 to x do
begin
  l:=1;
  sum:=0;
   for i:=1 to y do
     begin
        if i<>y then
          for j:=i+1 to y do
             if d[n,i]=d[n,j] then
               begin
                 m:=false;
                   if i<>1 then
                    begin
                     for k:=1 to i-1 do
                       if d[n,k]=d[n,i] then
                        m:=true;
                    end;
                  if m<>true then
                   l:=l+1;
               end;
       if l<>1 then
       sum:=sum+l;
       l:=1;
     end;
d[n,y+1]:=sum;
end;
 
for i:=1 to x-1 do
for j:=1 to x-1 do
  begin
    if d[j,y+1]<d[j+1,y+1] then
      begin
           for k:=1 to y+1 do
             begin
             d[x+1,k]:=d[j,k];
             d[j,k]:=d[j+1,k];
             d[j+1,k]:=d[x+1,k];
             end;
      end;
  end;
{если поставить y+1 то моно посмотреть
значения одинаковых чисел в каждой строке}
    for n:=1 to x do
    for i:=1 to y do
      if i<>y then
        Write(d[n,i],' ')
      else
        WriteLn(d[n,i]);
ReadLn;
end.

program Project2;
 
var d:array[1..30,1..30] of integer;
    i,j,l,k,n,sum:integer;
    x,y,minus:integer;
    m:boolean;
begin
     WriteLn('vvedi x(strok) and y(stolbcov)=');
     ReadLn(x,y);
 
    for n:=1 to x do
    for i:=1 to y do
      begin
         Write('d[',n,',',i,']=');
         Readln(d[n,i]);
      end;
 
for n:=1 to x do
begin
  l:=1;
  sum:=0;
   for i:=1 to y do
     begin
        if i<>y then
          for j:=i+1 to y do
             if d[n,i]=d[n,j] then
               begin
                 m:=false;
                   if i<>1 then
                    begin
                     for k:=1 to i-1 do
                       if d[n,k]=d[n,i] then
                        m:=true;
                    end;
                  if m<>true then
                   l:=l+1;
               end;
       if l<>1 then
       sum:=sum+l;
       l:=1;
     end;
d[n,y+1]:=sum;
end;
 
for i:=1 to x-1 do
for j:=1 to x-1 do
  begin
    if d[j,y+1]>d[j+1,y+1] then
      begin
           for k:=1 to y+1 do
             begin
             d[x+1,k]:=d[j,k];
             d[j,k]:=d[j+1,k];
             d[j+1,k]:=d[x+1,k];
             end;
      end;
  end;
{если поставить y+1 то моно посмотреть
значения одинаковых чисел в каждой строке}
WriteLn;
    for n:=1 to x do
    for i:=1 to y do
      if i<>y then
        Write(d[n,i],' ')
      else
        WriteLn(d[n,i]);
WriteLn;
 
{тут находим положительный столбик}
    minus:=-1;
    i:=0;
     repeat
        i:=i+1;
         for n:=1 to x do
          begin
             if (d[n,i]<0) then
              minus:=i;
          end;
             if minus=-1 then
              begin
                 minus:=i;
                 i:=y;
              end
             else
              begin
                minus:=-1;
              end;
     until i=y;
   if minus<>-1 then
     WriteLn('stolbec=',minus)
   else
     WriteLn('netu');
ReadLn;
end.