Аналог itertools.permutations(iterable, r=None) для delphi

Question

Есть ли у кого-то варианты, как написать такую же функцию, но на делфи. В официальной документации по python имеется yield, которого нет в делфи. Код функции на python:

def permutations(iterable, r=None):
    # permutations('ABCD', 2) --> AB AC AD BA BC BD CA CB CD DA DB DC
    # permutations(range(3)) --> 012 021 102 120 201 210
    pool = tuple(iterable)
    n = len(pool)
    r = n if r is None else r
    if r > n:
        return
    indices = list(range(n))
    cycles = list(range(n, n-r, -1))
    yield tuple(pool[i] for i in indices[:r])
    while n:
        for i in reversed(range(r)):
            cycles[i] -= 1
            if cycles[i] == 0:
                indices[i:] = indices[i+1:] + indices[i:i+1]
                cycles[i] = n - i
            else:
                j = cycles[i]
                indices[i], indices[-j] = indices[-j], indices[i]
                yield tuple(pool[i] for i in indices[:r])
                break
        else:
            return

Answer 1

Если нужны просто перестановки в лексикографическом порядке, то надо найти алгоритм next_permutation (с переворотом суффикса) и реализовать его.

itertools.permutations может выдавать ещё сочетания (когда r назначено), но их при необходимости нетрудно получить, используя начальный массив из n-r нулей и r единиц.

Пример

procedure Swap(var A: TArray<Byte>; l, r: Integer);
var
  t: Byte;
begin
  t := A[l];
  A[l] := A[r];
  A[r] := t;
end;

function next_perm(var A: TArray<Byte>): Boolean;
var
  i, j: Integer;
  t: Byte;
begin
  i := High(A);
  while (i > 0) and (A[i - 1] >= A[i]) do
    Dec(i);
  if (i <= 0) then
     Exit(False);

  j := High(A);
  while A[j] <= A[i - 1] do
    Dec(j);
  Swap(A, i - 1, j);

  j := High(A);
  while (i < j)  do begin
    Swap(A, i, j);
    Inc(i);
    Dec(j);
  end;
  Result := True;
end;

function ArrToStr(const A: TArray<Byte>): string;
var
  i: Integer;
begin
  Result := '';
  for i := 0 to High(A) do
    Result := Result + A[i].ToString + ' ';
end;

var
  A: TArray<Byte>;
  i: Integer;
  s: string;
begin
  A := [1,2,3];
  repeat
    Memo1.Lines.Add(ArrToStr(A))
  until not next_perm(A);

1 2 3 
1 3 2 
2 1 3 
2 3 1 
3 1 2 
3 2 1

БЛОГ НА HUSL

Аналог itertools.permutations(iterable, r=None) для delphi

Ответы (1 шт):