Перебор перестановок, размещений, сочетаний

Ноябрь 9, 2012 — Шарахов А.П.

Известно великое множество алгоритмов перебора перестановок, размещений и сочетаний. Существуют ли быстрые алгоритмы перебора? Как удобнее организовать параллельный перебор? Давайте поищем ответы на эти вопросы. Попутно рассмотрим два новых очень быстрых алгоритма перебора перестановок, которые можно использовать и для параллельной работы.

Ни о чем

В качестве элементов множества далее будем использовать большие буквы английского алфавита, а максимальную длину результата (сочетания, перестановки или размещения) ограничим 26 элементами. Если длина строк небольшая, можно использовать цифры. Для проверки работы генераторов предлагается использовать процедуры ProcessString и ProcessSubstring, которые, в свою очередь, вызывают ShowSubstring:

const
  chfirst   = 'A'; //первый символ в наборе допустимых символов
  maxlength = 26;  //максимальная длина результата (сочетания, перестановки, размещения)
 
procedure ShowSubstring(const s: ShortString; cut: integer); overload;
begin;
  Form1.Memo1.Lines.Add(Copy(s,1,cut)+'    '+IntToStr(ItemCount));
  end;
 
procedure ProcessSubstring(const s: ShortString; cut: integer);
begin;
  //if Length(s)<=5 then ShowSubstring(s, cut); //comment this line when measure speed
  end;
 
procedure ProcessString(const s: ShortString);
begin;
  //if Length(s)<=5 then ShowSubstring(s, MaxInt); //comment this line when measure speed
  end;

При измерениях скорости работы мы тоже будем вызывать эти процедуры, но с пустым телом, имитируя вызов пустой процедуры обработки.
Если что-то из перечисленного вам не подходит – измените. Но только постарайтесь не выплеснуть ребенка вместе с водой: тип ShortString в процедурах перебора использован для того, чтобы избавиться от лишних трат времени на проверку уникальности длинных строк в Delphi.

Перестановки

Идея алгоритма очень проста. Для перебора всех перестановок длины n надо при фиксированном левом элементе перебрать все перестановки остальных n-1 элементов, затем повторить указанные действия при новом значении самого левого элемента, и т.д. Казалось бы, напрашивается рекурсивная реализация – но это ловушка, нам туда не надо. Чтобы перебор был быстрым, придется отказаться от рекурсии.

procedure StdGeneratePermutations(n: integer);
var
  s: ShortString;
  i, j: integer;
  ch: AnsiChar;
begin;
  if (n<=0) or (n>maxlength) then exit;
 
  SetLength(s,n);
  for i:=1 to n do s[i]:=AnsiChar((Ord(chfirst)-1)+i);
 
  while true do begin;
    ProcessString(s);
    i:=n;
    repeat;
      dec(i);
      if i<=0 then exit;
      until s[i]<s[i+1];
    ch:=s[i];
    j:=n;
    while ch>=s[j] do dec(j);
    s[i]:=s[j];
    s[j]:=ch;
    inc(i); j:=n;
    while i<j do begin;
      ch:=s[i]; s[i]:=s[j]; s[j]:=ch;
      inc(i); dec(j);
      end;
    end;
  end;

На входе процедуры значение параметра проверяется на допустимость. Это повышает надежность кода и совершенно не влияет на скорость работы. Подобные проверки будут встречаться и далее.

Можно добиться заметного ускорения работы стандартного алгоритма при больших n, если вместо поиска элемента, которым требуется заменить текущий "увеличиваемый" элемент, вычислять его позицию с использованием дополнительного массива. Кроме того, можно вообще избавиться от сравнения элементов множества.

//перебор перестановок n элементов в алфавитном порядке
procedure GeneratePermutations(n: integer);
var
  s: ShortString;
  p: array[1..maxlength] of integer;
  i, j, len: integer;
  ch: AnsiChar;
