Комбинаторика

Все подмножества данного множества

Допустим, что у нас есть множество S, состоящее из элементов a₁, a₂, …, a_N, т.е.
S = {a_N, a₂, …, a_N}
Для простоты можно считать, что a₁, .. a_N - это различные целые числа от 1 до N.
Подмножеством данного множества S называется множество S', которое содержит некоторые элементы из S (не обязательно все). У множества из N элементов будет ровно 2^N различных подмножеств. Получить их все можно как минимум тремя различными способами.

1-й способ

Для примера возьмем N = 3. Запишем все числа от 0 до 2^N - 1 = 7 в двоичной системе счисления:

Если на i-той позиции в двоичной записи стоит 1, то i-тый элемент входит в подмножество, иначе - не входит. Поэтому данный алгоритм можно реализовать так:

Var N : Longint;
    Count : Longint;
    I : Longint;
 
Procedure PrintSet(X : Longint);
Var P : Integer;
Begin
 Write('{ ');
 P:=N;
 While X <> 0 Do
  Begin
   If X Mod 2 = 1 Then Write(P, ' ');
   Dec(P);
   X:=X Div 2;
  End;
 Writeln('}');
End;
 
Begin
 N:=5;
 Count:=1 Shl N; {2^N}
 For I:=0 To Count - 1 Do
  PrintSet(I);
End.

2-й способ

Допустим, что у нас уже есть можество S, причем про N элементов мы уже знаем, входят они в множество или нет. Из него можно получить еще 2 множества - то, которое содержит (N + 1)-й элемент, и то, которое (N + 1)-й элемент не содержит.
Получается рекурсивный алгоритм:

Function IntToStr(X : Longint) : String;
Var S : String;
Begin
 Str(S, X);
 IntToStr:=S;
End;
 
Procedure PrintSet(N : Integer; S : String);
Begin
 If (N = 0) Then
  Writeln('{ ', S, '}')
 Else
 Begin
  PrintSet(N - 1, S + ' ' + IntToStr(N));
  PrintSet(N - 1, S);
 End;
End;
 
Begin
 PrintSet(5);
End.

3-й способ

На самом деле, это вариация первого способа, но такой метод очень полезный.
Пусть у нас уже есть какое-то подмножество. Подумаем, как из него получить следующее (все подмножества будем записывать в определенном порядке).
Для определенности заведем массив, в котором будем хранить, какие элементы входят в данное подмножество. Начнем генерировать подмножества с пустого (т.е. в множестве нет ни одного элемента).
Допустим, что N = 5 и текущее подмножество {1, 2, 5} или в битовом представлении (1, 1, 0, 0, 1). Найдем первый 0 слева (если такого элемента не найдем, значит у нас «полное» множество, которое будет последним). Заменим этот 0 на 1, а все единицы слева - на нули.

Const MaxN = 100; {Максимальное число элементов в множестве}
Var Bits : Array[1..MaxN] Of Byte; {Массив битов}
    N : Longint;
    I : Longint;
Begin
 ReadLn(N); {Считываем, какого размера множество}
 For I:=1 To N + 1 Do Bits[I]:=0; {Сначала у нас пустое подмножество}
 While (Bits[N + 1] = 0) Do {Пока не все множество состоит из 1}
  Begin
   Write('{ '); {Выводим текущее подмножество}
   For I:=1 To N Do
    If Bits[I] = 1 Then Write(I, ' ');
   Writeln('}');
   I:=1; {Ищем следующее подмножество}
   While (Bits[I] = 1) Do
    Begin
     Bits[I]:=0;
     Inc(I);
    End;
   Bits[I]:=1;
  End;
End.

Перестановки

Как не сложно догадаться, что общее число перестановок из N элементов равно N! (действительно, на первое место можем поставить любое из N чисел, на всторое - любое из оставшихся N-1 и т.д.). Применим подход, как при генерации подмножеств.

1-й способ

Выберем порядок - по алфавиту (лексикографический) - т.е. первая перестановка - 1 2 3 .. N, а последняя -
N N-1 … 2 1

Рассмотрим пример.
Пусть N = 5 и текущая перестановка 1 4 3 5 2. Какая будет следующая перестановка?
Будем двигаться с конца. Найдем самое «правое» число (оно будет на i-ой позиции), которое больше передыдущего (другими словами надо найти самый длиный возрастающий «хвост»). Если мы такого числа не нашли, то у нас уже получена перестановка N N-1 … 2 1 - это последняя перестановка.
Теперь найдем самое «правое» число, большее i-того (допустим, оно на j-той позиции). Поменяем их местами. Осталось перевернуть хвост от i+1-й позиции до конца. И будет получена новая перестановка.

1 4 3 5 2    - было в начале
1 4 5 3 2    - меняем 3 и 5
1 4 5 2 3    - затем 3 и 2

Const MaxN = 10; {Максимальная длина перестановки}
Var Mas : Array[1..MaxN] Of Byte; {Массив с перестановкой}
    N : Longint;
    I, J, K : Longint;
