今回は、順列の生成について取りあげます。5 種類のプログラムを紹介しますが、どれも機能としては同じです。いろいろな書き方があることを知ってもらいたいと思います。どれも長いコードではないので、理解するのはそれほど難しくはありません。順列生成の対象は、配列に格納されたアルファベット各文字を使います。まずは、foreach の積み重ねに関連したもので、2 つのプログラムを考えてみました。文字数が固定であれば、次のプログラムで順列を生成できます。
use strict;
use warnings;
my @alpha0 = 'a' .. 'd';
foreach my $c0 (@alpha0) {
my @alpha1 = grep { $c0 ne $_ } @alpha0;
foreach my $c1 (@alpha1) {
my @alpha2 = grep { $c1 ne $_ } @alpha1;
foreach my $c2 (@alpha2) {
my @alpha3 = grep { $c2 ne $_ } @alpha2;
foreach my $c3 (@alpha3) {
print $c0, $c1, $c2, $c3, "\n";
}
}
}
}
上記のプログラムは 4 文字の順列を生成しますが、違う文字数ではその都度書き直す必要があります。それを避けて、可変の文字数に対応するには一工夫が必要になります。次のプログラム１では、コード内で文字列として foreach の積み重ねを作って、eval を使って実行させています。
プログラム１ use strict; use warnings; my @alpha0 = 'a' .. 'j'; my $code = qq|foreach my \$c0 (\@alpha0) {\n|; my $job1 = qq| ++\$count;\n|; my $job2 = qq| # print \$c0|; # 順列の表示: qq内のシャープを除去 my $tail = qq|}\n|; my ($indent, $count) = ('', 0); foreach my $i (1 .. $#alpha0) { $indent .= " "; my $j = $i - 1; $code .= qq|${indent}my \@alpha$i = grep { \$c$j ne \$_ } \@alpha$j;\n|; $code .= qq|${indent}foreach my \$c$i (\@alpha$i) {\n|; $job2 .= qq|,\$c$i|; $tail = qq|${indent}}\n| . $tail; if ($i == $#alpha0) { $job1 =~ s/^/$indent/; $job2 =~ s/^/$indent/; $job2 =~ s/$/, "\\n";\n/; } } $code = $code . $job1 . $job2 . $tail; # print $code; eval $code; print "$count\n";
文字数が多い場合、順列をコンソールに出力するとそれだけで非常に多くの時間がかかるため、順列数 (n!) を数えるだけにしています。プログラムの下に、10文字と 11 文字で実行したときの私のパソコンでの実行時間を参考程度に記しています。なお、コメントを外すと出力できるようになっています。
コードを文字列として組み立てるのは、当然ながら通常のコードを書くのよりも煩雑で難しくなります。短いコード (例えば、eval(join '*', 1 .. 5);) では何ら戸惑うこともないのですが、長くなるコードでは何らかの対応が必要です。デバッグ用に print 文の活用は一般的ですが、コードを文字列で組み立てる場合はより有用です。
# print $code;
eval $code;
print "$count\n";
文字列の組み立て段階では、print $code; を有効にして eval code; をコメント化しておきます。print $code; の表示は、冒頭に掲げたコードと同じになるように、インデントを入れて適切な改行を付け加えておきます。また、eval でのコードの実行は、エラーの扱いが通常のコードと異なります。eval で実行するコードに致命的なエラーがあっても、実行が中断してエラーメッセージが表示されることはありません。eval のエラーは特殊変数の $@ に入り、(今回のコードには入れてないが) 自力でチェックする必要があります。
foreach ループの積み重ねプログラムの 2 番目は、再帰呼び出しを利用したものです。search サブルーチンが呼び出される毎に foreach ループが追加され、冒頭に掲げたプログラムのような foreach の積み重ねを実現します。
プログラム２ use strict; use warnings; my (@alpha, @work, $count) = 'a' .. 'j'; search(@alpha); sub search { foreach my $c (@_) { push @work, $c; if (@work == @alpha) { # print join('', @work), "\n"; ++$count; } else { search(grep { $_ ne $c } @_); } pop @work; } } print "$count\n";
再帰呼び出しサブルーチンに理解があれば、特に難しい点はありません。次の search サブルーチンの呼び出しは、受け取った引数 (@_) から現在選択されている文字を除外して引数として渡します。再帰呼び出しの停止条件は、作業用の配列の @work の要素数が配列 @alpha の要素数と同じになることです。
プログラム３では添字の数値を対象に順列を生成して、join('', @alpha[@idx]) という形で順列を出力しています。もっとも、順列数を数えるだけで出力をコメント化しているので、数値の順列と思ってもらってかまいません (実際に join('', @idx) とすれば数値の順列になる)。
数値の順列は、例えば 5 桁の 0 〜 4 であれば、昇順の (0,1,2,3,4) から降順の (4,3,2,1,0) までを生成することになります。現在の順列から次の順列の生成は数値の交換を用い、次の 3 段階の処理を行います。
数値を増加する位置を求める
順列の生成が終わるのは、すべての数値が降順に並んだときです。このことは、下位の一部分にも当てはまります。次の例では、下位 3 桁の数値が降順になり、上から 2 番目の数値を増加する過程を示しています。
0, 1, 4, 3, 2 --> 0, 2, 4, 3, 1 0, 2, 1, 3, 4 ... 0, 2, 4, 3, 1 --> 0, 3, 4, 2, 1 0, 3, 1, 2, 4 ... 0, 3, 4, 2, 1 --> 0, 4, 3, 2, 1 0, 4, 1, 2, 3 ... 1, 0, 4, 3, 2 --> 1, 2, 4, 3, 0 1, 2, 0, 3, 4 ...
数値を増加する位置を求めるには、下位から隣接する 2 つの数値を比較します。最初に末尾の 2 つを比較して「上位の数値 < 下位の数値」なら末尾から 2 番目、「上位の数値 > 下位の数値」なら見つかるまで (見つからなければ生成終了) 同様の比較を続けます。
数値を交換する
増加する位置が下から 2
番目であれば、末尾の数値と交換して次の順列が生成されたことになり、3. の処理は省略できます。下から 3
番目以上では、次の位置から末尾までの数値のうち、大きくより近い数値 (上記の青字)
が、交換対象の数値になります。
交換対象の位置にはローテーションがあり、上記の例では (5→4→3) がローテーションになります。最上位の数値 (0,1,2,3,4) が変わる毎に (5→4→3) が繰り返されます。ローテーションを管理すれば、その都度交換対象の数値を探す必要がなくなります。
必要なら数値を増加した次の位置から末尾までを並び替える
数値を増加する次の位置から末尾までは降順に並んでおり、数値を交換した後も降順は維持されます。順列の生成は昇順から始まるので、次の位置から末尾までを逆順に並び替えることになります。
プログラム３ use strict; use warnings; my @alpha = 'a' .. 'j'; my @idx = 0 .. $#alpha; my ($count, @swap_pos) = (1, ($#idx) x (@idx - 2)); # print join('', @alpha[@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 { my $j = $swap_pos[$i-1]; @idx[$i-1,$j] = @idx[$j,$i-1]; @idx[$i .. $#idx] = @idx[reverse($i .. $#idx)]; $swap_pos[$i-1] = $j == $i ? $#idx : $j - 1; } ++$count; # print join('', @alpha[@idx]), "\n"; if ($i < $#idx) { $i = $#idx; redo; } } print "$count\n";
@swap_pos が交換対象の位置のローテーションを管理する配列です。プログラム中の for ループは、ループ中でループ変数への代入や next と redo 演算子を使うという、(行儀の悪い) 複雑なループになっています。10 文字の場合、通常の for ループなら 9 回で終了しますが、コード中の for ループは 4,420,900 回ループすることになります。
ウソだと思われるかも知れませんが、順列の最初の 2 つ (2 文字の順列) だけを基にすべての順列を生成することができます。プログラム３では、配列の添字 (0, 1, ... $#alpha-1, $#alpha) から ($#alpha, $alpha-1, ... 1, 0) までをループで生成して、@alpha[@idx] という配列スライスで順列を生成しました。そのとき思いついた方法で、添字を生成済みの添字で操作します。a〜j の 10 文字を例に、説明してみましょう。
abcdefghij (0,1,2,3,4,5,6,7,8,9) abcdefghji (0,1,2,3,4,5,6,7,9,8)
先頭の a 〜 h までの文字を無視すれば、末尾の 2 文字の順列になっています。ここから 3 文字の順列を作るのですが、すでに h が先頭の順列はできているので、残る i と j が先頭の順列を作成すればよいことになります。それには、(0,1,2,3,4,5,6,8,7,9) と (0,1,2,3,4,5,6,9,7,8) を作り、それぞれに (0,1,2,3,4,5,6,7,8,9) と (0,1,2,3,4,5,6,7,9,8) を添字で指定して新たな @alpha 用の添字を作ります。
@base_idx = (0,1,2,3,4,5,6,8,7,9);
@idx = @base_idx[0,1,2,3,4,5,6,7,8,9];
print join('', @alpha[@idx]), "\n"; # abcdefgihj
@idx = @base_idx[0,1,2,3,4,5,6,7,9,8];
print join('', @alpha[@idx]), "\n"; # abcdefgijh
@base_idx = (0,1,2,3,4,5,6,9,7,8);
@idx = @base_idx[0,1,2,3,4,5,6,7,8,9];
print join('', @alpha[@idx]), "\n"; # abcdefgjhi
@idx = @base_idx[0,1,2,3,4,5,6,7,9,8];
print join('', @alpha[@idx]), "\n"; # abcdefgjih
先の 2 つに新たに生成した 4 つを追加すると、以下のようになります。末尾の 3 文字列とリストの末尾の 3 要素を見れば、順列が生成されていることがわかります。(なお、@idx = @base_idx[0,1,2,3,4,5,6,7,8,9]; と @idx = @base_idx; は同じですが、最上位では 1/9! の比率になるので条件判定で除外するよりも効率的とも言えます。)
abcdefghij (0,1,2,3,4,5,6,7,8,9)
abcdefghji (0,1,2,3,4,5,6,7,9,8)
abcdefgihj (0,1,2,3,4,5,6,8,7,9)
abcdefgijh (0,1,2,3,4,5,6,8,9,7)
abcdefgjhi (0,1,2,3,4,5,6,9,7,8)
abcdefgjih (0,1,2,3,4,5,6,9,8,7)
次に、末尾 4 文字 (リストの末尾の 4 要素) の順列を作りますが、3 文字の場合と同様です。すでに先頭 g の順列ができているので、残りの (0,1,2,3,4,5,7,6,8,9), (0,1,2,3,4,5,8,6,7,9) と (0,1,2,3,4,5,9,6,7,8) を、上記の 6 つのリストを添字に指定して @alpha 用の添字を作成します。この方法は最上位に至るまで続けることができ、結果的にすべての順列を生成できることになります。
プログラム４ use strict; use warnings; my @alpha = 'a' .. 'j'; my @base_idx = 0 .. $#alpha; my @memo = ([@base_idx], [0..$#base_idx-2,$#base_idx,$#base_idx-1]); my @perm_n; unshift @perm_n, eval(join '*', 1 .. $_) foreach 2 .. $#base_idx; my ($count, $pos) = (2, $#base_idx - 1); # print join('',@alpha[@$_]), "\n" foreach @memo; for (my $i = $#base_idx - 2; $i >= 0; $i--) { if ($base_idx[$i] == $#base_idx) { @base_idx = 0 .. $#base_idx; $pos = $i; next; } @base_idx[$i,$pos] = @base_idx[$pos,$i]; ++$pos; for (my $j = 0; $j < $perm_n[$i]; $j++) { my @idx = @base_idx[@{$memo[$j]}]; # print join('', @alpha[@idx]), "\n"; ++$count; push @memo, [@idx] if $i; } redo; } print "$count\n";
@memo は生成済みの添字を保存する配列で、n 文字の順列では最終的に (n-1)! (10 文字では 362,880) の要素数になります。@perm_n の内容は ((n-1)!, (n-2)!, ..., 3!, 2!) で、位毎に @memo の要素をいくつ参照するかを問い合わせるのに使います。プログラム４は実行時間では 1 番速いのですが、メモリを消費するのが欠点といえます。
最後のプログラムは、階乗進数を利用しています。2 進数、10 進数、16 進数はよく知っていると思いますが、それらとはちょっと違う特殊な進数です。特殊な点は基数 (または底) が階乗になっていることと、位毎に使える数値が異なることです。次の表は、最初が 0 からの整数、2 番目が対応する階乗進数表記、3 番目が割り当てられる順列です。
0: (0, 0, 0, 0) abcd 6: (1, 0, 0, 0) bacd 12: (2, 0, 0, 0) cabd 18: (3, 0, 0, 0) dabc 1: (0, 0, 1, 0) abdc 7: (1, 0, 1, 0) badc 13: (2, 0, 1, 0) cadb 19: (3, 0, 1, 0) dacb 2: (0, 1, 0, 0) acbd 8: (1, 1, 0, 0) bcad 14: (2, 1, 0, 0) cbad 20: (3, 1, 0, 0) dbac 3: (0, 1, 1, 0) acdb 9: (1, 1, 1, 0) bcda 15: (2, 1, 1, 0) cbda 21: (3, 1, 1, 0) dbca 4: (0, 2, 0, 0) adbc 10: (1, 2, 0, 0) bdac 16: (2, 2, 0, 0) cdab 22: (3, 2, 0, 0) dcab 5: (0, 2, 1, 0) adcb 11: (1, 2, 1, 0) bdca 17: (2, 2, 1, 0) cdba 23: (3, 2, 1, 0) dcba
N 桁の階乗進数の基数は ((N-1)!, (N-2)!, ... 1!, 0!) であり、位に使用できる数値の最大値は ((N-1), (N-2), ... 1, 0) なので、4 桁の階乗進数では基数が (3!, 2!, 1!, 0!) で、位毎の最大値が (3, 2, 1, 0) となります。例えば、15 を 4 桁の階乗進数に変換すると、下記の過程を経て得られた商を並べた (2, 1, 1, 0) が、その答えとなります。なお、末尾の位は、その 1 つ上の位を 1! で割るので常に 0 です。
15 割る 3! --> 商 2, 余り 3 3 割る 2! --> 商 1, 余り 1 1 割る 1! --> 商 1, 余り 0 0 割る 0! --> 商 0, 余り 0
表の 2 番目の階乗進数のリストは、初期の文字列からの抜き出す順番を示しています。15 の (2, 1, 1, 0) を abcd に適用すると、まず (0 から数えた) 2 番目の c を抜き出し、次に残りの abd から 1 番目の b を抜き出し、さらに残りの ad から 1 番目の d を抜き出して、すべてを繋げると cbda という 1 つの順列が得られます。整数を階乗進数のリストに変換する、初期文字列から抜き出す、という動作を、0 から始まる整数順に行うと、順列が生成できることになります。
プログラム５ 初期版 use strict; use warnings; my @alpha = 'a' .. 'j '; my ($n, $end, $count, @base) = (1, eval(join '*', 1 .. @alpha) - 1); unshift @base, $n *= $_ foreach 1 .. $#alpha; $n = -1; while (++$n <= $end) { my ($cp_n, @cp_alpha) = ($n, @alpha); my @order; foreach my $i (@base) { push @order, int($cp_n / $i); $cp_n %= $i; } push @order, 0; push @cp_alpha, splice(@cp_alpha, $_, 1) foreach @order; # print join('', @cp_alpha), "\n"; ++$count; } print "$count\n";
初期版は「階乗進数の原理そのもの」をコード化したものであり、分かりやすい代わりに効率が悪く 10 文字で 25 秒もかかってしまいました。効率が悪いのは、整数毎に抜き出す順番を格納する配列 @order を作成し、その順番通りにコピーした @alpha から抜き出しているからです。改良版では、前の順列の @order と @alpha を引き継いで、次の順列を生成するようにしています。
プログラム５ 改良版 use strict; use warnings; my @alpha = 'a' .. 'j'; @alpha[-1,-2] = @alpha[-2,-1]; my @limit = reverse 0 .. $#alpha; my @order = (0) x @alpha; $order[-2] = -1; my $count; for (my $i = $#order - 1; $i >= 0; $i--) { if ($order[$i] == $limit[$i]) { $order[$i] = 0; } else { ++$order[$i]; if ($i == $#alpha-1) { @alpha[-1,-2] = @alpha[-2,-1]; } else { my $j; foreach my $k ($i+1 .. $#alpha) { $alpha[$i] lt $alpha[$k] ? $j = $k : last; } @alpha[$i,$j] = @alpha[$j,$i]; @alpha[$i+1 .. $#alpha] = @alpha[reverse $i+1 .. $#alpha]; } # print join('', @alpha), "\n"; ++$count; $i = $#order - 1; redo; } } print "$count\n";
(2015/11/01)