begin;
  if (n<=0) or (n>High(p)) then exit;
 
  SetLength(s,n);
  for i:=1 to n do begin;
    s[i]:=AnsiChar((Ord(chfirst)-1)+i);
    p[i]:=n;
    end;
 
  len:=n;                      //n, а не n-1, т.к. иначе обратимся к p[0] при n=1
  while true do begin;
    ProcessString(s);
    while true do begin;
      i:=p[len];               //индекс элемента, который будет стоять в позиции len
      if i<=len then begin;    //если там стоял последний, который могли взять
        p[len]:=n;             //то будет стоять первый, который сможем взять
        dec(len);
        if len>0 then continue
        else exit;
        end
      else begin;
        ch:=s[len];            //начало обмена s[len] и s[i]
        s[len]:=s[i];
        s[i]:=ch;
        p[len]:=i-1;
        j:=len+1;
        i:=n;
        len:=n-1;              //n-1, т.к. здесь n>1, а p[n]=n никогда не меняется
        repeat;                //инвертируем порядок символов s[len+1..n]
          ch:=s[j]; s[j]:=s[i]; inc(j); s[i]:=ch; dec(i);
          until j>=i;
        break;
        end;
      end;
    end;
  end;

Совершенно очевидно, что значение последнего символа перестановки однозначно определяется предыдущими символами. Поэтому алгоритм всегда начинает проверки возможности "увеличения" символов с предпоследней позиции.

Размещения

Алгоритм перебора размещений - это более общий вариант алгоритма перебора перестановок. Хотя вызов процедуры перебора размещений с одинаковыми параметрами позволяет перебрать перестановки, но специализированная процедура перебора перестановок работает заметно быстрее.

//перебор размещений из n по k элементов в алфавитном порядке
procedure GenerateArrangements(n, k: integer);
var
  s: ShortString;
  p: array[1..maxlength] of integer;
  i, j, len: integer;
  ch: AnsiChar;
begin;
  if (k<=0) or (k>High(p)) or (n<k) then exit;
 
  SetLength(s,n);
  for i:=1 to k do s[i]:=AnsiChar((Ord(chfirst)-1)+i);
  for i:=k+1 to n do s[i]:=AnsiChar((Ord(chfirst)-1)+(n+k+1-i));
  for i:=1 to k do p[i]:=n;
 
  len:=k;
  while true do begin;
    ProcessSubstring(s,k);
    while true do begin;
      i:=p[len];               //индекс элемента, который будет стоять в позиции len
      if i<=len then begin;    //если там стоял последний, который могли взять
        p[len]:=n;             //то будет стоять первый, который сможем взять
        dec(len);
        if len>0 then continue
        else exit;
        end
      else begin;
        ch:=s[len];            //начало обмена s[len] и s[i]
        s[len]:=s[i];
        s[i]:=ch;
        p[len]:=i-1;
        j:=len+1;
        i:=n;
        repeat;                //инвертируем порядок символов s[len+1..n]
          ch:=s[j]; s[j]:=s[i]; inc(j); s[i]:=ch; dec(i);
          until j>=i;
        j:=k+1;
        i:=n;
        while j<i do begin;    //инвертируем порядок символов s[k+1..n]
          ch:=s[j]; s[j]:=s[i]; inc(j); s[i]:=ch; dec(i);
          end;
        len:=k;
        break;
        end;
      end;
    end;
  end;

Алгоритм отличается от предыдущего отсутствием хака для последнего символа результата и дополнительным циклом, имитирующим перебор хвостовых элементов при инициализации и основной работе.

Сочетания

Наверное, крайне трудно найти медленный алгоритм перебора сочетаний. По двум причинам: алгоритм очень прост и сочетаний сравнительно мало. Но есть одна опасность: и в печати, и в сети можно встретить варианты, которые работают неверно при n=k. Поэтому на всякий случай ниже приведен годный алгоритм:

//перебор сочетаний из n по k элементов в алфавитном порядке
procedure GenerateCombinations(n, k: integer);
var
  s: ShortString;
  i, start: integer;
  chlast, ch: AnsiChar;
begin;
  if (k<=0) or (k>maxlength) or (n<k) then exit;
 
  SetLength(s,k);
  for i:=1 to k do s[i]:=AnsiChar((Ord(chfirst)-1)+i);
  ProcessString(s);
 
  //если существует более одного сочетания, то крутим цикл
  if k<n then begin;
    chlast:=AnsiChar(Ord(s[1])-1+n);
    start:=k;
    while true do begin;
      if s[k]<>chlast then start:=k
      else begin;
        dec(start); if start<=0 then break;
        end;
      i:=start;
      ch:=s[start];
      repeat;
        inc(ch); s[i]:=ch; inc(i);
        until i>k;
      ProcessString(s);
      end;
    end;
  end;

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

1 транспозиция

