Разработать алгоритм формирования всех разбиений 6 элементного множества - Pascal

program razbien;
uses crt;
const NN=100;
type arr=array[1..NN] of integer;
 
procedure vivod(a,b:arr;n,kol:integer);
var
 i,k,t:integer;
begin
 for k:=1 to n-1 do
  for i:=1 to n-k do
   if(b[i]>b[i+1]) then
    begin
     t:=b[i];
     b[i]:=b[i+1];
     b[i+1]:=t;
     t:=a[i];
     a[i]:=a[i+1];
     a[i+1]:=t;
    end;
 t:=1;
 for i:=2 to n do
  if b[i]<>b[i-1] then inc(t);
 
 if(kol=t) then
  begin
 write('(',a[1]);
 for i:=2 to n do
  if b[i]<>b[i-1] then
   write(') (',a[i])
  else
   write(' ',a[i]);
 writeln(')');
  end;
end;
 
{функциия расчета числа Стирлинга второго рода - число неупорядоченных разбиений 
n-элементного множества на k непустых подмножеств }
function Stirling2rec(n,k:integer):longint;
begin
 if n=k then
  Stirling2rec:=1
 else
  if(k=0) then Stirling2rec:=0
  else Stirling2rec:=Stirling2rec(n-1,k-1)+k*Stirling2rec(n-1,k);
end;
 
}
var
 a,
 Prev, {номер предыдущего блока}
 Next, {номер следующего блока: Next[I]=0, если блок I является последним блоком разбиения}
 Blok:arr; {номер текущего блока}
 j,i, {минимальный элемент текущего блока}
 n,k,kol:integer;
 Forw:array[1..NN] of boolean; {направление в котором движется элемент I, =true, если движется вперёд}
 
 
begin
 clrscr;
 write('Введите количество элементов множества: ');
 readln(n);
 write('Введите количество подмножеств для разбиения множества: ');
 readln(kol);
{ s:=Stirling2rec(n,k);
 writeln(s);           }
 {инициализация исходного множества}
 for i:=1 to n do
  begin
   a[i]:=i;
   Blok[i]:=1;
   Forw[i]:=true;
  end;
  Next[1]:=0;
  {вывести разбиение}
  vivod(a,Blok,n,kol);
  j:=n; {j=активный элемент}
  while j>1 do
   begin
    k:=Blok[j];
    if Forw[j] then {j движется вперёд}
     begin
      if Next[k]=0 then {k есть последний блок}
       begin
        Next[k]:=j;
        Prev[j]:=k;
        Next[j]:=0;
       end;
      if Next[k]>j then {j образует новый блок}
       begin
         Prev[j]:=k;
         Next[j]:=Next[k];
         Prev[Next[j]]:=j;
         Next[k]:=j;
       end;
      Blok[j]:=Next[k];
     end
    else {j движется назад}
     begin
      Blok[j]:=Prev[k];
      if k=j then {j образует одноэлементный блок}
       if Next[k]=0 then
         Next[Prev[k]]:=0
       else
        begin
         Next[Prev[k]]:=Next[k];
         Prev[Next[k]]:=Prev[k];
        end
     end;
    {выписать разбиение}
    vivod(a,Blok,n,kol);
    j:=n;
    while (j>1) and
     ( (Forw[j] and (Blok[j]=j)) or (not Forw[j] and (Blok[j]=1)) ) do
      begin
        Forw[j]:=not Forw[j];
        j:=j-1;
      end;
   end;
readkey;
end.