Генерация перестановок лениво

Необходимо проверить статья Permutations о wikipeda. Кроме того, существует понятие Factoradic числа.

Так или иначе, математическая проблема довольно трудна.

В C# можно использовать iterator и остановить алгоритм перестановки с помощью yield. Проблема с этим состоит в том, что Вы не можете пойти назад и вперед или использовать index.

Предположение, что мы говорим о лексикографическом порядке по переставляемым значениям, существует два общих подхода, которые можно использовать:

1. преобразовывают одну перестановку элементов к следующей перестановке (как отправленный ShreevatsaR), или
2. непосредственно вычисляют n th перестановка, при подсчете n от 0 вверх.

Для тех (как я;-), кто не говорит C++ как собственные компоненты, приблизьтесь 1, может быть реализован от следующего псевдокода, приняв основанную на нуле индексацию массива с индексным нулем на "левом" (заменяющий некоторой другой структурой, такой как список, "оставлен как осуществление";-):

1. scan the array from right-to-left (indices descending from N-1 to 0)
1.1. if the current element is less than its right-hand neighbor,
     call the current element the pivot,
     and stop scanning
1.2. if the left end is reached without finding a pivot,
     reverse the array and return
     (the permutation was the lexicographically last, so its time to start over)
2. scan the array from right-to-left again,
   to find the rightmost element larger than the pivot
   (call that one the successor)
3. swap the pivot and the successor
4. reverse the portion of the array to the right of where the pivot was found
5. return

Вот пример, запускающийся с текущей перестановки CADB:

1. scanning from the right finds A as the pivot in position 1
2. scanning again finds B as the successor in position 3
3. swapping pivot and successor gives CBDA
4. reversing everything following position 1 (i.e. positions 2..3) gives CBAD
5. CBAD is the next permutation after CADB

Для второго подхода (прямое вычисление n th перестановка), помните, что существует N! перестановки N элементы. Поэтому, если Вы переставляете N элементы, первое (N-1)!, перестановки должны начаться с самого маленького элемента, следующее (N-1)!, перестановки должны начаться со второго самого маленького и так далее. Это приводит к следующему рекурсивному подходу (снова в псевдокоде, нумеруя перестановки и положения от 0):

To find permutation x of array A, where A has N elements:
0. if A has one element, return it
1. set p to ( x / (N-1)! ) mod N
2. the desired permutation will be A[p] followed by
   permutation ( x mod (N-1)! )
   of the elements remaining in A after position p is removed

Так, например, 13-я перестановка ABCD найдена следующим образом:

