[算法]Permutation - 元素排列

[523066680]

2楼 迭代算法分析 - Fischer-Krause ordered permutation 转 C 代码，以及解释
[4楼]递归+元素调换 —— 最直接的算法
[5楼]耳目一新的迭代法 —— 通过进制转换原理计算模式，再应用到排列

[523066680]

Fischer-Krause ordered

Here's a little program that generates all permutations of all the words
on each line of input. The algorithm embodied in the "permute()"
function is discussed in Volume 4 (still unpublished) of Knuth's *The
Art of Computer Programming* and will work on any list:

Code: [全选] [展开/收缩] [Download] (permute.pl)

1. #!/usr/bin/perl -n
2. # Fischer-Krause ordered permutation generator
3.  
4. sub permute (&@) {
5.     my $code = shift;
6.     my @idx = 0..$#_;
7.     while ( $code->(@_[@idx]) ) {
8.         my $p = $#idx;
9.         --$p while $idx[$p-1] > $idx[$p];
10.         my $q = $p or return;
11.         push @idx, reverse splice @idx, $p;
12.         ++$q while $idx[$p-1] > $idx[$q];
13.         @idx[$p-1,$q]=@idx[$q,$p-1];
14.     }
15. }
16.  
17. permute { print "@_\n" } split;

来自 perldoc -q permute， 调用示例：echo a b c | permute.pl

解读和代码转C，主要是有一个数字调换的规律

Code: [全选] [展开/收缩] [Download] (Untitled.c)

1. /* Translate by 523066680@163.com */
2. #include <stdio.h>
3.  
4. void splice_and_reverse( int *arr, int p, int ubound )
5. {
6.     int t;
7.     for (int i = p; i <= (ubound+p)/2 ; i++ )
8.     {
9.         t = arr[i];
10.         arr[i] = arr[ubound - i + p];
11.         arr[ubound - i + p] = t;
12.     }
13. }
14.  
15. void exchange(int *arr, int a, int b)
16. {
17.     int t;
18.     t = arr[a];
19.     arr[a] = arr[b];
20.     arr[b] = t;
21. }
22.  
23. void print_array(int *arr, int ubound)
24. {
25.     for (int i = 0; i <= ubound; i++)
26.         printf("%d", arr[i]);
27.  
28.     printf("\n");
29. }
30.  
31. int main(int argc, char *argv[] )
32. {
33.     int arr[] = {0, 1, 2, 3};
34.     int ubound = sizeof(arr) / sizeof(arr[0]) - 1;
35.     int p, q;
36.  
37.     while (1)
38.     {
39.         p = ubound;
40.  
41.         //p 递减，直到 当前元素 > 上一个元素 ，上一个元素记为 N
42.         while ( arr[p-1] > arr[p] ) p--;
43.  
44.         if ( p <= 0 ) break;
45.  
46.         q = p;
47.  
48.         //反转 从 p 至 末尾的元素
49.         splice_and_reverse( arr, p, ubound );
50.  
51.         //q 递增，直到当前元素 > N
52.         while ( arr[p-1] > arr[q] ) q++;
53.  
54.         //交换
55.         exchange(arr, p-1, q);
56.  
57.         //打印结果
58.         print_array(arr, ubound);
59.     }
60.  
61.     return 0;
62. }

有了这一个规则，我们可以 通过某个中间的排列得出下一个结果：

举一个 6 位的
arr[] = 5 3 4 2 1 0

• 从右往左寻找 前一项小于当前项 的情况(3和4), 下标 p = 2; 记住前一项 = 3
• 反转以 p 为起点，至末尾的项, arr[] = 5 3 0 1 2 4
• 之后的计算依据 5 3 0 1 2 4
• 以 arr[2] 为起点，向右寻找 > 3 的项的下标, 4 > 3, 所以 q = 5;
  从 5 3 0 1 2 4 调换 arr[p-1], arr[q], 得

arr[] = 5 4 0 1 2 3

等有时间就做个图什么的... 未完待续

[523066680]

另一段 Perl 排列元素的代码 看上去相当简练，不过应该还是递归提取和堆叠元素的思路，只是语法糖用的比较到位。

