====== Комбинаторика ====== == Все подмножества данного множества == Допустим, что у нас есть множество S, состоящее из элементов a1, a2, ..., aN, т.е.\\ S = {aN, a2, ..., aN}\\ Для простоты можно считать, что a1, .. aN - это различные целые числа от 1 до N.\\ Подмножеством данного множества S называется множество S', которое содержит некоторые элементы из S (не обязательно все). У множества из N элементов будет ровно 2N различных подмножеств. Получить их все можно как минимум тремя различными способами. === 1-й способ === Для примера возьмем N = 3. Запишем все числа от 0 до 2N - 1 = 7 в двоичной системе счисления: 0 - 000 1 - 001 2 - 010 3 - 011 4 - 100 5 - 101 6 - 110 7 - 111 Если на //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. ===== Размещения ===== //Размещение// - это сочетание, в котором важен порядок. Получение всех размещений - это объединение задач о получении перестановок и сочетаний: для каждого сочетания находим перестановки.