type Taction = (acComb,acPerm,acPart);
     Taa     = array[1..50] of byte;

var action   : Taction = acComb;
    elements : Taa;
    partList : Taa;             //make next partition until = elements
    pmax     : byte;            //scratch for partitions
    faculties : array[0..12] of longInt;
    number   : byte;
    choices  : byte;
    rank     : longInt;
    maximum  : boolean = false;
   

function C(n,k : byte) : longInt;
//calculate combinations k of n
var i   : byte;
    tt,nn : double;
begin
 if (k = 0) or (k = n) then
  begin
   result := 1; exit;
  end;
//--
 if 2*k > n then k := n - k;
 tt := 1; nn := 1;
 try
  for i := 0 to k-1 do
   begin
    tt := tt * (n-i);
    nn := nn * (k-i);
   end;
  result := trunc(tt/nn);
 except
  result := 0;
 end;
end;

procedure newComb;
var r,comb    : longInt;
    i,n,k     : byte;
    elList    : array[1..50] of byte;
    endrepeat : boolean;
begin
 if Checkelements then exit;
 if checkChoices then exit;
 if CheckRank then exit;
//----
 r := rank;
 k := 1;
 if rank = C(number,choices)-1 then maximum := true
  else maximum := false;
 clearelements(elements);
 for i := 1 to 50 do ElList[i] := i;
//----
 for n := 1 to choices do
  begin
   endrepeat := false;
   repeat
    comb := C(number-k,choices-n);
    if r >= comb then
     begin
      inc(k);
      r := r - comb;
     end
    else endrepeat := true; ;
   until endrepeat;
   elements[n] := ElList[k];
   inc(k);
  end;//for n
//---
 ShowElements(choices);
end;

procedure newCombRank;
//calulate rank from combination
var i,j,min : byte;
begin
 if checkelements then exit;
 if getCombination then exit;
 if checkchoices then exit;
//--
 for i := 1 to choices do
  if (elements[i] = 0) or (elements[i] > number) then
   begin
    post(16);
    exit;
   end;
//--
 for i := 1 to choices-1 do
  if elements[i] = elements[i+1] then
   begin
    post(17);
    exit;
   end;
//--
 min := 1;
 rank := 0;
 for i := 1 to choices do
  begin
   for j := min to elements[i]-1 do
    rank := rank + C(number-j,choices-i);
   min := elements[i]+1;
  end;
//--
 form1.edit4.text := inttostr(rank);
 post(6);
end;

procedure newPerm;
//make permutation from number, rank
var i,k,x : byte;
    r : longInt;
    list : array[1..12] of byte;
begin
 if CheckElements then exit;
 if CheckRank then exit;
//-----
 r := rank;
 if rank = faculties[number]-1 then maximum := true
  else maximum := false;
 clearElements(elements);
 for i := 1 to 12 do list[i] := i;
//--
 for i := 1 to number do
  begin
   x := r div faculties[number-i] + 1;
   r := r mod faculties[number-i];
   elements[i] := list[x];
   for k := x to 11 do list[k] := list[k+1];
  end;
//--
 ShowElements(number);
end;

procedure newPermRank;
var i,j : byte;
    list : array[1..12] of byte;
begin
 if checkelements then exit;
 if GetPermutation then exit;
//--
 for i := 1 to 12 do list[i] := i;
 rank := 0;
 for i := 1 to number do
  begin
   j := 1;
   while elements[i] <> list[j] do inc(j);
   rank := rank + (j-1)*faculties[number-i];
   for j := j to 11 do list[j] := list[j+1];
  end;
 form1.edit4.text := inttostr(rank);
 post(6);
end;

procedure newPart;
var n : longInt;
    max,min,acc : byte;
    s : string;
begin
 if CheckElements then exit;
 if CheckRank then exit;
//--
 clearElements(elements);
 maximum := false;
 elements[1] := number;
 max := 1;
 for n := 1 to rank do
  begin
   acc := 0;
   while (max > 0) and (elements[max] = 1) do
    begin
     dec(max);
     inc(acc);
    end;
   if elements[1] = 1 then
    begin
     maximum := true;
     rank := n-1;
     form1.edit4.text := inttostr(rank);
     showElements(number);
     exit;
    end;
//-----
   dec(elements[max]);
   inc(acc);
   min := elements[max];
   while acc > 0 do
    begin
     inc(max);
     if acc >= min then
      begin
       elements[max] := min;
       acc := acc - min;
      end
     else
      begin
       elements[max] := acc;
       acc := 0;
      end;
    end;//while
  end;//for
 ShowElements(max);
end;

procedure NextPartition;
//generate next partition in partlist
var n : longInt;
    min,acc : byte;
    s : string;
begin
 acc := 0;
 while (pmax > 0) and (partlist[pmax] = 1) do
  begin
   dec(pmax);
   inc(acc);
  end;
 dec(partlist[pmax]);
 inc(acc);
 min := partlist[pmax];
 while acc > 0 do
  begin
   inc(pmax);
   if acc >= min then
    begin
     partlist[pmax] := min;
     acc := acc - min;
    end
   else
    begin
     partlist[pmax] := acc;
     acc := 0;
    end;
  end;//while
end;

procedure newPartRank;
var i,count,sum : byte;
begin
 if GetPartition(count) then exit;
 if checkelements then exit;
 for i := 2 to 50 do partlist[i] := 0;
 partlist[1] := number;
 pmax := 1;
 rank := 0;
//--
 repeat
  sum := 0;
  for i := 1 to count do
   if partlist[i] = elements[i] then inc(sum)
    else break;
  if sum <> count then
   begin
    inc(rank);
    NextPartition;
   end;
 until sum = count;
 form1.Edit4.text := inttostr(rank);
 post(6);
end;