На главную Наши проекты:
Журнал   ·   Discuz!ML   ·   Wiki   ·   DRKB   ·   Помощь проекту
ПРАВИЛА FAQ Помощь Поиск Участники Календарь Избранное RSS
msm.ru
! Правила ЧаВо (FAQ) разделов Паскаля
В этом разделе разрешено создавать только темы, в которых описано РЕШЕНИЕ какой-либо общей проблемы, или описание какого-либо аспекта языка Паскаль.
Обсуждение уже созданных тем разрешено, но только конструктивное, например указание на ошибку или уточнение имеющегося текста.

Также читать Требования к оформлению статей
Модераторы: Romtek, volvo877
  
    > Комбинаторика , и Паскаль
    tserega
    Сообщ. #1 ,

      Profi
      *****
      Профиль · PM
      Поощрения: 1 Dgm
      Рейтинг (т): 80
      Комбинаторика


      Иногда встречаются задания (особенно их любят в университетах "злобные" преподаватели) типа "найти число сочетаний из 15 по 7" или, что еще хуже, "получить все перестановки из 6 элементов".

      Все подмножества данного множества
      Допустим, что у нас есть множество 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-тый элемент входит в подмножество, иначе - не входит. Поэтому данный алгоритм можно реализовать так:
      ExpandedWrap disabled
        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)-й элемент не содержит. Получается рекурсивный алгоритм:
      ExpandedWrap disabled
        function IntToStr(X: Longint): String;
        var S: string;
        begin
          Str(X, S);
          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, а все единицы слева - на нули.
      ExpandedWrap disabled
        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 3 5 3 2 - меняем 3 и 5, затем подчеркнутое надо перевернуть
      1 3 5 2 3
      ExpandedWrap disabled
        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)
      Так тоже мы получим все перестановки:
      ExpandedWrap disabled
        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)
      ExpandedWrap disabled
        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.


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


        Рейтинг@Mail.ru
        [ Script execution time: 0,0285 ]   [ 16 queries used ]   [ Generated: 28.04.24, 11:35 GMT ]  
        Powered by Invision Power Board(U) v1.2 © 2003  IPS, Inc.