perm 13 of ABCD: {p = (13 / 3!) mod 4 = (13 / 6) mod 4 = 2; ABCD[2] = C}
C followed by perm 1 of ABD {because 13 mod 3! = 13 mod 6 = 1}
  perm 1 of ABD: {p = (1 / 2!) mod 3 = (1 / 2) mod 2 = 0; ABD[0] = A}
  A followed by perm 1 of BD {because 1 mod 2! = 1 mod 2 = 1}
    perm 1 of BD: {p = (1 / 1!) mod 2 = (1 / 1) mod 2 = 1; BD[1] = D}
    D followed by perm 0 of B {because 1 mod 1! = 1 mod 1 = 0}
      B (because there's only one element)
    DB
  ADB
CADB

Кстати, "удаление" элементов может быть представлено параллельным массивом булевских переменных, который указывает, какие элементы все еще доступны, таким образом, не необходимо создать новый массив на каждом рекурсивном вызове.

Так, для итерации через перестановки ABCD, просто количество от 0 до 23 (4!-1), и непосредственно вычисляют соответствующую перестановку.

функция перестановок в clojure.contrib.lazy_seqs уже утверждает, что сделала просто это.

Больше примеров алгоритмов перестановки для генерации их.

Источник: http://www.ddj.com/architect/201200326

1. Использование Алгоритм Флирта, который является тем известных самых быстрых.
2. Использование Алгоритм к порядку Lexographic.
3. Использование nonlexographic, но работает быстрее, чем объект 2.

1.

PROGRAM TestFikePerm;
CONST marksize = 5;
VAR
    marks : ARRAY [1..marksize] OF INTEGER;
    ii : INTEGER;
    permcount : INTEGER;

PROCEDURE WriteArray;
VAR i : INTEGER;
BEGIN
FOR i := 1 TO marksize
DO Write ;
WriteLn;
permcount := permcount + 1;
END;

PROCEDURE FikePerm ;
{Outputs permutations in nonlexicographic order.  This is Fike.s algorithm}
{ with tuning by J.S. Rohl.  The array marks[1..marksizn] is global.  The   }
{ procedure WriteArray is global and displays the results.  This must be}
{ evoked with FikePerm(2) in the calling procedure.}
VAR
    dn, dk, temp : INTEGER;
BEGIN
IF 
THEN BEGIN { swap the pair }
    WriteArray;
    temp :=marks[marksize];
    FOR dn :=  DOWNTO 1
    DO BEGIN
        marks[marksize] := marks[dn];
        marks [dn] := temp;
        WriteArray;
        marks[dn] := marks[marksize]
        END;
    marks[marksize] := temp;
    END {of bottom level sequence }
ELSE BEGIN
    FikePerm;
    temp := marks[k];
    FOR dk :=  DOWNTO 1
    DO BEGIN
        marks[k] := marks[dk];
        marks[dk][ := temp;
        FikePerm;
        marks[dk] := marks[k];
        END; { of loop on dk }
    marks[k] := temp;l
    END { of sequence for other levels }
END; { of FikePerm procedure }

BEGIN { Main }
FOR ii := 1 TO marksize
DO marks[ii] := ii;
permcount := 0;
WriteLn ;
WrieLn;
FikePerm ; { It always starts with 2 }
WriteLn ;
ReadLn;
END.

2.

PROGRAM TestLexPerms;
CONST marksize = 5;
VAR
    marks : ARRAY [1..marksize] OF INTEGER;
    ii : INTEGER;
    permcount : INTEGER;

PROCEDURE WriteArray;
VAR i : INTEGER;
BEGIN
FOR i := 1 TO marksize
DO Write ;
permcount := permcount + 1;
WriteLn;
END;

PROCEDURE LexPerm ;
{ Outputs permutations in lexicographic order.  The array marks is global   }
{ and has n or fewer marks.  The procedure WriteArray () is global and  }
{ displays the results.                             }
VAR 
    work : INTEGER:
    mp, hlen, i : INTEGER;
BEGIN
IF 
THEN BEGIN { Swap the pair }
    work := marks[1];
    marks[1] := marks[2];
    marks[2] := work;
    WriteArray ;
    END
ELSE BEGIN
    FOR mp :=  DOWNTO 1
    DO BEGIN
        LexPerm<>;
        hlen :=  DIV 2;
        FOR i := 1 TO hlen
        DO BEGIN { Another swap }
            work := marks[i];
            marks[i] := marks[n - i];
            marks[n - i] := work
            END;
        work := marks[n]; { More swapping }
        marks[n[ := marks[mp];
        marks[mp] := work;
        WriteArray;
        END;
    LexPerm<>
    END;
END;

BEGIN { Main }
FOR ii := 1 TO marksize
DO marks[ii] := ii;
permcount := 1; { The starting position is permutation }
WriteLn <   Starting position:  >;
WriteLn
LexPerm ;
WriteLn <   PermCount is   , permcount>;
ReadLn;
END.

3.

PROGRAM TestAllPerms;
CONST marksize = 5;
VAR
    marks : ARRAY [1..marksize] of INTEGER;
    ii : INTEGER;
    permcount : INTEGER;

PROCEDURE WriteArray;
VAR i : INTEGER;
BEGIN
FOR i := 1 TO marksize
DO Write ;
WriteLn;
permcount := permcount + 1;
END;

PROCEDURE AllPerm (n : INTEGER);
{ Outputs permutations in nonlexicographic order. The array marks is    }
{ global and has n or few marks.  The procedure WriteArray is global and    }
{ displays the results.                             }
VAR
    work : INTEGER;
    mp, swaptemp : INTEGER;
BEGIN
IF 
THEN BEGIN { Swap the pair }
    work := marks[1];
    marks[1] := marks[2];
    marks[2] := work;
    WriteArray;
    END
ELSE BEGIN
    FOR mp :=  DOWNTO 1
    DO BEGIN
        ALLPerm<< n - 1>>;
        IF > 
        THEN swaptemp := 1
        ELSE swaptemp := mp;
        work := marks[n];
        marks[n] := marks[swaptemp};
        marks[swaptemp} := work;
        WriteArray;
    AllPerm< n-1 >;
    END;
END;

BEGIN { Main }
FOR ii := 1 TO marksize
DO marks[ii] := ii
permcount :=1;
WriteLn < Starting position;   >;
WriteLn;
Allperm < marksize>;
WriteLn < Perm count is  , permcount>;
ReadLn;
END.