Найдите самую длинную возрастающую подпоследовательность.

uses crt;
type vector=array[1..100] of integer;
var k,n,i,j,q,t:integer;
        a,b,p:vector;
procedure cnk(m,l:integer);
var i:integer;
begin
writeln;
  if m=0 then begin
   for j:=1 to k do
   write(p[j],' ');
  end
  else
  for i:=l to n-m+1 do
  begin
   p[k-m+1]:=a[i];
   cnk(m-1,i+1)
  end;
end;
 
begin
  writeln ('Подмножества из N по K');
  writeln ('Введите N,K:');
  read(n);
  for i:=1 to n do
  begin
    a[i]:=random(10);
    write(a[i],' ');
    end;
    k:=1;
    repeat
 
    k:=k+1;
    writeln;
 
for j:=1 to k do
for t:=2 to k do
if p[j]<=p[j+1] then
begin
inc(q);
for j:=1 to q do
b[j]:=p[j];
end;
      cnk(k,1);
 
    until(k>n);
 
 
end.

l:=1;    // инициализация, минимально возможная длина последовательности
lmax:=1;         // минимально возможная максимальная длина
for i:=2 to n do
  if a[i-1]<=a[i] then Inc(l)  // если возрастание, то увеличиваем l
  else begin                  // если убывание ..
    if l>lmax then lmax:=l;   // .. то проверяем, не превышен ли старый рекорд, и обновляем его
    l:=0            // обнуляем длину (для подсчета новых подпоследовательностей)
  end
end;
if l>lmax then lmax:=l;    // в самом конце - еще одна проверка, иначе последняя посл. выпадет из рассмотрения

uses crt;
const nmax=100;
var a:array[1..nmax] of integer;
      i,j,n,k,p1,max:byte;
begin
clrscr;
repeat
write('Размер массива от 2 до ',nmax,' n=');
readln (n);
until n in [2..nmax];
writeln('Введите ',n,' элементов массива:');
for i:=1 to n do
readln (a[i]);
clrscr;
writeln('Массив:');
for i:=1 to n do
write(a[i],' ');
writeln;
writeln;
{Поиск позиции и длины максимальной цепи}
max:=0;{Первоначальные значения}
i:=2;p1:=0;
while i<=n do
if a[i]>a[i-1] then
  begin
   k:=1;j:=i;
   while (a[j]>a[j-1])and(j<=n) do
    begin
     inc(j);
     inc (k); {Если возрастает - наращиваем счётчик}
    end;
   if k>max then
    begin
     max:=k;
     p1:=i-1;
    end;
   i:=i+k;{перепрыгиваем}
  end
else inc(i);
writeln; {Выводим результат}
if max=0 then write('Участков возрастания нет!')
else
 begin
  writeln('Максимальная длина=',max);
  for i:=p1 to p1+max-1 do
  write (a[i],' ');
 end;
readln
end.

type
  PIntArr = ^TIntArr;
  TIntArr = array [0..$FFFE div SizeOf(Integer)-1] of Integer;
 
procedure LongestIncSubseq(
  na: Integer; const  a: array of Integer; 
  var nb: Integer; var b: array of Integer);
var
  prv, lst: PIntArr;
  i, l, r, m: Integer;
begin;
  GetMem(prv,na*SizeOf(Integer));
  GetMem(lst,na*SizeOf(Integer));
  nb:=-1;
  for i:=0 to na-1 do begin;
    l:=0; r:=nb;
    while l<=r do begin
      m:=l+(r-l) div 2;
      if a[i]<=a[lst^[m]] then r:=m-1 else l:=m+1;
    end;
    if r>=0 then r:=lst^[r];
    prv^[i]:=r; lst^[l]:=i;
    if nb<l then nb:=l;
  end;
  m:=lst^[nb]; Inc(nb);
  for i:=nb-1 downto 0 do begin
    b[i]:=m; m:=prv^[m];
  end;
  FreeMem(lst,na*SizeOf(Integer));
  FreeMem(prv,na*SizeOf(Integer));
end;
 
const
  na=16;
  a: array [0..na-1] of Integer = (1,2,3,7,4,6,5,5,6,4,7,3,8,2,9,1);
var
  b: array [0..na-1] of Integer;
  i, nb: Integer;
begin
  LongestIncSubseq(na,a,nb,b);
  for i:=0 to nb-1 do Write(' ',a[b[i]]); WriteLn;
end.

  b[i]:=a[m]; ...

... Write(' ',b[i]); ...