Иногда приходится слышать, что самым быстрым алгоритмом генерации перестановок является алгоритм, использующий минимальное количество транспозиций. Казалось бы, если для перехода к следующей перестановке выполняется всего одна транспозиция, то в итоге будет затрачено минимальное время. К сожалению, для всех известных мне реализаций это не так. В суммарное время работы алгоритма входят затраты времени на изменения и проверки значений служебных переменных, которые для этого алгоритма существенно превышают время выполнения единственной транспозиции. Например, в известной реализации Липского алгоритма Джонсона-Троттера имеются 2 массива управляющих переменных, в одном из которых хранится количество обменов символов-челноков со своими соседями, а в другом - код для обозначения левого или правого соседа. На каждой итерации алгоритма выполняется несколько проверок, вычисляются позиции для обмена и выполняется обмен.

Рассмотрим одну из возможных реализаций алгоритма:

//движение справа налево
procedure ShaGeneratePermutationsTrotter(n: integer);
var
  c, moveright: array[0..maxlength] of integer;
  s: ShortString;
  i, x, k: integer;
begin;
  if (n<=0) or (n>maxlength) then exit;
 
  SetLength(s,n);
  for i:=1 to n do begin;
    s[i]:=AnsiChar((Ord(chfirst)-1)+i);
    c[i]:=i-1;
    moveright[i]:=0;
    end;
 
  ProcessString(s);
  while true do begin;
    i:=n;
    x:=0;
    k:=c[i];
    while k=0 do begin;
      k:=moveright[i]; k:=k xor -1; moveright[i]:=k;
      i:=i-1;
      x:=x-k;
      if i<=0 then exit;
      k:=c[i];
      c[i+1]:=i;
      end;
    x:=moveright[i] and (i-k-k) + k + x; //if moveright[i]=0 then x:=k+x else x:=i-k+x;
    c[i]:=k-1;
    i:=ord(s[x]); s[x]:=s[x+1]; s[x+1]:=AnsiChar(i);
    ProcessString(s);
    end;
  end;

Эта версия имеет несколько важных отличий от реализации Липского. Челноки движутся налево, что немного упрощает пересчет позиций. Счетчик выполненных шагов уменьшается (считает к нулю), это упрощает условие внутреннего цикла. Булевский массив заменен целочисленным, что позволило исключить в коде две проверки. Оператор exit во внутреннем цикле также позволил уменьшить общее количество проверок. Для уменьшения количества использованных переменных применяется встроенная функция Ord. Благодаря этим отличиям скорость алгоритма заметно выше.

Но главная проблема так осталась нерешенной - "плавающие" границы, внутри которых перемещается символ-челнок, мешают быстрому определению позиции обмена. Давайте эту проблему решим чуть позже, а пока зададимся вопросом, существуют ли другие (желательно, быстрые) алгоритмы генерации перестановок с малым числом транспозиций?

2 транспозиции (12.07.2014)

Можно заметить, что основной цикл алгоритма Джонсона-Троттера заметно упростится (а количество транспозиций возрастет), если на каждой итерации обменивать челнок всегда с правым соседом, а по окончании цикла сдвигать перестановку к начальному состоянию. Это упростит код, но не ускорит его, т.к. выигрыш будет меньше потерь из-за всплеска нагрузки на память в конце цикла. Было бы здорово равномерно распределить эту нагрузку на все время работы цикла.

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

Если в качестве первого символа множества использовать '1', то описанный алгоритм порождает следующую последовательность перестановок длины 4:

1234    1
2134    2
3214    3
4231    4
1324    5
3124    6
2314    7
4321    8
1432    9
4132    10
3412    11
2431    12
1243    13
2143    14
4213    15
3241    16
1423    17
4123    18
2413    19
3421    20
1342    21
3142    22
4312    23
2341    24

Легко заметить, что символ-челнок '1' каждый раз смещается на одну позицию, вытесняя стоящий там символ в первую позицию. Символ из первой позиции, в свою очередь, возвращается на то место, которое занимал до этого символ-челнок. На всех итерациях, кроме первой, это равносильно тройному обмену. Подобную логику работы, при желании, можно разглядеть и на вложенных уровнях. Иными словами, каждый раз для перехода к следующей перестановке выполняется проверка первого символа-челнока: если его следующая позиция не выходит за длину перестановки, то перемещаем челнок, в противном случае возвращаем челнок в самую левую позицию и, мысленно отсекая левый элемент, повторяем такие же проверки для следующих символов-челноков и перестановок меньшей длины.

