アルファベットn文字の組み合わせ一覧を生成するサブルーチン

質問

「アルファベットを格納した配列」と「文字列長」を引数として与えると、全ての組み合せの文字列を返してくれるサブルーチンを定義するにはどうすればよろしいでしょうか？
「文字列長」が２や３の場合には以下のようにforeach文を入れ子にしていますが、「文字列長」の変化に対応できるようなサブルーチンを定義したいと考えます。

@cc = qw(a b c d); # アルファベットを格納した配列

「文字列長」が２の場合、
foreach my $c1 (@cc){
foreach my $c2 (@cc){
push(@str, $c1.$c2);
}
}

aa ab ac ad ba bb bc bd ca cb cc cd da db dc dd

「文字列長」が３の場合、
foreach my $c1 (@cc){
foreach my $c2 (@cc){
foreach my $c3 (@cc){
push(@str, $c1.$c2.$c3);
}
}
}

aaa aab aac aad aba abb abc abd aca acb acc acd ada adb adc add baa bab bac bad bba bbb bbc bbd bca bcb bcc bcd bda bdb bdc bdd caa cab cac cad cba cbb cbc cbd cca ccb ccc ccd cda cdb cdc cdd daa dab dac dad dba dbb dbc dbd dca dcb dcc dcd dda ddb ddc ddd

アドバイスをよろしくお願いします。

回答No.2

kabaokaba · ベストアンサー

No.1です．
問題を誤読してました．
順列ではないですね．
問題は，文字が``N''種類あるときに
n桁の文字列を生成するということでした．

N進数のn桁の数をすべて列挙するのと同じなので
例えば以下のようにできます．

use strict;
use warnings;

use strict;
use warnings;

sub to_N_pos{
my ($n,$N,$L)=@_;
my @result;
for my $i (1..$L){
unshift @result, $n % $N;
$n = int($n / $N);
}
return $n ? () : @result;
}

sub listup{
my ($list,$L)=@_;
my @result;
my $N=scalar @{$list};
my $n=0;
while(my @r = to_N_pos($n,$N,$L)){
my $result;
for my $i (@r){
$result = $result.$list->[$i];
}
push @result, $result;
$n++;
}
return @result;
}

$,=", ";
print listup(['a'..'d'],2);

listupは
文字のリストのリファレンス，文字列の長さ
を引数として，
結果を配列として出力します．

お礼

迅速なアドバイスをいただき心より感謝申し上げます。

回答No.4

Tacosan

試していないので無保証ですが, 再帰を使わずがんばってみる:
sub allstring(\@$) {
my ($alphabet, $count) = @_;
my @ans = ();
for my $i (1 .. $count) {
my @tmp = ();
for my $ch (@$alphabet) {
push @tmp, map { $_ . $ch } @ans;
}
@ans = @tmp;
}
@ans;
}
例:
$, = ',';
print allstring(['a' .. 'd'], 2), "\n";

補足

回答ありがとうございました。以下のエラーが出力されました
Type of arg 1 to main::allstring must be array (not single ref constructor) at Tacosan.pl line 15, near "2)"
Execution of Tacosan.pl aborted due to compilation errors.

回答No.3

kumoz

再帰呼び出しを使った方法です。

use strict;
my @cc = qw(a b c d);
my $n = 3; # 文字列長を指定
my @result; my @work = ();

search(@cc);

sub search {
my @list = @_;
foreach my $item (@list) {
if (@work == ($n - 1)) {
push @result, join('', @work, $item);
} else {
push @work, $item;
search(@list);
pop @work;
}
}
}

print "@result\n";

お礼

再帰呼び出しを使った方法は大変勉強になりました。ありがとうございました。

回答No.1

kabaokaba

http://faq.perl.org/perlfaq4.html
↑で
How do I permute N elements of a list?
という項目を見ましょう．

MJDの``Higher-Order Perl''という書籍では
4.3.1節にかなり詳細にでています．
コードそのものは http://hop.perl.plover.com/Examples/
の``permuteなんちゃらら''というものです．
何種類かあります．

一般的にやるとかなり複雑なコードになります．