全組み合わせ

久しぶりにプログラミングしたら極端に頭が悪くなっていました。
死にたい。

my @a = qw(a b c d);

@aには何個の値が入っているか分かりません。
これを全組み合わせが欲しいのですが、どのようにするのが良いでしょうか。

abcd
abdc
acbd
acdb
adbc
adcb
bacd
…以下略

できれば、見るからに分かりやすい記述と
速い記述の2種類書いて頂けると幸いです。


ちなみに頑張ってたら作りたいのと全然違う物ができますた。ｳｴｰﾝ
my @a = qw(a b c d e f);
my %h = map{ $_, $a[$_] } 0..$#a; #感覚的によく分からないので数字のハッシュにする。
foreach my $n (0..((@a ** @a) - 1)){
my @p = ();
unshift @p,($n % @a);
while($n = int($n / @a)){
unshift @p, ($n % @a);
};

foreach my $k (@p){
print $h{$k};
}
print "\n";
}
しかも@aが増えると爆発的に遅いです。(当たり前か)

No.2 ベストアンサー 回答者： rararaxx 回答日時： 2015/09/06 08:59

分かりやすいかどうかは個人の好みがあるので、なんとも言えません。

最初のプログラムは、簡単な再帰呼び出しを利用したものです。なお、画面出力すると、それだけで時間がかかりますので数えるだけにしています。画面に出力するには、コメントを外してください。

use strict;
use warnings;
my (@a, @work, $count) = 'a' .. 'd';
search(@a);

sub search {
foreach my $c (@_) {
push @work, $c;
if (@work == @a) {
# print join('', @work), "\n";
++$count;
} else {
search(grep { $c ne $_ } @_);
}
pop @work;
}
}

print "$count\n";


２番目のプログラムでは、(0,1,...,$#a-1,$#a) から ($#a,$#a-1,...,1,0) までを生成しています。私のパソコンで 10 文字 (a〜j) で実行してみると、最初のプログラムが 11 秒、２番目が 8 秒です。11 文字 (a〜k) では、111 秒と 93 秒です。

use strict;
use warnings;
my @a = 'a' .. 'd';
my @idx = 0 .. $#a;
my $count = 1; # print join('', @a[@idx]), "\n";

for (my $i = $#idx; $i > 0; $i--) {
next if $idx[$i-1] > $idx[$i];
if ($i == $#idx) {
@idx[$i-1,$i] = @idx[$i,$i-1];
} else {
foreach my $j (reverse $i .. $#idx) {
if ($idx[$i-1] < $idx[$j]) {
@idx[$i-1,$j] = @idx[$j,$i-1];
@idx[$i .. $#idx] = @idx[reverse($i .. $#idx)];
last;
}
}
}
++$count;
# print join('', @a[@idx]), "\n";
$i = $#idx; redo;
}

print "$count\n";

この回答へのお礼

ありがとうございます。
両方理解することが出来ました。
大変助かりました。

お礼日時：2015/09/06 17:56

No.1 回答者： kmee 回答日時： 2015/09/05 21:41

> 全組み合わせが欲しい

数学用語ですと、「組合せ(Combination)」は順番不問ものものですから、これは「順列(Permutation)」ですね。

順列も組合せもよく使われるものですから、検索すればいろんなアルゴリズムが見つかります。

「自作」が目的でないなら、CPANで順列組合せ用のモジュールをインストールするのも手です。
http://search.cpan.org/search?query=permute&mode …


> @aが増えると爆発的に遅いです。(当たり前か)

n個からn個並べる全順列は n! 個ありますから、どんな工夫しても爆発的に遅くなります。

この回答へのお礼

昨日順列で検索したところ、すぐにいくつか見つけることが出来ました。
ありがとうございます。

お礼日時：2015/09/06 17:54