От идеи к реализации ведут два пути. Первый – взять за основу и начать изменять простейшую рекурсивную реализацию вроде этой (обратите внимание, что здесь внешний челнок находится справа и движется налево):

procedure ShaGeneratePermutationsRecursiveInternal(var s: ShortString; i: integer);
var
  j: integer;
  ch: AnsiChar;
begin;
  s[i]:=AnsiChar((Ord(chfirst)-1)+i);
  for j:=i downto 1 do begin;
    ch:=s[j]; s[j]:=s[i]; s[i]:=ch;
    if i>=Length(s) then ProcessString(s) else ShaGeneratePermutationsRecursiveInternal(s,i+1);
    ch:=s[j]; s[j]:=s[i]; s[i]:=ch;
    end;
  end;
procedure ShaGeneratePermutationsRecursive(n: integer);
var
  s: ShortString;
begin;
  if (n<=0) or (n>maxlength) then exit;
  SetLength(s,n);
  ShaGeneratePermutationsRecursiveInternal(s,1);
  end;

Второй путь – сразу написать нерекурсивную реализацию вроде следующей, а затем попробовать разобраться в ней:

procedure ShaGeneratePermutations(n: integer);
var
  c: array[0..maxlength] of integer;
  s: ShortString;
  i, j: integer;
  ch: AnsiChar;
begin;
  if (n<=0) or (n>maxlength) then exit;
 
  SetLength(s,n);
  for i:=1 to n do begin;
    s[i]:=AnsiChar((Ord(chfirst)-1)+i);
    c[i]:=i+1;
    end;
 
  i:=1;
  j:=2;
  while true do begin;
    ProcessString(s);
    if j<=n then begin;
      ch:=s[j]; s[j]:=s[j-1]; s[j-1]:=s[i]; s[i]:=ch;
      j:=j+1;
      end
    else begin;
      repeat;
        ch:=s[n]; s[n]:=s[i]; s[i]:=ch;
        i:=i+1;
        if i>=n then exit; //thanks to Michael Trofimov: i>n here when n=1
        j:=c[i];
        c[i-1]:=i;
        until j<=n;
      ch:=s[j]; s[j]:=s[j-1]; s[j-1]:=s[i]; s[i]:=ch;
      c[i]:=j+1;
      i:=1;
      j:=2;
      end;
    end;
  end;

Стоит остановиться на некоторых особенностях нерекурсивной версии алгоритма. Массив c[i] предназначен для хранения будущего положения i-того челнока. Нулевой элемент этого массива не используется, но с ним код работает немного быстрее. Первый элемент тоже не используется, т.к. в процессе работы будущее значение первого челнока всегда лежит в переменной j и в c[1] не сохраняется.

Генерация очередной перестановки производится во внешнем цикле "while". Обычно при этом выполняется вызов внешней процедуры обработки, проверка и изменение переменной цикла и тройной обмен элементов перестановки. На первой итерации те же операторы выполняют обмен первых двух элементов перестановки. Так быстрее, потому что не требуется дополнительная проверка на особый случай.

Количество итераций основного цикла равно длине перестановки, челнок перемещается слева направо. На последней итерации основного цикла управление попадает во внутренний цикл "repeat", который последовательно "откатывает" в первоначальное состояние все челноки, пока не найдет такой, который можно продвинуть направо, после чего найденный челнок перемещается направо.

Параллельная генерация перестановок

Чтобы генерировать перестановки параллельно, надо уметь разбивать все множество перестановок на подмножества, которые затем независимо генерировать в разных потоках. Напрашивается идея использовать для этого нумерацию перестановок и проверять номер очередной перестановки в процессе генерации. Однако уже при сравнительно небольших n для представления n! потребуется использовать 64-битный тип данных. Естественно, это замедлит генерацию. На самом деле номер перестановки нам не нужен, достаточно номера множества - он и меньше, и работать с ним проще.

Очевидно, что для перебора всех перестановок P(n) достаточно для каждого размещения A(n,k) перебрать все перестановки P(n-k). В процедуру генерации можно передавать длину размещения и его номер. На практике необходимо выбрать длину размещения такой, чтобы разбить всю работу на достаточно большое количество частей и обеспечить равномерную загрузку процессоров:

procedure ShaGeneratePermutationsWithSuffix(n, SuffixLen, SuffixNo: integer);
var
  c: array[0..maxlength] of integer;
  s: ShortString;
  i, j, nNew: integer;
  ch: AnsiChar;