Permutations using Perl

steabert - There is a nice lecture on YouTube in the Stanford programming paradigms series about doing permutation with recursion and double mapping in Scheme. In Perl, I came up with the following implementation for the algorithm:

Code: [全选] [展开/收缩] [Download] (Untitled.pl)

1. #!/usr/bin/perl
2. use strict;
3. use warnings;
4.  
5. my @array = qw(a b c);
6.  
7. sub permute {
8.     return ([]) unless (@_);
9.     return map {
10.       my @cdr = @_;
11.       my $car = splice @cdr, $_, 1;
12.       map { [$car, @$_]; } &permute(@cdr);
13.     } 0 .. $#_;
14. }
15.  
16. print "@$_\n" foreach (&permute (@array));

[523066680]

这段代码引自：http://bbs.bathome.net/thread-43749-1-1.html

Code: [全选] [展开/收缩] [Download] (Untitled.cpp)

1. #include <stdio.h>
2. #include <string.h>
3.  
4. void swap(char *a, char *b)
5. {
6.       char tmp = *a;
7.       *a = *b;
8.       *b = tmp;
9. }
10.  
11. void arrange(char *str, int start, int end)
12. {
13.       int i;
14.       if(start == end)
15.       {
16.             printf("%s\n",str);
17.  
18.       }else{
19.             for(i = start; i < end; i++)
20.             {
21.                   swap(str+start,str+i);
22.                   arrange(str,start+1,end);
23.                   swap(str+start,str+i);
24.             }
25.  
26.       }
27. }
28.  
29. int main(void)
30. {
31.       char str[10]="bathome";
32.       int len = strlen(str);
33.       arrange(str,0,len);
34.       return 0;
35. }

和常规的递归思路一样，层层提取，但是把递归结构应用到极致，没有多余的副本创建，整个代码展现出一种概念：

数据 即 结构，结构 即 数据。

[523066680]

编辑/整理：523066680@163.com
日期：2017-05
转载请注明出处：http://www.code-by.org/viewtopic.php?f=29&t=261

序

通过迭代方式获得排列的方案，参考自《Higher-Order Perl》

概念

假设有4个元素: @arr = (a, b, c, d)，下标为 0 1 2 3，每提取一个元素，
数组重新定义，下标从0开始。排列和下标的提取关系：
a b c d -> 0 0 0 0
a b d b -> 0 0 1 0
a c b d -> 0 1 0 0
a c d b -> 0 1 1 0
a d b c -> 0 2 0 0
...

注意这里数字的变化和进制换算、递增非常相似，区别在于，每一位的进制是不同的：
末位始终为0，
倒数第二位最大为1(0,1)，
倒数第三位最大为2(0,1,2)，
倒数第四位最大为3(0,1,2,3)
一共能产生 4×3×2×1 种模式(pattern) （刚好对应24种排列情况）

不同模式的生成和换算

先设计一种换算函数，对于传入的任意数字，计算出对应的模式：

Code: [全选] [展开/收缩] [Download] (untitle.pl)
1. my @elements = qw/a b c d/;   #元素
2. my $seats = $#elements + 1;   #数量
3. my @order = (0) x $seats;     #初始模板
4.  
5. to_pattern(5, $seats, \@order);
6. print join(",", @order);
7.  
8. sub to_pattern                #转换器
9. {
10.     my ($num, $seats, $o_ref) = @_;
11.     my $mod;
12.  
13.     for my $div ( 1 .. $seats )
14.     {
15.         $mod = $num % $div;
16.         $num = int($num / $div);
17.         $o_ref->[-$div] = $mod;    #倒序填入
18.     }
19. }

输出: 0,2,1,0

将模式应用到排列顺序

再写一个函数将 模式应用于顺序地提取数组元素

