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;

{ 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;

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;

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;

  /// <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;

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;