begin;
  if (n<=0) or (n>maxlength) or (SuffixLen<=0) or (SuffixLen>=n) then exit;
 
  SetLength(s,n);
  for i:=1 to n do begin;
    s[i]:=AnsiChar((Ord(chfirst)-1)+i);
    c[i]:=i+1;
    end;
 
  nNew:=n-SuffixLen;
  j:=SuffixNo;
  while n>nNew do begin;
    i:=j; j:=j div n; i:=i+1-j*n;
    ch:=s[i]; s[i]:=s[n]; s[n]:=ch;
    dec(n);
    end;
 
  i:=1;
  j:=2;
  while true do begin;
    ProcessString(s);
    if j<=n then begin;
      ch:=s[j]; s[j]:=s[j-1]; s[j-1]:=s[i]; s[i]:=ch;
      j:=j+1;
      end
    else begin;
      repeat;
        ch:=s[n]; s[n]:=s[i]; s[i]:=ch;
        i:=i+1;
        if i>=n then exit;
        j:=c[i];
        c[i-1]:=i;
        until j<=n;
      ch:=s[j]; s[j]:=s[j-1]; s[j-1]:=s[i]; s[i]:=ch;
      c[i]:=j+1;
      i:=1;
      j:=2;
      end;
    end;
  end;
 
procedure TForm1.Button4Click(Sender: TObject);
var
  i, n, SuffixLen, SuffixCount, SuffixNo: integer;
begin;
  n:=12; SuffixLen:=4;
  SuffixCount:=1; for i:=1 to SuffixLen do SuffixCount:=SuffixCount * (n-i+1);
  for SuffixNo:=0 to SuffixCount-1 do ShaGeneratePermutationsWithSuffix(n, SuffixLen, SuffixNo);
  end;

Возможно, нуждается в пояснении строка декодирования номера размещения:

  i:=j; j:=j div n; i:=i+1-j*n;

Если в этом коде опустить единицу, то мы получим эквивалент последовательности операторов:

  i:=j mod n; j:=j div n;

Это просто вычисление последнего разряда в позиционной системе счисления с переменным основанием (сравните с вычислением последней цифры числа в десятичной системе счисления). Прибавляя единицу, мы получаем позицию символа, который надо переставить на последнее место. Для декодирования номера в размещение можно использовать любой другой алгоритм, лишь бы он не был слишком медленным. Если требуется, изменив код, вместо номера размещения можно передавать само размещение или начальное значение всей перестановки.

В примере все подмножества перестановок генерируются в одном цикле главного потока. На практике каждый поток приложения должен генеровать примерно равное количество различных подмножеств.

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

procedure ShaGeneratePermutationsWithConstraint(n, ConstraintLen, ConstraintNo: integer);
var
  c: array[0..maxlength] of integer;
  s: ShortString;
  i, j, ConstraintPos: integer;
  ch: AnsiChar;
begin;
  if (n<=0) or (n>maxlength) or (ConstraintLen<=0) or (ConstraintLen>=n) then exit;
 
  SetLength(s,n);
 
  ConstraintPos:=n-ConstraintLen+1;
  for i:=1 to ConstraintLen do s[i]:=AnsiChar(Ord(chfirst)+n-i);
 
  n:=ConstraintLen;
  j:=ConstraintNo;
  while n>0 do begin;
    i:=j; j:=j div n; i:=i+1-j*n;
    ch:=s[i]; s[i]:=s[n]; s[n]:=ch;
    dec(n);
    end;
 
  j:=ConstraintPos-1;
  for i:=ConstraintLen downto 1 do s[j+i]:=s[i];
 
  for i:=1 to ConstraintPos-1 do begin;
    s[i]:=AnsiChar((Ord(chfirst)-1)+i);
    c[i]:=i+1;
    end;
 
  n:=ConstraintPos+ConstraintLen-1;
  i:=1;
  j:=2;
  while true do begin;
    ProcessString(s);
    if j<=n then begin;
      ch:=s[j]; s[j]:=s[j-1]; s[j-1]:=s[i]; s[i]:=ch;
      j:=j+1;
      end
    else begin;
      repeat;
        ch:=s[n]; s[n]:=s[i]; s[i]:=ch;
        i:=i+1;
        if i>=ConstraintPos then exit;
        j:=c[i];
        c[i-1]:=i;
        until j<=n;
      ch:=s[j]; s[j]:=s[j-1]; s[j-1]:=s[i]; s[i]:=ch;
      c[i]:=j+1;
      i:=1;
      j:=2;
      end;
    end;
  end;
 
