懒洋洋地生成排列

我正在寻找一个算法来生成一个集合的排列,这样我就可以在 Clojure 制作一个懒列表。也就是说,我想迭代一个排列列表,其中每个排列在我请求之前不会被计算,并且所有的排列不必一次性存储在内存中。

或者我寻找一个算法,在给定一个特定的集合时,它将返回该集合的“下一个”排列,以这样的方式,重复调用函数对其自身输出将循环通过原始集合的所有排列,以某种顺序(顺序是什么并不重要)。

有这种算法吗?我见过的大多数排列生成算法都倾向于一次性(通常是递归地)生成所有的排列,这样就不能扩展到非常大的集合。用 Clojure (或其他函数式语言)实现会很有帮助,但我可以从伪代码中找到答案。

22788 次浏览

You should check the Permutations article on wikipeda. Also, there is the concept of Factoradic numbers.

Anyway, the mathematical problem is quite hard.

In C# you can use an iterator, and stop the permutation algorithm using yield. The problem with this is that you cannot go back and forth, or use an index.

Yes, there is a "next permutation" algorithm, and it's quite simple too. The C++ standard template library (STL) even has a function called next_permutation.

The algorithm actually finds the next permutation -- the lexicographically next one. The idea is this: suppose you are given a sequence, say "32541". What is the next permutation?

If you think about it, you'll see that it is "34125". And your thoughts were probably something this: In "32541",

  • there is no way to keep the "32" fixed and find a later permutation in the "541" part, because that permutation is already the last one for 5,4, and 1 -- it is sorted in decreasing order.
  • So you'll have to change the "2" to something bigger -- in fact, to the smallest number bigger than it in the "541" part, namely 4.
  • Now, once you've decided that the permutation will start as "34", the rest of the numbers should be in increasing order, so the answer is "34125".

The algorithm is to implement precisely that line of reasoning:

  1. Find the longest "tail" that is ordered in decreasing order. (The "541" part.)
  2. Change the number just before the tail (the "2") to the smallest number bigger than it in the tail (the 4).
  3. Sort the tail in increasing order.

You can do (1.) efficiently by starting at the end and going backwards as long as the previous element is not smaller than the current element. You can do (2.) by just swapping the "4" with the '2", so you'll have "34521". Once you do this, you can avoid using a sorting algorithm for (3.), because the tail was, and is still (think about this), sorted in decreasing order, so it only needs to be reversed.

The C++ code does precisely this (look at the source in /usr/include/c++/4.0.0/bits/stl_algo.h on your system, or see this article); it should be simple to translate it to your language: [Read "BidirectionalIterator" as "pointer", if you're unfamiliar with C++ iterators. The code returns false if there is no next permutation, i.e. we are already in decreasing order.]

template <class BidirectionalIterator>
bool next_permutation(BidirectionalIterator first,
BidirectionalIterator last) {
if (first == last) return false;
BidirectionalIterator i = first;
++i;
if (i == last) return false;
i = last;
--i;
for(;;) {
BidirectionalIterator ii = i--;
if (*i <*ii) {
BidirectionalIterator j = last;
while (!(*i <*--j));
iter_swap(i, j);
reverse(ii, last);
return true;
}
if (i == first) {
reverse(first, last);
return false;
}
}
}

It might seem that it can take O(n) time per permutation, but if you think about it more carefully, you can prove that it takes O(n!) time for all permutations in total, so only O(1) -- constant time -- per permutation.

The good thing is that the algorithm works even when you have a sequence with repeated elements: with, say, "232254421", it would find the tail as "54421", swap the "2" and "4" (so "232454221"), reverse the rest, giving "232412245", which is the next permutation.

the permutations function in clojure.contrib.lazy_seqs already claims to do just this.

Assuming that we're talking about lexicographic order over the values being permuted, there are two general approaches that you can use:

  1. transform one permutation of the elements to the next permutation (as ShreevatsaR posted), or
  2. directly compute the nth permutation, while counting n from 0 upward.

For those (like me ;-) who don't speak c++ as natives, approach 1 can be implemented from the following pseudo-code, assuming zero-based indexing of an array with index zero on the "left" (substituting some other structure, such as a list, is "left as an exercise" ;-):

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

Here's an example starting with a current permutation of 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

For the second approach (direct computation of the nth permutation), remember that there are N! permutations of N elements. Therefore, if you are permuting N elements, the first (N-1)! permutations must begin with the smallest element, the next (N-1)! permutations must begin with the second smallest, and so on. This leads to the following recursive approach (again in pseudo-code, numbering the permutations and positions from 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

So, for example, the 13th permutation of ABCD is found as follows:

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

Incidentally, the "removal" of elements can be represented by a parallel array of booleans which indicates which elements are still available, so it is not necessary to create a new array on each recursive call.

So, to iterate across the permutations of ABCD, just count from 0 to 23 (4!-1) and directly compute the corresponding permutation.

More examples of permutation algorithms to generate them.

Source: http://www.ddj.com/architect/201200326

  1. Uses the Fike's Algorithm, that is the one of fastest known.
  2. Uses the Algo to the Lexographic order.
  3. Uses the nonlexographic, but runs faster than item 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.

It looks necromantic in 2022 but I'm sharing it anyway

Here an implementation of C++ next_permutation in Java can be found. The idea of using it in Clojure might be something like

(println (lazy-seq (iterator-seq (NextPermutationIterator. (list 'a 'b 'c)))))

disclaimer: I'm the author and maintainer of the project