flashercs

回复 14# flashercs


    我明白了，性能差主要是函数调用次数太多，那种算法调用了7的阶乘次函数，而用循环来实现会快很多。我那个调用7次函数，所以快一些，但是应该可以只用循环实现的，就是三个嵌套循环。

523066680

C语言已忘光，代码毫无新意

#include <stdio.h>
#include <stdlib.h>
#include <string.h>
 
void f(char *oldstr, char *newstr, int len, int lv)
{
	char *ostr = (char *)malloc( len * sizeof(char) );
	for (int i = 0; i < len; i++)
	{
		strcpy( ostr, oldstr );
 
		newstr[lv] = ostr[i];
		newstr[lv+1] = '\0';
		if (len == 1)
			printf("%s \n", newstr);
 
		for (int j = i; j < (len-1); j++)
			ostr[j] = ostr[j+1];
 
		if ( len > 0 )
			f( ostr, newstr, len-1, lv+1 );
 
	}
}
 
int main(int argc, char *argv[])
{
	char oldstr[] = "bathome";
	char *newstr = (char *)malloc( (strlen(oldstr)+1) * sizeof(char) );
	f(oldstr, newstr, strlen(oldstr), 0);
 
	return 0;
}COPY

Perl (不借用外部模块)

my @cup;
my @nums;
our $len;
@nums = (split("", "bathome"));
$len = $#nums+1;
 
&func(\@cup, \@nums);
 