procedure TForm1.Button5Click(Sender: TObject);
var
  i, n, ConstraintLen, ConstraintCount, ConstraintNo: integer;
begin;
  n:=12; ConstraintLen:=8;
  ConstraintCount:=1; for i:=1 to ConstraintLen do ConstraintCount:=ConstraintCount * i;
  for ConstraintNo:=0 to ConstraintCount-1 do ShaGeneratePermutationsWithConstraint(n, ConstraintLen, ConstraintNo);
  end;

Здесь внутренняя перестановка последних ConstraintLen элементов всей перестановки задает ограничение на состав генерируемых перестановок, разбивая все множество на ConstraintLen! непересекающихся подмножеств. Основной код генерации отличается от предыдущих листингов только строкой:

        if i>=ConstraintPos then exit;

Заметим, что номер подмножества перестановок не соответствует последовательности генерации перестановок процедурой ShaGeneratePermutations.

Компилятор Delphi имеет довольно слабые возможности оптимизации. Чтобы важные для скорости работы переменные были размещены в регистрах, нам пришлось в начале процедуры выполнить всю подготовительную работу, не вводя новых переменных. Если считаете, что это выглядит не особенно красиво, то эту работу можно перенести в другую процедуру.

Повторение пройденного (12.10.2014)

Теперь настало время вернуться к алгоритму ShaGeneratePermutationsTrotter. Как вы помните, основная проблема, которая мешает добиться от него большей скорости, состоит в том, что границы, внутри которых перемещаются почти все символы-челноки, "плавают". Однако самый внешний челнок всегда перемещается между двумя крайними позициями перестановки, что наталкивает на мысль применить идею алгоритма ShaGeneratePermutations для ускорения алгоритма ShaGeneratePermutationsTrotter. А именно, мы откажемся от использования управляющих массивов для внешнего челнока и развернем основной цикл. Получится не особенно красиво, зато быстро:

//движение справа налево
procedure ShaGeneratePermutationsTrotterUnrolled(n: integer);
var
  c, moveright: array[0..maxlength] of integer;
  s: ShortString;
  i, x, k: integer;
  ch: AnsiChar;
begin;
  if (n<=1) or (n>maxlength) then exit; //n<>1
 
  SetLength(s,n);
  for i:=1 to n do begin;
    s[i]:=AnsiChar((Ord(chfirst)-1)+i);
    c[i]:=i-1;
    moveright[i]:=0;
    end;
 
  while true do begin;
    ProcessString(s);
    x:=n-1;
    repeat;
      ch:=s[x]; s[x]:=s[x+1]; s[x+1]:=ch;
      ProcessString(s);
      x:=x-1;
      until x=0;
    i:=n;
    x:=0;
    repeat;
      k:=moveright[i]; k:=k xor -1; moveright[i]:=k;
      i:=i-1;
      x:=x-k;
      if i<=0 then exit;
      k:=c[i];
      c[i+1]:=i;
      until k>0;
    x:=moveright[i] and (i-k-k) + k + x; //if moveright[i]=0 then x:=k+x else x:=i-k+x;
    ch:=s[x]; s[x]:=s[x+1]; s[x+1]:=ch;
    c[i]:=k-1;
 
    ProcessString(s);
    x:=1;
    repeat;
      ch:=s[x]; s[x]:=s[x+1]; s[x+1]:=ch;
      ProcessString(s);
      x:=x+1;
      until x=n;
    i:=n;
    x:=0;
    repeat;
      k:=moveright[i]; k:=k xor -1; moveright[i]:=k;
      i:=i-1;
      x:=x-k;
      if i<=0 then exit;
      k:=c[i];
      c[i+1]:=i;
      until k>0;
    x:=moveright[i] and (i-k-k) + k + x; //if moveright[i]=0 then x:=k+x else x:=i-k+x;
    ch:=s[x]; s[x]:=s[x+1]; s[x+1]:=ch;
    c[i]:=k-1;
    end;
  end;

При больших n процедура ShaGeneratePermutationsTrotterUnrolled приблизительно на 10% быстрее ShaGeneratePermutations.