Code: [全选] [展开/收缩] [Download] (untitle.pl)
1. my @elements = qw/a b c d/;
2. my $seats = $#elements + 1;
3. my @order = (0, 2, 1, 0);
4.  
5. apply(\@elements, \@order);
6.  
7. sub apply
8. {
9.     my ($e_ref, $o_ref) = @_;
10.     my @temp = @$e_ref;
11.     my @final;
12.  
13.     for my $idx ( @$o_ref )
14.     {
15.         push @final, splice( @temp, $idx, 1 );
16.     }
17.  
18.     print join(",", @final),"\n";
19. }

输出：a,d,c,b

这样，不管想要哪一个序列，只要通过类似进制换算的方法算出模式，按模式提取即可

枚举所有情况的代码：

Code: [全选] [展开/收缩] [Download] (untitle.pl)
1. use strict;
2. my @elements = qw/a b c d e/;
3. my $seats = $#elements + 1;
4. my @order = (0) x $seats;
5.  
6. for my $n ( 0 .. factorial($seats)-1 )
7. {
8.     my @result;
9.     to_pattern($n, $seats, \@order);
10.     apply( \@elements, \@order, \@result );
11.     print join(",", @result), "\n";
12. }
13.  
14. sub to_pattern
15. {
16.     my ($n, $seats, $o_ref ) = @_;
17.     my $mod;
18.  
19.     for my $div ( 1 .. $seats )
20.     {
21.         $mod = $n % $div;
22.         $n = int($n / $div);
23.         $o_ref->[-$div] = $mod;    #从右边向左填入
24.     }
25. }
26.  
27. sub apply
28. {
29.     my ($e_ref, $o_ref, $result) = @_;
30.     my @temp = @$e_ref;
31.  
32.     for my $idx ( @$o_ref )
33.     {
34.         push @$result, splice( @temp, $idx, 1 );
35.     }
36. }
37.  
38. sub factorial
39. {
40.     my $v = shift;
41.     return ($v > 1) ? $v*factorial($v-1) : 1;
42. }

[rubyish]

laige perl ~~

Code: [全选] [展开/收缩] [Download] (abc.pl)

1. #!/usr/bin/perl
2. # version 26, subversion 1 (v5.26.1)
3.  
4. use 5.010;
5.  
6.  
7. #my @data = grep chomp, <DATA>;
8. my @data = 'A' .. 'I';
9.  
10. #perm( \@data, 4 );
11.  
12. perm( \@data, ~~@data );
13.  
14. # ____________________SUB____________________
15. sub perm {
16.     my ( $data, $numba ) = @_;
17.     my @indes = 0 .. $numba - 1;
18.     my @use   = (0) x $numba;
19.     @use[@indes] = (1) x @indes;
20.  
21.     my $new = 1;
22.     while ($new) {
23.         say @{$data}[@indes];
24.         $new = 0;
25.  
26.         for ( my $poz = $#indes ; $poz >= 0 ; $poz-- ) {
27.             $use[ $indes[$poz] ] = 0;
28.  
29.             for my $it ( $indes[$poz] + 1 .. $#use ) {
30.                 $new = $it, last if !$use[$it];
31.             }
32.  
33.             next if !$new;
34.  
35.             $use[$new]   = 1;
36.             $indes[$poz] = $new;
37.             my $next = 0;
38.             for my $p ( $poz + 1 .. $#indes ) {
39.                 for my $it ( $next .. $#use ) {
40.                     if ( not $use[$it] ) {
41.                         $use[$it]  = 1;
42.                         $indes[$p] = $it;
43.                         $next      = $it + 1;
44.                         last;
45.                     }
46.                 }
47.             }
48.  
49.             last;
50.         }
51.     }
52. }
53.  
54. __DATA__
55. $_

[523066680]

laige perl ~~

Code: [全选] [展开/收缩] [Download] (abc.pl)

1. #!/usr/bin/perl
2. # version 26, subversion 1 (v5.26.1)

我就想起来你在 CU 的蜜汁代码

代码: 全选

E_( [ 1 .. 9 ], [] );

sub E_
{
    my ( $a, $b ) = @_;
    #此处省略若干代码
    E_( [ @$a[ 0 .. $_ - 1, $_ + 1 .. $#$a ] ], [ @$b, $a->[$_] ] )
        for 0 .. $#$a;
}

当时我还做了图，