sub func 
{
    my ($a, $b) = (shift, shift);
    my @ar;
    my @br;
    
    print join(",", @{$a}),"\n" if ( scalar(@{$a}) == $len );
 
    for my $i ( 0 .. $#{$b} )
    {
        @ar = (@{$a}, $b->[$i]);
        @br = @{$b}[0..$i-1, $i+1..$#{$b}];
        &func(\@ar, \@br);
    }
}COPY

以下拷贝自《High-Order Perl》

sub permute 
{
	my @items = @{ $_[0] };
	my @perms = @{ $_[1] };
	unless (@items) 
	{
		print join("", @perms) ,"\n";
	}
	else 
	{
		my(@newitems,@newperms,$i);
		for $i (0 .. $#items) 
		{
			@newitems = @items;
			@newperms = @perms;
			unshift(@newperms, splice(@newitems, $i, 1));
			permute([@newitems], [@newperms]);
		}
	}
}
 
# sample call:
permute([qw(b a t h o m e)], []);COPY

《High-Order Perl》里面有更有趣的思路，午休，有空再更

happy886rr

回复 16# flashercs

你的速度确实蛮快，但是那个批处理版就很慢了。

523066680

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:

#!/usr/bin/perl -n
# Fischer-Krause ordered permutation generator
 
sub permute (&@) {
    my $code = shift;
    my @idx = 0..$#_;
    while ( $code->(@_[@idx]) ) {
        my $p = $#idx;
        --$p while $idx[$p-1] > $idx[$p];
        my $q = $p or return;
        push @idx, reverse splice @idx, $p;
        ++$q while $idx[$p-1] > $idx[$q];
        @idx[$p-1,$q]=@idx[$q,$p-1];
    }
}
 
permute { print "@_\n" } split;COPY

来自 perldoc -q permute， 调用示例：echo a b c | permute.pl
刚开始真没看懂，蜜汁语法 ……
只看出来说是 knuth 在 计算机程序设计艺术 卷4 里面提到的算法，该书还未出版。

待会儿再更

a20150604

8 楼置换算法的 JS 和 VBS 版

JS

Z = "1;";
for( j = 2; j <= 7; j++ ) {
    t = Z;
    Z = Z.replace(/;/g, j + ";")
    for ( i = 1; i <= j - 1; i++ ) Z = Z + t.replace(RegExp(i, "g"), j).replace(/;/g, i + ";");
}
for( i = 1; i <= 7; i++ ) Z = Z.replace(RegExp(i, "g"), "bathome".substr(i - 1, 1));
console.log(Z);COPY

VBS

Z = "1;"
For j = 2 To 7
    t = Z
    Z = Replace(Z, ";", j & ";")
    For i = 1 To j - 1
      Z = Z & Replace(Replace(t, i, j), ";", i & ";")
    Next
Next
For i = 1 To 7
    Z = Replace(Z, i, Mid("bathome", i, 1))
Next
WScript.Echo ZCOPY

a20150604

http://www.cs.utsa.edu/~wagner/knuth/

Donald E. Knuth  
  The Art of Computer
Programming
Volume 4,
Combinatorial Algorithms

523066680

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

/* Translate by 523066680@163.com */
#include <stdio.h>
 
void splice_and_reverse( int *arr, int p, int ubound )
{
	int t;
	for (int i = p; i <= (ubound+p)/2 ; i++ )
	{
		t = arr[i];
		arr[i] = arr[ubound - i + p];
		arr[ubound - i + p] = t;
	}
}
 
void exchange(int *arr, int a, int b)
{
	int t;
	t = arr[a];
	arr[a] = arr[b];
	arr[b] = t;
}
 
void print_array(int *arr, int ubound)
{
	for (int i = 0; i <= ubound; i++)
		printf("%d", arr[i]);
 
	printf("\n");
}
 
int main(int argc, char *argv[] ) 
{
	int arr[] = {0, 1, 2, 3};
	int ubound = sizeof(arr) / sizeof(arr[0]) - 1;
	int p, q;
 
	while (1)
	{
		p = ubound;
 
		//p 递减，直到 当前元素 > 上一个元素 ，上一个元素记为 N
		while ( arr[p-1] > arr[p] ) p--;
 
		if ( p <= 0 ) break;
 
		q = p;
 
		//反转 从 p 至 末尾的元素
		splice_and_reverse( arr, p, ubound );
 
		//q 递增，直到当前元素 > N
		while ( arr[p-1] > arr[q] ) q++;
 
		//交换
		exchange(arr, p-1, q);
 
		//打印结果
    	print_array(arr, ubound);
	}
 
    return 0;
}COPY

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

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

• init p = 5, 当 arr[p-1] > arr[p], p递减, p = 2; 记住 arr[p-1] = 3
  
• 反转后面 2,3,4,5 位, arr[] = 5 3 0 1 2 4;
  
• 之后的计算依据 5 3 0 1 2 4
  
• init q = p = 2; 当 3 > arr[q], q递增, q = 5;
  从 5 3 0 1 2 4 调换 arr[1] arr[5] 得
  

arr[] = 5 4 0 1 2 3

taofan712

@echo off & setlocal enabledelayedexpansion
set "str[0]= b a t h o m e"
set tm1=%time%
for %%a in (%str[0]%) do (
	set /a n+=1
	set /a odr[!n!]=n-1
	set var[!n!]=%%~a
)
::FOR的嵌套递归，借鉴了http://bbs.bathome.net/viewthread.php?tid=1701&extra=&page=2中22楼CrLf的答案。
for /l %%a in (1, 1, %n%) do if not "%%~a"=="%n%" (
	set "for=!for!for %%!var[%%~a]! in (^!str[!odr[%%~a]!]^!) do ( set "str[%%~a]=^^^!str[!odr[%%~a]!]: %%~!var[%%~a]!=^^^!" & "
) else (
	set "for=!for!for %%!var[%%~a]! in (^!str[!odr[%%~a]!]^!) do ( "
)
set "for=!for!echo;!str[0]: = %%~!"
for /l %%a in (1, 1, %n%) do set "for=!for!) "
%for%
echo;	始于%tm1% ^
	终于%time%
pauseCOPY

523066680

回复 10# codegay


    我可是在知乎给论坛打了广告哇 https://www.zhihu.com/question/57102581/answer/152543345

523066680

编辑/整理：523066680@163.com
日期：2017-05

序

通过迭代方式获得排列的方案，参考自《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)
一共能产生 432*1 种模式(pattern) （刚好对应24种排列情况）

不同模式的生成和换算

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



my @elements = qw/a b c d/;   #元素 my $seats = $#elements + 1;   #数量 my @order = (0) x $seats;     #初始模板 to_pattern(5, $seats, \@order); print join(",", @order); sub to_pattern                #转换器 {     my ($num, $seats, $o_ref) = @_;     my $mod;     for my $div ( 1 .. $seats )     {         $mod = $num % $div;         $num = int($num / $div);         $o_ref->[-$div] = $mod;    #倒序填入     } }


输出: 0,2,1,0

将模式应用到排列顺序

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



my @elements = qw/a b c d/; my $seats = $#elements + 1; my @order = (0, 2, 1, 0); apply(\@elements, \@order); sub apply {     my ($e_ref, $o_ref) = @_;     my @temp = @$e_ref;     my @final;     for my $idx ( @$o_ref )     {         push @final, splice( @temp, $idx, 1 );     }     print join(",", @final),"\n"; }


输出：a,d,c,b

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

枚举所有情况的代码：

use strict; my @elements = qw/a b c d e/; my $seats = $#elements + 1; my @order = (0) x $seats; for my $n ( 0 .. factorial($seats)-1 ) {     my @result;     to_pattern($n, $seats, \@order);     apply( \@elements, \@order, \@result );     print join(",", @result), "\n"; } sub to_pattern {     my ($n, $seats, $o_ref ) = @_;     my $mod;     for my $div ( 1 .. $seats )     {         $mod = $n % $div;         $n = int($n / $div);         $o_ref->[-$div] = $mod;    #从右边向左填入     } } sub apply {     my ($e_ref, $o_ref, $result) = @_;     my @temp = @$e_ref;     for my $idx ( @$o_ref )     {         push @$result, splice( @temp, $idx, 1 );     } } sub factorial {     my $v = shift;     return ($v > 1) ? $v*factorial($v-1) : 1; }

[Finished in 0.9s]

CrLf

回复 10# codegay


    何止是不错...我刷完贴只能灰溜溜逃了好吗

523066680

Perl 6 (这也太梦幻了)

Works with: rakudo version 2014-1-24
First, you can just use the built-in method on any list type.



.say for <a b c>.permutations


Output:
a b c
a c b
b a c
b c a
c a b
c b a

python

Standard library function
Works with: Python version 2.6+



import itertools for values in itertools.permutations([1,2,3]):     print (values)

Ruby (也是挺梦幻的)

[1,2,3].permutation.to_a

[Finished in 0.2s]

老刘1号

填坑，汇编递归版

Include masm32rt.inc
.const
	CrLf db 0DH,0AH,0
.data?
	Input db 20 dup (?)
.code
	recursion Proc Uses Ebx Eax Ecx lpStr:dword
		Mov Ebx,lpStr
		.If Byte Ptr [Ebx+1] != NULL
			Mov Al,Byte Ptr [Ebx]
			Xor Ecx,Ecx
			.Repeat
				XChg Al,[Ebx+Ecx]
				Mov Byte Ptr [Ebx],Al
				Inc Ebx
				Invoke recursion,Ebx
				Dec Ebx
				XChg Al,[Ebx+Ecx]
				Mov Byte Ptr [Ebx],Al
				Inc Ecx
			.Until Byte Ptr [Ebx+Ecx] == NULL
		.Else
			Invoke StdOut,Offset Input
			Invoke StdOut,Offset CrLf
		.EndIf
		Ret
	recursion Endp
 
	Start:
		Invoke ArgClC,1,Offset Input
		Invoke recursion,Offset Input
		Invoke ExitProcess,NULL
	End Start
EndCOPY