今回は簡単な例題として「順列 (permutation)」と「組み合わせ (combination)」を取り上げます。Perl には順列や組み合わせを求めるライブラリ Math::Combinatorics がありますが、今回は Perl のお勉強ということで、実際にプログラムを作ってみましょう。
順列の生成は拙作のページ「再帰定義」で取り上げました。今回は 1 から n までの数字から m 個を選ぶ順列を生成することにします。関数名は permutations としました。
permutations($f, $n, $m);
permutations は高階関数で、生成した順列を関数 $f に渡して呼び出します。プログラムは次のようになります。
リスト : 順列の生成 (1)
# 配列 $xs に $n と等しい要素があるか
sub member {
my ($n, $xs) = @_;
foreach my $x (@$xs) {
return 1 if $x == $n;
}
0;
}
# 1 .. n の数字から m 個を選ぶ順列を生成
sub perm_sub {
my ($f, $n, $m, $xs) = @_;
if (@$xs == $m) {
$f->([@$xs]);
} else {
for (my $i = 1; $i <= $n; $i++) {
if (!member($i, $xs)) {
push @$xs, $i;
perm_sub($f, $n, $m, $xs);
pop @$xs;
}
}
}
}
sub permutations {
my ($f, $n, $m) = @_;
perm_sub($f, $n, $m, []);
}
実際の処理は関数 perm_sub で行います。引数 $f が関数、$n が数字の上限値、$m が選ぶ数字の個数、引数 $xs が選んだ数字を格納する配列です。@$xs の大きさが $m と等しい場合、順列が一つ完成しました。[@$xs] で配列をコピーして関数 $f に渡します。そうでなければ、1 から $n までの数字から一つ選んで、配列 @$xs に追加します。このとき、関数 member で $xs に同じ数字がないことをチェックします。あとは、perm_sub を再帰呼び出しして、戻ってきたら pop で配列 $xs から末尾の要素を削除します。これで順列を生成することができます。
それでは、実際に試してみましょう。
リスト : 簡単なテスト
permutations(sub {my $xs = shift; print "@$xs\n"; }, 4, 4);
$ perl perm.pl 1 2 3 4 1 2 4 3 1 3 2 4 1 3 4 2 1 4 2 3 1 4 3 2 2 1 3 4 2 1 4 3 2 3 1 4 2 3 4 1 2 4 1 3 2 4 3 1 |
3 1 2 4 3 1 4 2 3 2 1 4 3 2 4 1 3 4 1 2 3 4 2 1 4 1 2 3 4 1 3 2 4 2 1 3 4 2 3 1 4 3 1 2 4 3 2 1 |
正常に動作していますね。
生成した順列を配列に格納して返すことも簡単にできます。次のリストを見てください。
リスト : 順列の生成
sub permutations_list {
my ($n, $m) = @_;
my $a = [];
permutations(sub {push @$a, shift}, $n, $m);
$a;
}
関数 permutations_list は、無名の配列 $a を用意して permutations を呼び出します。あとは、無名の関数の中で受け取った順列を配列 @$a に push で追加していくだけです。
それでは実際に試してみましょう。
リスト : 簡単なテスト (2)
my $b = permutations_list(4, 4);
foreach my $xs (@$b) {
print "@$xs\n";
}
結果は permutations と同じです。
次は、配列に格納された要素から m 個を選ぶ順列を生成するプログラムを作ってみましょう。この場合、配列の要素を交換することで、簡単に順列を生成することができます。たとえば、i 番目の要素を選ぶ場合、0 から i - 1 番目までの要素は選択済みとすると、i から末尾までの要素から選べばよいことになります。選択する要素が j 番目の場合、i 番目の要素と j 番目の要素を交換して、次は i + 1 番目の要素を i + 1 から末尾までの中から選べばよいわけです。
プログラムは次のようになります。
リスト : 順列の生成 (3)
sub perm1_sub {
my ($f, $i, $n, $xs) = @_;
if ($n == $i) {
$f->([@$xs[0 .. $n - 1]]);
} else {
my $temp = $xs->[$i];
for (my $j = $i; $j < @$xs; $j++) {
$xs->[$i] = $xs->[$j];
$xs->[$j] = $temp;
perm1_sub($f, $i + 1, $n, $xs);
$xs->[$j] = $xs->[$i];
$xs->[$i] = $temp;
}
}
}
sub permutations1 {
my ($f, $n, $xs) = @_;
perm1_sub($f, 0, $n, $xs);
}
実際の処理は関数 perm1_sub で行います。引数 $i が選択する位置、$n が選択する要素の個数、$xs が配列です。$n と $i が等しい場合、$n 個の要素を選択したので、$xs の 0 番目から $n - 1 番目までをコピーして関数 $f に渡します。そうでなければ、配列の要素を交換します。for 文の変数 $j が選択する要素の位置を表します。$j の範囲は $i から @$xs - 1 までになります。あとは要素を交換して perm1_sub を再帰呼び出しして、戻ってきたら交換した要素を元に戻すだけです。
それでは実際に試してみましょう。
リスト : 簡単なテスト (3)
permutations1(sub {my $xs = shift; print "@$xs\n"; }, 4, [1,2,3,4]);
$ perl perm.pl 1 2 3 4 ・・・略・・・ 4 1 2 3
24 通りの順列が生成されました。ただし、生成される順列の順番は permutations とは異なることに注意してください。
次は「組み合わせ (combination)」を生成するプログラムを作ってみましょう。たとえば、配列 [1, 2, 3, 4, 5] の中から 3 個を選ぶ組み合わせは次のようになります。
1 2 3, 1 2 4, 1 2 5, 1 3 4, 1 3 5, 1 4 5 2 3 4, 2 3 5, 2 4 5, 3 4 5
最初に 1 を選択した場合、次は [2, 3, 4, 5] の中から 2 個を選べばいいですね。2 番目に 2 を選択したら、次は [3, 4, 5] の中から 1 個を選べばいいわけです。これで、[1, 2, 3], [1, 2, 4], [1, 2, 5] が生成されます。
[2, 3, 4, 5] の中から 2 個選ぶとき、2 を選ばない場合があります。この場合は [3, 4, 5] の中から 2 個を選べばいいわけです。ここで 3 を選ぶと [1, 3, 4], [1, 3, 5] が生成できます。同様に、3 を除いた [4, 5] の中から 2 個をえらぶと [1, 4, 5] を生成することができます。
これで 1 を含む組み合わせを生成したので、次は 1 を含まない組み合わせ、つまり [2, 3, 4, 5] から 3 個を選ぶ組み合わせを生成すればいいわけです。けっきょく、この処理の考え方は次に示す組み合わせの公式と同じです。
これをプログラムすると次のようになります。
リスト : 組み合わせの生成
sub comb_sub {
my ($f, $i, $n, $r, $xs) = @_;
if ($r == 0) {
$f->([@$xs]);
} elsif ($n - $i + 1 == $r) {
$f->([@$xs, $i .. $n]);
} else {
push @$xs, $i;
comb_sub($f, $i + 1, $n, $r - 1, $xs);
pop @$xs;
comb_sub($f, $i + 1, $n, $r, $xs);
}
}
sub combinations {
my ($f, $n, $r) = @_;
comb_sub($f, 1, $n, $r, []);
}
関数 combinations は高階関数で、1 から $n までの数字から $r 個の数字を選ぶ組み合わせを生成します。実際の処理は関数 comb_sub で行います。引数 $i が選ぶ数字、$xs が選んだ数字を格納する配列です。$r が 0 の場合、[@$xs] で配列をコピーして関数 $f に渡して呼び出します。残った数字 ($i から $n まで) の個数が $r と等しい場合は、その数字をすべて選び、関数 $f に渡します。
それ以外の場合、最初に数字 $i を選択します。push で $i を $xs に追加して、comb_sub を再帰呼び出しします。このとき、$i を +1 して、$r を -1 します。戻ってきたら、$xs から末尾の要素を pop で削除して、comb_sub を再帰呼び出しします。このときは、$i を選択しない場合です。$i は +1 しますが、$r は -1 しません。これで、すべての組み合わせを生成することができます。
実際に試してみましょう。
リスト : 簡単なテスト
combinations(sub {my $xs = shift; print "@$xs\n";}, 5, 3);
$ perl perm.pl 1 2 3 1 2 4 1 2 5 1 3 4 1 3 5 1 4 5 2 3 4 2 3 5 2 4 5 3 4 5
正常に動作していますね。
生成した組み合わせを配列に格納して返す場合も簡単です。プログラムは次のようになります。
リスト : 組み合わせの生成 (2)
sub combinations_list {
my ($n, $r) = @_;
my $a = [];
combinations(sub {push @$a, shift;}, $n, $r);
$a;
}
関数 combinations_list は、無名の配列 $a を用意して、combinations を呼び出します。あとは、無名の関数の中で受け取った組み合わせを配列 @$a に push で追加していくだけです。
それでは実際に試してみましょう。
リスト : 簡単なテスト (2)
$b = combinations_list(5, 3);
foreach my $xs (@$b) {
print "@$xs\n";
}
結果は combinations と同じです。
次は配列から n 個の要素を選ぶ組み合わせを生成するプログラムを作ります。次のリストを見てください。
リスト ; 組み合わせの生成 (3)
sub comb1_sub {
my ($f, $i, $r, $xs, $ys) = @_;
if ($r == 0) {
$f->([@$ys]);
} elsif (@$xs - $i == $r) {
$f->([@$ys, @$xs[$i .. $#$xs]]);
} else {
push @$ys, $xs->[$i];
comb1_sub($f, $i + 1, $r - 1, $xs, $ys);
pop @$ys;
comb1_sub($f, $i + 1, $r, $xs, $ys);
}
}
sub combinations1 {
my ($f, $r, $xs) = @_;
comb1_sub($f, 0, $r, $xs, []);
}
実際の処理は関数 comb1_sub で行います。$xs が配列で、$ys が選んだ要素を格納する配列です。基本的には comb_sub と同じで、変数 $i が $xs の添字になるだけです。つまり、選択する要素は $xs->[$i] になります。
それでは実行してみましょう。
リスト : 簡単なテスト
combinations1(sub {my $xs = shift; print "@$xs\n"; }, 3, [1,2,3,4,5]);
$ perl perm.pl 1 2 3 ・・・略・・・ 3 4 5
正常に動作していますね。
#
# perm.pl : 順列と組み合わせの生成
#
# Copyright (C) 2015-2023 Makoto Hiroi
#
use strict;
use warnings;
sub member {
my ($n, $xs) = @_;
foreach my $x (@$xs) {
return 1 if $x == $n;
}
0;
}
# 1 .. n の数字から m 個を選ぶ順列を生成
sub perm_sub {
my ($f, $n, $m, $xs) = @_;
if (@$xs == $m) {
$f->([@$xs]);
} else {
for (my $i = 1; $i <= $n; $i++) {
if (!member($i, $xs)) {
push @$xs, $i;
perm_sub($f, $n, $m, $xs);
pop @$xs;
}
}
}
}
sub permutations {
my ($f, $n, $m) = @_;
perm_sub($f, $n, $m, []);
}
sub permutations_list {
my ($n, $m) = @_;
my $a = [];
permutations(sub {push @$a, shift}, $n, $m);
$a;
}
# 配列から n 個選ぶ順列
sub perm1_sub {
my ($f, $i, $n, $xs) = @_;
if ($n == $i) {
$f->([@$xs[0 .. $n - 1]]);
} else {
my $temp = $xs->[$i];
for (my $j = $i; $j < @$xs; $j++) {
$xs->[$i] = $xs->[$j];
$xs->[$j] = $temp;
perm1_sub($f, $i + 1, $n, $xs);
$xs->[$j] = $xs->[$i];
$xs->[$i] = $temp;
}
}
}
sub permutations1 {
my ($f, $n, $xs) = @_;
perm1_sub($f, 0, $n, $xs);
}
# 組み合わせ
sub comb_sub {
my ($f, $i, $n, $r, $xs) = @_;
if ($r == 0) {
$f->([@$xs]);
} elsif ($n - $i + 1 == $r) {
$f->([@$xs, $i .. $n]);
} else {
push @$xs, $i;
comb_sub($f, $i + 1, $n, $r - 1, $xs);
pop @$xs;
comb_sub($f, $i + 1, $n, $r, $xs);
}
}
sub combinations {
my ($f, $n, $r) = @_;
comb_sub($f, 1, $n, $r, []);
}
sub combinations_list {
my ($n, $r) = @_;
my $a = [];
combinations(sub {push @$a, shift;}, $n, $r);
$a;
}
# 配列から要素を選ぶ
sub comb1_sub {
my ($f, $i, $r, $xs, $ys) = @_;
if ($r == 0) {
$f->([@$ys]);
} elsif (@$xs - $i == $r) {
$f->([@$ys, @$xs[$i .. $#$xs]]);
} else {
push @$ys, $xs->[$i];
comb1_sub($f, $i + 1, $r - 1, $xs, $ys);
pop @$ys;
comb1_sub($f, $i + 1, $r, $xs, $ys);
}
}
sub combinations1 {
my ($f, $r, $xs) = @_;
comb1_sub($f, 0, $r, $xs, []);
}
# テスト
permutations(sub {my $xs = shift; print "@$xs\n"; }, 4, 4);
my $b = permutations_list(4, 4);
foreach my $xs (@$b) {
print "@$xs\n";
}
permutations1(sub {my $xs = shift; print "@$xs\n"; }, 4, [1,2,3,4]);
combinations(sub {my $xs = shift; print "@$xs\n";}, 5, 3);
$b = combinations_list(5, 3);
foreach my $xs (@$b) {
print "@$xs\n";
}
combinations1(sub {my $xs = shift; print "@$xs\n"; }, 3, [1,2,3,4,5]);