Комбинаторика Опции

[Altair]

Код

Function Accomodations(N,K:Longint):Longint;
var i,Result:longint;
begin
  Result:=1;
  For i:=n downto (n-k+1) do result:=result*i;
  Accomodations:=result
end;

Function Transpositions(N:longint):Longint;
begin
  Transpositions:=Accomodations(N,N)
end;

Function Combination(N,K:Longint):Longint;
var numerator,denominator,i:longint;
begin
  numerator:=1; denominator:=1;
  for i:=N downto (N-K+1) do numerator:=numerator*i;
  for i:=1 to K do denominator:=denominator*i;
  Combination:=numerator div denominator
end;

procedure BinomialTheorum(N:longint);
var K,T,SA,SB:Longint;
begin
  writeln;
  for K:=0 to n do
  begin
    SA:=n-k; SB:=k;
    T:=Combination(N,K);
    If T>1 then write(T);
    If SA=1 then write('A');
    If SA>1 then write('A^',SA);
    If SB=1 then write('B');
    If SB>1 then write('B^',SB);
    If k<>n then write(' + ');
  end;
  writeln
end;

begin
BinomialTheorum(3);
writeln(Combination(14,7));
writeln(Accomodations(14,5));
writeln(Transpositions(3));
end.

Function Accomodations(N,K:Longint):Longint;
Вычисление размещений из N по К.
(число размещений из N по K есть число К-элементных упорядоченных подмножеств множества, содержащего N элементов.)
Function Transpositions(N:longint):Longint;
Вычисление числа перестановок. (A из n по n)
Function Combination(N,K:Longint):Longint;
Вычисление сочетаний из N по K. (k элементные подмножества множества, содержащего N элементов.)
procedure BinomialTheorum(N:longint);
Выводит на экран разложение (a+b)^n. по формуле Ньютона.
Входной паарметр - N.

[samec]

Генерация разбиений n-элементного множества на k блоков.
Разбиение множества (1,…,n) мы будем представлять с помощью последовательности блоков, упорядоченной по возрастанию самого маленького элемента в блоке. Например (для множества из 4 элементов, разбиение на три подмножества):
( 1 2 ) ( 3 ) ( 4 )
( 1 4 ) ( 2 ) ( 3 )
( 1 ) ( 2 4 ) ( 3 )
( 1 ) ( 2 ) ( 3 4 )
( 1 ) ( 2 3 ) ( 4 )
( 1 3 ) ( 2 ) ( 4 ) (в каждом блоке элементы упорядочены по возрастанию)
Этот наименьшей элемент блока мы будем называть номером блока. Надо заметить, что номера соседних блоков совсем не обязательно являются соседними натуральными числами, например для блоков: ( 1 2 ) ( 3 ) ( 4 ), номера каждого блока будут: 1, 3 и 4.
В этом алгоритме мы будем использовать переменные Prev[i], Next[i], 1<=i<=n, содержащие соответственно номер предыдущего и номер следующего блока, для блока с номером i. (Next[i]=0, если блок с номером i является последним блоком разбиения) Например для разбиения ( 1 2 ) ( 3 ) ( 4 ) эти переменные будут выглядеть следующим образом: Prev[0,1,3], Next[3,4,0].
Для каждого элемента I, 1<=i<=n, номер блока, содержащего элемент i, будет храниться в переменной Blok[i], например для разбиения ( 1 2 ) ( 3 ) ( 4 ) – Blok[1,1,2,3], а для разбиения ( 1 3 ) ( 2 ) ( 4 ) – Blok[1,2,1,3].
Направление, в котором «движется» элемент I, будет находиться в переменной Forw[i] (Forw[i]==1, если I, движется вперед, Forw[i]==0, если I, движется назад).

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.