На главную
ПРАВИЛА FAQ Помощь Участники Календарь Избранное DigiMania RSS
msm.ru
Модераторы: Rouse_, jack128, Krid
  
    > Комбинаторика: генерация сочетаний, для Delphi 2010
      Генерация сочетаний


      Под сочетанием понимается выборка k элементов из множества N имеющихся, без повторений (k <= N). Без нарушения общности можно пронумеровать элементы исходного множества числами от 1 до N, и задача сводится к генерации уникальных последовательностей из k чисел от 1 до N.

      Обычно сочетания выдаются в лексикографическом порядке, упорядоченными аналогично строкам, проще всего это продемонстрировать на примере.

      Пример
      Пусть N=6, {1,2,3,4,5,6}, k=4. Тогда получается следующий набор из 15 сочетаний:
      • 1 2 3 4
      • 1 2 3 5
      • 1 2 3 6
      • 1 2 4 5
      • 1 2 4 6
      • 1 2 5 6
      • 1 3 4 5
      • 1 3 4 6
      • 1 3 5 6
      • 1 4 5 6
      • 2 3 4 5
      • 2 3 4 6
      • 2 3 5 6
      • 2 4 5 6
      • 3 4 5 6
      Количество сочетаний равно (неслучайно) биномиальному коэффициенту, C(k,N).
      Сосчитать биномиальный коэффициент проще всего воспользовавшись следующей ссылкой: Нахожение числа сочетаний. Надо заметить, что с увеличением N и k число сочетаний растет очень быстро.

      Алгоритм
      В книге Липский В. «Комбинаторика для программистов», М., Мир, 1988 предлагается следующий довольно простой алгоритм (чуть изменен):
      ExpandedWrap disabled
        begin
          for i := 1 to k do
            A[i] := i; //Первое подмножество
          p := k;
          while p >= 1 do
          begin
            writeln(A[1],..., A[k]); //вывод очередного сочетания
            if A[k] = n then
              p := p - 1
            else
              p := k;
            if p >= 1 then
              for i := k downto p do
                A[i] := A[p] + i - p + 1;
          end;
        end;

      В принципе, его можно использовать как есть, но при преобразовании данной процедуры в объекты можно достичь гораздо большей гибкости...

      Добавлено
      Delphi предоставляет удобные средства для объектно-ориентированного программирования, сохраняя возможность достаточно строгого контроля над типами. Логично оформить данный алгоритм в виде объекта-генератора сочетаний, который может быть использован в разных частях программы разными способами.

      Первая мысль - создать объект, получающий значения k и N в конструкторе, и имеющий один метод Generate, код которого практически написан выше. Вместо writeln поставить вызов абстрактного метода, тогда для обработки сочетаний надо просто написать потомка, реализовав этот метод. Этот способ носит громкое название паттерна "шаблоннный метод".
      Путь не слишком привлекательный: придется писать потомков класса для каждого случая обработки, да и часто хочется получить весь массив сочетаний или его часть.

      Второй способ, более дельфийский: вместо writeln ставится вызов динамического метода, например DoGenerate, в котором идет вызов эвента OnGenerate. Это подразумевает прежде всего то, что пользователь должен написать объект-владелец этого генератора, и присоединить его метод к обработчику OnGenerate. Совершенно аналогично OnButtonClick в форме.
      Это гораздо лучше, но все равно пользователя подталкивают к способу использования данного объекта.

      Третий способ - воспользоваться итератором, тем более что в Delphi сейчас имеются встроенные средства для использования итераторов (см for .. in).
      Beware the wild rabbit.
        Сочетание удобно также оформить в виде объекта, обеспечивающего функциональность массива: доступ к элементу сочетания по его номеру от 1 до N.
        Сочетание, объявления:
        ExpandedWrap disabled
          const
            /// <summary>
            /// Максимально возможный размер сочетания или последовательности.
            /// </summary>
            MaxQuantity = 32; //количество сочетаний по 16 из 32 - это 601080390, достаточно
           
          type
            // На самом деле в группе нет нулевых элементов.
            // Диапазон расширен для особого случая: нулевой индекс дает нулевой элемент.
            TSeqNum = 0 .. MaxQuantity;
           
            // массив для хранения выборки
            TSequenceArray = array of TSeqNum;
           
            TSequenceError = class(Exception);
           
            /// <summary>
            /// Собственно группа-сочетание элементов: запись-массив.
            /// Представляет собой массив фиксированной вместимости не более MaxQuantity
            /// В массиве содержатся значения от 1 до MaxQuantity
            /// </summary>
            /// <stereotype>array</stereotype>
            TGroup = record
            strict private
              // Просто динамический массив элементов группы. Пока ;)
              FGroupArray: TSequenceArray;
              FCapacity: TSeqNum;
              function GetItem(index: TSeqNum): TSeqNum;
              procedure SetItem(index: TSeqNum; const Value: TSeqNum);
              function GetCapacity: TSeqNum;
            public
              constructor Create(Capacity: TSeqNum); //N
              class operator Implicit(const Sequence: TSequenceArray): TGroup;
              //Выдает список элементов, разделенный пробелами. Медленно :)
              class operator Implicit(Group: TGroup): string;
              /// <summary>Нумерация элементов от 1 до Capacity. Впрочем, при Index = 0 выдает 0.</summary>
              property Item[index: TSeqNum]: TSeqNum read GetItem write SetItem; default;
              property Capacity: TSeqNum read FCapacity;
            end;

        реализация достаточно простая:
        ExpandedWrap disabled
          { TGroup }
           
          constructor TGroup.Create(Capacity: TSeqNum);
          begin
            FCapacity := Capacity;
            SetLength(FGroupArray, FCapacity);
          end;
           
          function TGroup.GetCapacity: TSeqNum;
          begin
            Result := Length(FGroupArray);
          end;
           
          function TGroup.GetItem(index: TSeqNum): TSeqNum;
          begin
            if index = 0 then
              Exit(0);
            Result := FGroupArray[index - 1];
          end;
           
          class operator TGroup.Implicit(Group: TGroup): string;
          var
            i: integer;
          begin
            Result := '';
            for i := 0 to High(Group.FGroupArray) do
              Result := Result + IntToStr(Group.FGroupArray[i]) + ' ';
            Result := Trim(Result);
          end;
           
          class operator TGroup.Implicit(const Sequence: TSequenceArray): TGroup;
          var
            i: integer;
            Capacity: TSeqNum;
          begin
            Capacity := Length(Sequence);
            Result := TGroup.Create(Capacity);
            for i := 0 to Capacity - 1 do
              Result.FGroupArray[i] := Sequence[i];
          end;
           
          procedure TGroup.SetItem(index: TSeqNum; const Value: TSeqNum);
          begin
            assert(Value > 0, Format(strElemError, [MaxQuantity]));
            FGroupArray[index - 1] := Value;
          end;


        Добавлено
        Теперь нужно написать нумератор, пригодный для применения в цикле for .. in, и собственно генератор сочетаний:
        ExpandedWrap disabled
          type
            /// <summary>
            /// генератор сочетаний, k элементов из n (k < n),
            /// выдается массив Capacity элементов
            /// со значениями в пределах от 1 до Quantity, элементы массива упорядочены
            /// по возрастанию.
            /// </summary>
            /// <stereotype>iterator</stereotype>
            TSequenceEnumerator = class
            private
              FCurrent: TSequenceArray;
              // Для генерации следующей последовательности меняется только часть
              // текущей. Индекс, с которого надо менять, хранится.
              // В новой последовательности будут изменены элементы с индексами
              // от FFixedPart до Capacity.
              FFixedPart: TSeqNum;
              FCapacity: byte;
              FQuantity: byte;
            public
              constructor Create(Capacity, Quantity: byte);
              function GetCurrent: TGroup;
              function MoveNext: boolean;
              procedure Reset;
              property Current: TGroup read GetCurrent;
            end;
           
            /// <summary>Обертка над TSequenceEnumerator для for...in </summary>
            /// <stereotype>wrapper</stereotype>
            TSequence = class
              FCapacity: byte;
              FQuantity: byte;
            public
              function GetEnumerator: TSequenceEnumerator;
              /// <summary>Количество элементов в сочетании</summary>
              property Capacity: byte read FCapacity write FCapacity;
              /// <summary>Множество элементов для выборки</summary>
              property Quantity: byte read FQuantity write FQuantity;
            end;
           
          implementation
           
          { TSequenceEnumerator }
           
          constructor TSequenceEnumerator.Create(Capacity, Quantity: byte);
          begin
            FCapacity := Capacity;
            FQuantity := Quantity;
            SetLength(FCurrent, FCapacity);
            Reset;
          end;
           
          function TSequenceEnumerator.GetCurrent: TGroup;
          begin
            assert(FFixedPart <= FCapacity);
            // Выдаем объект "группа"
            Result := FCurrent;
          end;
           
          function TSequenceEnumerator.MoveNext: boolean;
          var
            i: integer;
          begin
           
            // собственно алгоритм генерации следующей в лексикографическом порядке группы
            Result := False;
           
            if FCurrent[FCapacity - 1] = FQuantity then
              dec(FFixedPart)
            else
              FFixedPart := FCapacity;
            if FFixedPart = 0 then
              exit;
            if FFixedPart >= 1 then
              for i := FCapacity downto FFixedPart do
                FCurrent[i - 1] := FCurrent[FFixedPart - 1] + i - FFixedPart + 1;
            Result := True;
          end;
           
          procedure TSequenceEnumerator.Reset;
          var
            i: integer;
          begin
            // начальная подгруппа
            for i := 0 to high(FCurrent) do
              FCurrent[i] := i + 1;
            // Первым вызывается MoveNext!
            // поэтому начальная группа - перед первой, последний элемент равен предыдущему.
            // При применении MoveNext из такой группы получается первая, от 1 до Capacity.
            if Length(FCurrent) > 1 then
              FCurrent[ high(FCurrent)] := FCurrent[ high(FCurrent) - 1]
            else
              FCurrent[0] := 0;
            FFixedPart := FCapacity + 1;
          end;
           
          { TSequence }
           
          function TSequence.GetEnumerator: TSequenceEnumerator;
          begin
            Result := TSequenceEnumerator.Create(FCapacity, FQuantity);
          end;

        Фактически первоначальный метод оказался буквально вывернут наизнанку и разбросан по методам: MoveNext - это один шаг цикла, начальные значения задаются в reset, а GetCurrent - это аналог writeln.
        Из-за особенностей реализации нумератора начальным значением служит не первое сочетание, а "нулевое", получаемое из первого отступлением на шаг назад.

        Пример использования, проверка по примеру выше:
        ExpandedWrap disabled
          procedure TestTSequence.SetUp;
          begin
            FSequence := TSequence.Create;
          end;
           
          procedure TestTSequence.TestSequenceN6k4;
          const
            TestGroups: array [0..14] of array [0..3] of byte =
              ((1,2,3,4), (1,2,3,5), (1,2,3,6), (1,2,4,5), (1,2,4,6),
               (1,2,5,6), (1,3,4,5), (1,3,4,6), (1,3,5,6), (1,4,5,6),
               (2,3,4,5), (2,3,4,6), (2,3,5,6), (2,4,5,6), (3,4,5,6));
            ACapacity = 4;
            AQuantity = 6;
          var
            CurrGroup: TGroup;
            ind, i: integer;
          begin
            ind := 0;
            FSequence.Capacity := ACapacity;
            FSequence.Quantity := AQuantity;
            for CurrGroup in FSequence do
            begin
              assert(ind < 15);
              CheckEquals(CurrGroup.Capacity, ACapacity, 'Длина группы не соответствует');
              //Проверяем все выданные элементы подгруппы
              for i := 0 to High(TestGroups[ind]) do
                CheckEquals(CurrGroup[i + 1], TestGroups[ind, i]);
              inc(ind);
            end;
            //Выбраны все подгруппы:
            CheckEquals(ind, 15);
          end;


        Добавлено
        Вот и все. Создается экземпляр TSequence, из него в цикле получаются сочетания, и остается только не забыть уничтожить генератор.
        Вообще говоря, TSequence может быть и записью, но с классом легче наследовать.

        Генерация сочетаний с проспусками
        Задача состоит в том, чтобы выдать только сочетания не содержащие в себе некоторых номеров.
        ExpandedWrap disabled
            /// <summary>генератор сочетаний, вариация: k элементов из n (k < n)
            /// выдается массив Capacity элементов со значениями в пределах от 1 до Quantity
            /// элементы массива упорядочены по возрастанию.
            /// В итоговой группе отсутствуют элементы, поданные как исключаемые
            /// в конструктор: множество ExcludeItems</summary>
            TExcludedSequenceEnumerator = class
            private
              /// <summary>Собственно итератор по сокращенной выборке</summary>
              FSequenceEnumerator: TSequenceEnumerator;
              /// <summary>Массив трансляции номеров выборки</summary>
              FTranslate: TSequenceArray;
            public
              constructor Create(Capacity, Quantity: byte; const ExcludeItems: TGroup);
              function GetCurrent: TGroup;
              function MoveNext: boolean;
              procedure Reset;
              property Current: TGroup read GetCurrent;
            end;
           
            /// <summary>Обертка над TExcludedSequenceEnumerator для for...in </summary>
            /// <stereotype>wrapper</stereotype>
            TExcludedSequence = class(TSequence)
            private
              FExclude: TGroup;
            public
              function GetEnumerator: TExcludedSequenceEnumerator;
              /// <summary>Множество исключаемых элементов</summary>
              property Exclude: TGroup read FExclude write FExclude;
            end;
           
          implementation
           
          { TExcludedSequenceEnumerator }
           
          constructor TExcludedSequenceEnumerator.Create(Capacity, Quantity: byte;
            const ExcludeItems: TGroup);
          var
            RealQuantity: byte;
            i, k: integer;
            ExcludeSet: set of TSeqNum;
          begin
            assert(Capacity > ExcludeItems.Capacity, 'Нельзя исключить больше чем все');
            RealQuantity := Quantity - ExcludeItems.Capacity;
            FSequenceEnumerator := TSequenceEnumerator.Create(Capacity, RealQuantity);
            SetLength(FTranslate, RealQuantity);
            // Заполняем множество исключаемых элементов
            ExcludeSet := [];
            for i := 1 to ExcludeItems.Capacity do
              include(ExcludeSet, ExcludeItems[i]);
            // Формируем массив перевода
            k := 0;
            for i := 1 to Quantity do
            begin
              if i in ExcludeSet then
                Continue;
              FTranslate[k] := i;
              inc(k);
            end;
            // В FTranslate по возрастанию все числа, которых нет в ExcludeItems
          end;
           
          function TExcludedSequenceEnumerator.GetCurrent: TGroup;
          var
            i: integer;
            Item: TSeqNum;
          begin
            Result := FSequenceEnumerator.GetCurrent;
            // Теперь переводим
            for i := 1 to Result.Capacity do
            begin
              Item := Result[i];
              // Массив считается от 0
              Result[i] := FTranslate[Item - 1];
            end;
          end;
           
          function TExcludedSequenceEnumerator.MoveNext: boolean;
          begin
            Result := FSequenceEnumerator.MoveNext;
          end;
           
          procedure TExcludedSequenceEnumerator.Reset;
          begin
            FSequenceEnumerator.Reset;
          end;
           
          { TExcludedSequence }
           
          function TExcludedSequence.GetEnumerator: TExcludedSequenceEnumerator;
          begin
            Result := TExcludedSequenceEnumerator.Create(FCapacity, FQuantity, FExclude);
          end;
        Сообщение отредактировано: Romkin -
        Beware the wild rabbit.
        1 пользователей читают эту тему (1 гостей и 0 скрытых пользователей)
        0 пользователей:


        Рейтинг@Mail.ru
        [ Script Execution time: 0,0889 ]   [ 15 queries used ]   [ Generated: 24.11.17, 20:23 GMT ]