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

[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.

[volvo]

При решении задач на практике часто приходится выбирать из некоторого множества объектов какие-либо подмножества, обладающие заданными свойствами, размещать элементы в определенном порядке и т.д. Такие задачи называются комбинаторными. Классическими задачами комбинаторики являются задачи о перестановках, выборках, сочетаниях.

Перестановки
Перестановки описывают, сколькими способами можно расставить N различных предметов на N различных позиций.

Число перестановок принято обозначать Pn. N различных элементов можно расставить на N различных мест N! способами. Следовательно, Pn = N! = 1*2*… *(N-1)*N.

Также важной задачей является не только подсчет количества перестановок, но и их генерация, при этом больший интерес представляет генерация перестановок в определенном порядке, например, лексикографическом (отсортированном по возрастанию).

Рассмотрим задачу генерации всех перестановок N-элементного множества в лексикографическом порядке. В качестве примера рассмотрим перестановку для N=3

1 2 3
1 3 2
2 1 3
2 3 1
3 1 2
3 2 1

Алгоритм генерации следующей перестановки таков: начиная с конца перестановки находим такой элемент a[i]: a[i-1]<a[i]; затем в конце перестановки находим элемент a[j] больший чем a[i-1]; далее меняем местами элементы перестановки a[i-1] и a[j]; и оставшуюся конечную часть перестановки упорядочиваем в порядке возрастания.

{ программа генерации перестановок N элементного 
  множества в лексикографическом порядке }

Program perms;
var
  i, j, h, n, k: integer;
  a:array[0 .. 100] of integer;  { массив для хранения перестановки }

{процедура вывода полученной перестановки}
procedure output;
var i: integer;
begin
  writeln;
  for i:=1 to n do write(a[i],' ');
end;

begin
  write('количество элементов перестановки: '); readln(n);
  fillchar(a, sizeof(a), 0);

  { ввод элементов начальной перестановки }
  for i:=1 to n do a[i]:=i;

  repeat
    output;  { вывод текущей перестановки }
    i:=n;
    while a[i-1]>a[i] do dec(i); { поиск скачка }
    j:=i-1;
    h:=a[j];
    while a[i+1]>h do inc(i); { поиск первого меньшего элемента }
    a[j]:=a[i];  a[i]:=h;
    i:=j+1; k:=n;
    while i<k do begin { перестановка ”хвоста” }
       h:=a[i]; a[i]:=a[k]; a[k]:=h;
       inc(i); dec(k)               
    end
  until j=0;
end.

Для получения всех n! перестановок необходимо, чтобы начальная перестановка образовывала возрастающую последовательность (то есть была первой в лексикографическом порядке). Следует прокомментировать следующие два момента: почему условием окончания работы программы является выполнение равенства j=0 и почему для упорядочивания хвоста перестановки используется простой цикл без всяких сравнений.

1. Следуя логике алгоритма, последняя перестановка представляет собой убывающую последовательность. Следовательно, позиция скачка будет равна 1 и соответственно j=0. Ни в каком другом случае равенство j=0 не выполняется, так как тогда перестановка не будет убывающей последовательностью, то есть не является последней.
   
2. Об упорядочивании хвоста следует сказать только одно: хвост всегда представляет убывающую последовательность, поэтому требуется его только инвертировать.

Сочетания
Задачи о сочетаниях решают вопрос о том, сколькими способами можно выбрать M элементов из заданного N элементного множества и генерации всех возможных выборок. Число выборок вычисляется следующей формулой С=n!/(m!(n - m)!).

Рассмотрим задачу о генерации сочетаний в лексикографическом порядке.
Для примера рассмотрим начальные данные N=6 и M=4. Тогда число сочетаний равно 15. Начальное сочетание образует последовательность 1, 2, .. m, а последнее n-m+1, … , n.

1234 1256 2345
1235 1345 2346
1236 1346 2356
1245 1356 2456
1246 1456 3456

Переход к следующему сочетанию осуществляется по следующему правилу: требуется просмотреть текущее сочетание с конца и найти элемент, который можно увеличить. То есть такой элемент что a[i] <> n-k+i. Далее увеличиваем этот элемент на 1, а оставшуюся часть сочетания заполняем числами натурального ряда большими измененного элемента в порядке их следования.

program sochets;
var
  i, j, n, m: integer;
  a: array[0 .. 100] of integer;

{ процедура вывода текущего сочетания }
procedure use;
var i: integer;
begin
  writeln;
  for i:=1 to m do write(a[i]:3)
end;

begin
  write('ввод N и M: '); read(n, m);

  { формирование первого сочетания }
  for i:=0 to m do a[i]:=i;

  repeat
    use;
    i:=m;
    while a[i]=n-m+i do dec(i); { поиск элемента для изменения }
    inc(a[i]);
    for j:=i+1 to m do a[j]:=a[j-1]+1; { изменение правой части сочетания }
  until i=0;
end.

Рекурсивный алгоритм генерации сочетаний (с повторениями):

const
  n = 3;
  k = 2;

procedure s_pov(s: string);
var i: integer;
begin
  if length(s) = n then begin
    for i := 1 to length(s) do
      write(s[i] + ' ');
    writeln;
  end
  else
    for i := k downto 1 do
      s_pov(s+chr(ord('0') + i));
end;

begin
  s_pov('');
end.

Подмножества
Для генерации всех подмножеств N-элементного множества: введем массив b[1..n] такой, что если b[i]=1 то i-й элемент входит в подмножество и если b[i]=0, то иначе. Тогда пустому подмножеству будет соответствовать набор из 0, а n-элементному подмножеству набор из 1. Поэтому здесь явно заметна связь с двоичным представление чисел в интервале 0 … 2N–1.

Будем находить двоичное представление числа и формировать характеристические вектора подмножеств. Изначально положим b[i]=0 для всех I, что соответствует пустому подмножеству. Введем массив a[1..n] соответствующий двоичному представлению числа. Будем моделировать операцию сложения этого числа с 1. Для этого просмотрим число справа налево, заменяя единичные биты на нулевые до тех пор, пока не найдем нулевой бит, который заменим на 1.

program subsets;
var
  i, n: integer;
  a, b: array[0..100] of integer;

procedure output;
var i : integer;
begin
  { вывод двоичного числа }
  for i:=1 to n do write(' ',a[i]);
  write('    ');

  { вывод характеристического вектора подмножества }
  for i:=1 to n do write(' ',b[i]);
  write('    ');

  { вывод подмножества }
  for i:=1 to n do
    if(b[i]=1) then write(' ',i);
end;

begin
  readln(n);
  fillchar(a,sizeof(a),0);
  fillchar(b,sizeof(b),0);
  repeat
    output;
    i:=n;
    while a[i]=1 do begin
      a[i]:=0; dec(i); { перенос в следующий разряд }
    end;
    a[i]:=1;
    b[i]:=1-b[i] { b[i] = (1+b[i]) mod 2 }
  until i=0;
end.

[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.