「133 個のミカンを 6 人に分配してください。最低でも 1 人に 1 個、最大で 64 個とした場合の、すべての組み合わせを列挙せよ。」というのが今回の問題です。まずは愚直に、foreach を積み重ねて組合せを生成してみることにしましょう。
use strict;
use warnings;
my ($count_1, $count_2);
foreach my $n1 (1 .. 64) {
foreach my $n2 (1 .. 64) {
foreach my $n3 (1 .. 64) {
foreach my $n4 (1 .. 64) {
foreach my $n5 (1 .. 64) {
foreach my $n6 (1 .. 64) {
++$count_1;
if ($n1 + $n2 + $n3 + $n4 + $n5 + $n6 == 133) {
# print join(', ', $n1, $n2, $n3, $n4, $n5, $n6), "\n";
++$count_2;
}
}
}
}
}
}
}
print "$count_1\n$count_2\n";総数: 68,719,476,736 総組合せ数: 246,774,528 時間: 289m17s
この手の foreach の積み重ねでは時間が掛かりすぎて実行できないことも多いですが、今回は 5 時間弱で実行することができました。なお、個々の組合せを画面に書きだしたり、ファイルに書き出すとそれだけで時間がかかるので、総数と組合せ数を数えるだけにしています。組合せ数は生成総数 (64 の 6 乗) の約 1/279 なので無駄が多いのがわかりますが、反面組合せ数を正確に数えることができます。プログラムから生成される組合せの概略は、以下のようになります。
1, 1, 1, 2, 64, 64 1, 1, 1, 3, 63, 64 1, 1, 1, 3, 64, 63 1, 1, 1, 4, 62, 64 1, 1, 1, 4, 63, 63 1, 1, 1, 4, 64, 62 1, 1, 1, 5, 61, 64 1, 1, 1, 5, 62, 63 1, 1, 1, 5, 63, 62 1, 1, 1, 5, 64, 61 ..... 64, 63, 1, 2, 2, 1 64, 63, 1, 3, 1, 1 64, 63, 2, 1, 1, 2 64, 63, 2, 1, 2, 1 64, 63, 2, 2, 1, 1 64, 63, 3, 1, 1, 1 64, 64, 1, 1, 1, 2 64, 64, 1, 1, 2, 1 64, 64, 1, 2, 1, 1 64, 64, 2, 1, 1, 1
次は、前節の foreach のプログラムに枝刈りを導入したりして効率的にするのが通常ですが、ここでは「同じを含む昇順の組合せ + 含まれる詳細な組合せ」という方法を考えることにします。「同じを含む昇順の組合せ」とは、左側の数字が右側の数字よりも大きくならない組合せです。
use strict;
use warnings;
my (@work, $count);
comb(133, 6, 1);
sub comb {
my ($i, $j, $k) = @_;
my $min = ($i - $k) / ($j - 1) > 64 ? $i - 64 * ($j - 1) : $k;
my $max = int $i / $j;
foreach my $n ($min .. $max) {
push @work, $n;
if (@work == 5) {
++$count;
# print join(', ', @work, $i - $n), "\n";
} else { comb($i - $n, $j - 1, $n); }
pop @work;
}
}
print "$count\n";同じを含む昇順組合せ数: 442,412 時間: 0.2s
comb サブルーチンの再帰呼び出しで、同じを含む昇順の組合せを生成しています。comb サブルーチンは、3 つの引数を受け取ります。１つ目が被分割数、2 つ目が分割数、3 つ目が最小値となります。comb サブルーチンには特に難しいことはありませんが、注意を要するのは残りの分割で 64 を超えないように最小値を割り当てるところだけです。
1, 1, 1, 2, 64, 64 1, 1, 1, 3, 63, 64 1, 1, 1, 4, 62, 64 1, 1, 1, 4, 63, 63 1, 1, 1, 5, 61, 64 1, 1, 1, 5, 62, 63 1, 1, 1, 6, 60, 64 1, 1, 1, 6, 61, 63 1, 1, 1, 6, 62, 62 1, 1, 1, 7, 59, 64 ..... 21, 21, 21, 22, 22, 26 21, 21, 21, 22, 23, 25 21, 21, 21, 22, 24, 24 21, 21, 21, 23, 23, 24 21, 21, 22, 22, 22, 25 21, 21, 22, 22, 23, 24 21, 21, 22, 23, 23, 23 21, 22, 22, 22, 22, 24 21, 22, 22, 22, 23, 23 22, 22, 22, 22, 22, 23
同じを含む昇順組合せの生成数は、前節で数えた総組合せ数 246,774,528 よりもはるかに少ない 442,412 ですので 0.2 秒程度ですみます。むろん、これだけではすべての組合せを生成したことになりませんので、個々の組合せからさらに組合せを生成する必要があります。最後の組合せ (22, 22, 22, 22, 22, 23) を例にすると、次のように生成します。
22, 22, 22, 22, 22, 23 ---------------------- 22, 22, 22, 22, 22, 23 22, 22, 22, 22, 23, 22 22, 22, 22, 23, 22, 22 22, 22, 23, 22, 22, 22 22, 23, 22, 22, 22, 22 23, 22, 22, 22, 22, 22
上記の例は 5 つの数字が同じで 1 つだけ異なるので、6 種類の組合せがあることになります。何種類の組合せがあるかは、数字の構成によって異なります。すべての数字が異なれば、順列数と同じになるので 720 (6!) 通りになります。今回の問題では不可能ですが、すべての数字が同じであれば 1 種類となります。その他にも 2:4 や 2:2:2 は被分割数が奇数なので不可能で、3:3 も被分割数が 3 で割り切れないのでありません。今回の問題での数字の構成による組合せ数は、以下のようになります。
数字の構成 含組合せ 442,412の内訳 1:1:1:1:1:1 720 259,765 1:1:1:1:1:1 のパターン 1:1:1:1:2 360 13,167 a,b,c,d,e,f 1:1:1:2:1 360 21,919 a,b,c,d,f,e 1:1:1:3 120 878 ..... 1:1:2:1:1 360 30,704 f,e,d,c,a,b 1:1:2:2 180 1,419 f,e,d,c,b,a 1:1:3:1 120 2,032 (720 通り) 1:1:4 30 68 1:2:1:1:1 360 39,682 1:2:1:2 180 1,806 1:2:2:1 180 2,617 1:2:3 60 88 1:2:3 のバターン 1:3:1:1 120 3,420 a,b,b,c,c,c 1:3:2 60 139 a,b,c,b,c,c 1:4:1 30 167 ..... 1:5 6 4 c,c,c,b,a,b 2:1:1:1:1 360 48,686 c,c,c,b,b,a 2:1:1:2 180 2,365 (60 通り) 2:1:2:1 180 3,201 2:1:3 60 121 2:2:1:1 180 4,200 2:3:1 60 202 3:1:1:1 120 5,007 3:1:2 60 231 3:2:1 60 251 4:1:1 30 264 5:1 6 9
すべて数字の構成が異なる 1:1:1:1:1:1 の組合せは、442,412 のうち 259,765 種類もあります。1:1:1:1:1:1 の各数字をアルファベット a, b, c, d, e, f に割り当てて、あらかじめ 720 通りの組合せを生成しておけば、その都度組合せを生成せずに代入だけで済みそうです。その他の数字の構成についても、最初に 1 回だけアルファベットのパターンを生成して、残りを代入で対応すれば効率化を図れそうです。
次のプログラムが、この節の最初の「同じを含む昇順の組合せ」プログラムを改造してすべての組合せを生成できるようにしたものです。
use strict;
use warnings;
my (%struct, @work, $cnt1, $cnt2);
my @alpha = qw(a b c d e f);
base_hash(@alpha);
comb(133, 6, 1);
print "$cnt1, $cnt2\n";
sub comb {
my ($i, $j, $k) = @_;
my $min = ($i - $k) / ($j - 1) > 64 ? $i - 64 * ($j - 1) : $k;
my $max = int $i / $j;
foreach my $n ($min .. $max) {
push @work, $n;
if (@work == 5) {
my @block = ([$work[0]]);
foreach my $o (@work[1,2,3,4], $i - $n) {
if ($o == $block[-1]->[0]) { push @{$block[-1]}, $o; }
else { push @block, [$o]; }
}
my $key = join(':', map { scalar(@$_) } @block);
make_hash($key) unless exists $struct{$key};
my %assign; $assign{$alpha[$_]} = $block[$_]->[0] foreach 0 .. $#block;
foreach (@{$struct{$key}}) {
my @item = @$_;
$_ = $assign{$_} foreach @item;
# print join(', ', @item), "\n";
++$cnt2;
}
++$cnt1;
} else { comb($i - $n, $j - 1, $n); }
pop @work;
}
}
sub base_hash {
foreach my $c (@_) {
push @work, $c;
if (@work == 6) { push @{$struct{'1:1:1:1:1:1'}}, [@work]; }
else { base_hash(grep { $c ne $_ } @_); }
pop @work;
}
}
sub mk_hash {
my $key = shift;
my @block = map { [0 .. $_-1] } split /:/, $key;
foreach my $i (1 .. $#block) {
$_ += ($block[$i-1]->[-1] + 1) foreach @{$block[$i]};
}
foreach my $i (0 .. $#block) {
$_ = $alpha[$_] foreach @{$block[$i]};
}
my @pattern;
foreach my $i (0 .. $#block) {
next if @{$block[$i]} == 1;
my $pattern = join '.*', @{$block[$i]};
push @pattern, $pattern;
}
OUT: foreach (@{$struct{'1:1:1:1:1:1'}}) {
my @item = @$_;
foreach my $pattern (@pattern) {
next OUT unless join('', @item) =~ /$pattern/;
}
foreach my $c (@item) {
my ($i) = grep { join('', @{$block[$_]}) =~ /$c/ } 0 .. $#block;
$c = $alpha[$i];
}
push @{$struct{$key}}, [@item];
}
}同じを含む昇順組合せ数: 442,412 総組合せ数: 246,774,528 時間: 10m48s
このプログラムでは、最初にサブルーチン base_hash を使って、すべての数字の異なる数字の構成 1:1:1:1:1:1 の場合の組合せを a,b,c,d,e,f のアルファベットで生成しています。生成された 720 個の組合せは、ハッシュ %struct のキー '1:1:1:1:1:1' が指している無名配列に格納されます。
%struct = ('1:1:1:1:1:1' => [['a','b','c','d','e','f'], ['a','b','c','d','f','e'], ...]);
1:1:1:1:1:1 以外の数字の構成は、その構成が最初に出現したときにアルファベットでの組合せを生成します。構成 '1:2:3' を例にして、生成の過程を説明します。生成は 1:1:1:1:1:1 の組合せの配列を基に、そこから除外していきます。構成 1:2:3 をアルファベットを使って表すと '(a),(b,c),(d,e,f)' となり、b と c が同じ数字、d と e と f が同じ数字なので、丸カッコ内の順序通りの組合せだけを抽出します (上記の例で、'O' が通過、'X' が除外)。抽出した組合せは 6 種類のアルファベットのままなので、それを数字の構成に合わせて変換を行います。'(a),(b,c),(d,e,f)' では、最初の丸カッコの中のアルファベットを 'a' に、次の丸カッコの中のあるアルファベットを 'b' に、3 番目の丸カッコ内のアルファベットを 'c' に変換します。結果、a,b,c,d,e,f は a,b,b,c,c,c となります。生成した組合せは %struct ハッシュのキー '1:2:3' が指す無名配列の中に格納され、以降に '1:2:3' の数字の構成が出現するたびに利用されることになります。
1:1:1:1:1:1 判定 1:2:3
a,b,c,d,e,f O a,b,b,c,c,c
a,b,c,d,f,e X
a,b,c,e,d,f X
a,b,c,e,f,d X
a,b,c,f,d,e X
a,b,c,f,e,d X
a,b,d,c,e,f O a,b,c,b,c,c
a,b,d,c,f,e X
a,b,d,e,c,f X
a,b,d,e,f,c X
.....
%struct = ('1:1:1:1:1:1' => [['a','b','c','d','e','f'], ['a','b','c','d','f','e'], ...],
'1:2:3' => [['a','b','b','c','c','c'], ['a','b','c','b','c','c'], ...]);
改造したプログラムは、私のパソコンで 11 分弱で実行することができました。
最後に考えたプログラムは、インクリメントするように、無駄なく順番通りに組合せを生成します。最初の節の「まずは愚直に」では多くの無駄がありましたが、この節では１ループに１つの組合せを生成します。考えた仕組みは、以下のようなものです。
インクリメントする位置を求めて 1 を加算する
インクリメントするのは、下 2
番目から上に向かって調べて、最初に見つかった位置です。インクリメントできるのは、その位置の数字が 64
よりも小さく、その位置の次の位置が 1 よりも大きい場合です (下記の赤字の数値)。
1, 1, 1, 2, 64, 64 1, 1, 1, 3, 63, 64 1, 1, 1, 3, 64, 63 1, 1, 1, 4, 62, 64 ..... 1, 1, 1, 64, 64, 2 1, 1, 2, 1, 64, 64 ..... 1, 64, 64, 2, 1, 1 2, 1, 1, 1, 64, 64 .....
use strict;
use warnings;
my @num = (1, 1, 1, 2, 63, 65);
my $count = 0;
while ($num[0] < 64 or $num[1] < 64 or $num[2] < 2) {
my $i;
if ($num[4] < 64 and $num[5] > 1) { $i = 4; }
elsif ($num[3] < 64 and $num[4] > 1) { $i = 3; }
elsif ($num[2] < 64 and $num[3] > 1) { $i = 2; }
elsif ($num[1] < 64 and $num[2] > 1) { $i = 1; }
else { $i = 0; }
++$num[$i]; my $j;
if ($i == 4) { --$num[5]; }
elsif ($i == 3) {
$j = $num[4] + $num[5] - 1;
if ($j > 65) { $num[5] = 64; $num[4] = $j - 64; }
else { $num[4] = 1; $num[5] = $j - 1; }
} elsif ($i == 2) {
$j = $num[3] + $num[4] + $num[5] - 1;
if ($j > 66) { $num[5] = 64; $num[4] = $j - 64 - 1; $num[3] = 1; }
else { $num[3] = 1; $num[4] = 1; $num[5] = $j - 2; }
} elsif ($i == 1) {
$j = $num[2] + $num[3] + $num[4] + $num[5] - 1;
if ($j > 67) { $num[5] = 64; $num[4] = $j - 64 - 2; $num[3] = 1; $num[2] = 1; }
else { $num[2] = 1; $num[3] = 1; $num[4] = 1; $num[5] = $j - 3; }
} else {
$j = $num[1] + $num[2] + $num[3] + $num[4] + $num[5] - 1;
if ($j > 68) { $num[5] = 64; $num[4] = $j - 64 - 3; $num[3] = 1; $num[2] = 1; $num[1] = 1; }
else { $num[1] = 1; $num[2] = 1; $num[3] = 1; $num[4] = 1; $num[5] = $j - 4; }
}
++$count;
# print join(', ', @num), "\n";
}
print "$count\n";総組合せ数: 246,774,528 時間: 1m56s
プログラムは、インクリメントする位置を求める部分と、下位の数値を再配置する部分からなります。どちらも下位から 1 つずつ個別的に見ていくような、プログラムとしては冴えないコードになっています。これには、理由があります。インクリメントする位置を求めるコードを、次のように変えたとします。
foreach my $j (reverse 0 .. ($#num-1)) {
if ($num[$j] < 64 and $num[$j+1] > 1) {
$i = $j; last;
}
}
働きはまったく同じですが、実行時間が 3m35s と大幅に増えてしまいます。むろん、要素数の異なる配列に対応するには上記のようなコードが必要になりますが、今回のプログラムのように配列の要素数が固定の場合はコードは長くなっても個別的に処理したほうが実行時間は短くなります。
(2016/01/01)