Procedure WritePerm; {Вывод перестановки на экран}
Var I : Longint;
Begin
 For I:=1 To N Do Write(Mas[I], ' ');
 Writeln;
End;
 
Procedure _Swap(I, K : Longint); {Меняет два элемента с индексами I и K}
Var X : Byte;
Begin
 X:=Mas[I];
 Mas[I]:=Mas[K];
 Mas[K]:=X;
End;
 
Begin
 ReadLn(N);
 For I:=1 To N Do Mas[I]:=I; {Заполняем массив числами от 1 до N}
 While True Do
  Begin
   WritePerm; {Готова перестановка}
   I:=N; {Проверяем с конца}
   While (I > 0) And (Mas[I] >= Mas[I + 1]) Do Dec(I); {Пока числа расположены в возрастающем порядке, продолжаем}
   If I = 0 Then Break; {Все числа расположены в возрастающем порядке, значит, все перестановки получены}
   For J:=I + 1 To N Do  {Ищем самое правое число, больше найденного}
    If (Mas[J] > Mas[I]) Then
     K:=J;
   _Swap(I, K); {Меняем их}
   Inc(I); 
   J:=N;
   While (I < J) Do  {Переворачиваем хвост перестановки}
    Begin
     _Swap(I, J);
     Inc(I);
     Dec(J);
    End;
  End;
End.

2-й способ

Обычно именно этот метод приходит на ум первым. Пусть уже есть перестановка (3, 4, 2, 1). Из нее можно получить еще 5 перестановок, вставляя пятёрку в любое из 5 мест:

(5, 3, 4, 2, 1)
(3, 5, 4, 2, 1)
(3, 4, 5, 2, 1)
(3, 4, 2, 5, 1)
(3, 4, 2, 1, 5)

Так тоже мы получим все перестановки:

Const MaxN = 10; {Сколько цифр}
Type SMaxN = String[MaxN];
 
Procedure Permulate(N : Longint; S : SMaxN); {Сама процедура}
Var I : Longint;
    TmpS : SMaxN;
Begin
 If (N = MaxN) Then {Добавили последнюю цифру}
  Begin
   Writeln(S); {Новая перестановка в переменной S}
   Exit;
  End;
 For I:=0 To N Do {Добавляем еще по одной цифре(N) в каждое место}
  Begin
   TmpS:=S;
   Insert(Chr(Ord(N) + Ord('0')) ,TmpS, I + 1);
   Permulate(N + 1, TmpS); {Переход от шага N к шагу N+1}
  End;
End;
 
Begin
 Permulate(0, '');
End.

Сочетания

Сочетание - это выбор из N предметов нескольких (M), причем порядок не важен.
Из курса комбинаторики известно, что число сочетаний из N по M равно N!/(M! * (N - M)!)

Для примера, всего 10 сочетаний из 5 по 3: (1, 2, 3), (1, 2, 4), (1, 2, 5), (1, 3, 4), (1, 3, 5), (1, 4, 5), (2, 3, 4), (2, 3, 5), (2, 4, 5), (3, 4, 5)

Здесь снова приходит на помощь переход от одного сочетания к другому. Опять же будем записывать сочетания в лексикографическом порядке.
Пусть текущее сочетание из 6 по 4 (в данном варианте последнее сочетние - (3, 4, 5, 6)) будет (1, 2, 3, 6). Найдем с конца числа, которые не «последние» на своих местах (здесь 6 - последнее, а 3, 2 и 1 - нет).
Находим первый индекс i, который удовлетворяет этим условиям. Увеличим на 1 элемент с индексом i. получим (1, 2, 4, 6). Для хвоста сочетания переносим предыдущие числа, увеличенные на 1. В данном примере, i = 3. Перенос чисел даст (1, 2, 4, 5) - переносим только 4-й элемент с третьего (4 + 1 = 5)

Const MaxN = 100; {Максимальное число элементов в множестве}
 
Var Mas : Array[1..MaxN] Of Longint; {Текущее сочетание}
    N, M : Longint;
    I, J : Longint;
 
Procedure WriteComp; {Печать текущего сочетания}
Var I : Longint;
Begin
 For I:=1 To M Do Write(Mas[I], ' ');
 Writeln;
End;
 
Begin
 ReadLn(N, M);
 For I:=1 To M Do Mas[I]:=I; {Заполняем сочетание числами от 1 до M}
 While (True) Do
  Begin
   WriteComp; {Выводим сочетание}
   I:=M;
   While (I > 0) And (Mas[I] = N - M + I) Do Dec(I); {Пока все правые  числа -  последние}
   If I = 0 Then Break; {Если все числа - последние, то все сочетания сгенерированы}
   Inc(Mas[I]); {Увеличиваем на 1 найденный не последний элемент}
   For J:=I + 1 To M Do Mas[J]:=Mas[J - 1] + 1; {Переносим хвост}
  End;
End.

Размещения

Размещение - это сочетание, в котором важен порядок. Получение всех размещений - это объединение задач о получении перестановок и сочетаний: для каждого сочетания находим перестановки.