В случае необходимости в нее можно добавить обработку случая n=1 или реализовать на основе ShaGeneratePermutationsTrotterUnrolled возможности параллельной обработки аналогично процедурам ShaGeneratePermutationsWithSuffix и ShaGeneratePermutationsWithConstraint.

Времена работы процедур

Представление о скорости работы описанных процедур на компьютере с процессором E-6850 дает отладочный вывод для различных значений n:

n=12
1466 ms,  GenerateCombinations(32, 12)
2075 ms,  GeneratePermutations(12)
2106 ms,  GenerateArrangements(12, 11)
3183 ms,  GenerateArrangements(12, 12)
1903 ms,  ShaGeneratePermutationsRecursive(12)
1170 ms,  ShaGeneratePermutations(12)
1404 ms,  ShaGeneratePermutationsWithSuffix(12, 4, *)
1342 ms,  ShaGeneratePermutationsWithConstraint(12, 8, *)
1747 ms,  ShaGeneratePermutationsTrotter(12)
1123 ms,  ShaGeneratePermutationsTrotterUnrolled(12)
 
n=13
2324 ms,  GenerateCombinations(32, 13)
26443 ms,  GeneratePermutations(13)
27456 ms,  GenerateArrangements(13, 12)
41278 ms,  GenerateArrangements(13, 13)
24430 ms,  ShaGeneratePermutationsRecursive(13)
15179 ms,  ShaGeneratePermutations(13)
18751 ms,  ShaGeneratePermutationsWithSuffix(13, 4, *)
16755 ms,  ShaGeneratePermutationsWithConstraint(13, 9, *)
22823 ms,  ShaGeneratePermutationsTrotter(13)
14742 ms,  ShaGeneratePermutationsTrotterUnrolled(13)
 
n=14
226841 ms,  ShaGeneratePermutations(14)
205485 ms,  ShaGeneratePermutationsTrotterUnrolled(14)

Обратите внимание, что в последнем случае процессор тратит всего 7 тактов CPU на одну перестановку. И это с учетом вызова пустой внешней процедуры обработки!

По местам стоять (17.10.2016)

Приведу еще один алгоритм, который может оказаться полезен. Допустим, у нас есть перестановка, которая задает некоторую расстановку элементов массива. Такая перестановка может быть получена, например, алгоритмом Фишера–Йетса или алгоритмом Саттоло. Требуется соответствующим образом переставить элементы массива.

type
  TElem= integer;
  PElems= PIntegerArray;
  PPlaces= PIntegerArray;
 
procedure Place(a: PElems; b: PPlaces; count: integer);
var
  temp: TElem;
  i, j, k: integer;
begin;
  for i:=count-1 downto 1 do begin;
    k:=b[i];
    if k<>i then begin;
      j:=i; b[j]:=j; temp:=a[j];
      repeat;
        a[j]:=a[k];
        j:=k; k:=b[j]; b[j]:=j;
        until k=i;
      a[j]:=temp;
      end;
    end;
  end;

Передвигаясь по перестановке, мы находим элемент, стоящий не на своем месте. Затем циклически сдвигаем элементы, начиная с найденного. Главное здесь - не забыть пометить передвинутые элементы так, как будто они уже стоят на своем месте, чтобы не обработать их повторно.

на главную

Comments (4)

Перебор перестановок - "2 транспозиции (12.07.2014)"

Интересный алгоритм, почти то, что мне понадобилось. Извините за дилетантство, но возможен ли вообще перебор перестановок посредством совершенно однообразных действий? Этакое тупое тасование колоды: сдвинуть три "карты" под низ, поменять местами 4-ю и 17-ю, 9-ю и 24-ю. И так до икотки. Случайность и скорость не важны, программный код не нужен. Количество "карт" заранее не известно, но если потребуется ограничение типа "только четное" или "только число Фибоначчи", то и это допустимо. Можете подсказать такой алгоритм или хоть направление экспериментов?

С уважением,
Борис

N! так не получится

Количество всех перестановок N элементов равно N!
Вы не получите столько состояний несколькими простейшими действиями,
в чем легко убедиться, если запрограммировать их имитацию на компьютере.
Состояния начнут повторяться гораздо раньше.

перебор размещений

Не заработал алгоритм перебора размещений для 2 из 4 и 2 из 6, но правильно работает для 2 из 3 и 2 из 5.

перебор размещений

Спасибо за найденную ошибку.

Случайно опубликовал отладочную версию алгоритма без цикла,
имитирующего перебор хвостовых элементов.

Статью исправил.