組み合わせと順列の数え上げのアルゴリズム
Perl で組み合わせの数え上げが欲しかったのだが、CPAN からのインストールには C が必要なようなので、できれば避けたい。これぐらいなら、Perl 自体で書けるだろうと、参考となるサイトを探すと…意外にない。
そして見つけたいくつかの日本語のサイトでは、nCr = nCr=(n-1)Cr + (n-1)C(r-1) の式を使って示していた。いや、もっと効率の良い方法があったはず…と海外のサイトを調べると、最近、私が勉強している Python でアルゴリズムを示しているサイトがあったので、それを Perl に書き換えてみた。
なお、「数え上げ」という言葉を使ったが、数を求めるのと区別するために、組み合わせや順列の「生成」と言ったり「列挙」と言ったりもするようだ。
組み合わせ (combinationis) に関しては、ソースを読めばアルゴリズムは理解できるが、順列 (permutations) に関しては私は理解できなかった。本来、タイトルで示していることからは、アルゴリズムの説明を期待されるところだが、それは勘弁していただきたい。
{ package Combinations; sub new { my $class = shift; my $obj = {}; $obj->{l} = shift; $obj->{r} = shift; bless $obj, $class; return $obj; } sub next { my $self = shift; my $n = scalar @{$self->{l}}; my $r = $self->{r}; if (! exists $self->{tmp}) { $self->{tmp} = [0 .. ($r - 1)]; } else { my $i; for ($i = $r - 1; $i >= 0; $i--) { if ($self->{tmp}->[$i] != $i + $n - $r) { last; } } if ($i == -1) { return undef; } $self->{tmp}->[$i]++; for (my $j = $i + 1; $j < $r; $j++) { $self->{tmp}->[$j] = $self->{tmp}->[$j - 1] + 1; } } my @r; foreach my $c (@{$self->{tmp}}) { push(@r, $self->{l}->[$c]); } return \@r; } } { package Permutations; sub new { my $class = shift; my $obj = {}; $obj->{l} = shift; $obj->{r} = shift; if (! defined $obj->{r}) { $obj->{r} = scalar @{$obj->{l}}; } bless $obj, $class; return $obj; } sub next { my $self = shift; my $n = scalar @{$self->{l}}; my $r = $self->{r}; if (! exists $self->{tmp}) { $self->{tmp} = [0 .. ($n - 1)]; my @l = reverse(($n - $r + 1) .. $n); $self->{cycles} = \@l; } else { my $i; for ($i = $r - 1; $i >= 0; $i--) { $self->{cycles}->[$i]--; if ($self->{cycles}->[$i] == 0) { my $c = splice(@{$self->{tmp}}, $i, 1); push(@{$self->{tmp}}, $c); $self->{cycles}->[$i] = $n - $i; } else { my $j = $self->{cycles}->[$i]; my $tmp = $self->{tmp}->[$i]; $self->{tmp}->[$i] = $self->{tmp}->[-$j]; $self->{tmp}->[-$j] = $tmp; last; } } if ($i == -1) { return undef; } } my @r; for (my $i = 0; $i < $r; $i++) { push(@r, $self->{l}->[$self->{tmp}->[$i]]); } return \@r; } } MAIN: { print "Combinations:\n"; my $comb = Combinations->new(["a", "b", "c", "d"], 2); while (my $l = $comb->next()) { print join(",", @$l) . "\n"; } print "\nPermutations:\n"; my $perm = Permutations->new(["a", "b", "c", "d"], 2); while (my $l = $perm->next()) { print join(",", @$l) . "\n"; } }
下記の参考にしたサイトでは変数名が indices になっているところを、tmp に置き換えている以外は、だいたい同じなので、少なくとも私に著作権はなさそうである。数式や証明に著作権がないように、このプログラムはパブリックドメインのはず。
ちなみに実行すると次のようになる。
$ perl combinations.pl Combinations: a,b a,c a,d b,c b,d c,d Permutations: a,b a,c a,d b,a b,c b,d c,a c,b c,d d,a d,b d,c
他の値でも試したが、ちゃんと数え上げられているようである。
■ |
参考
|
||||||||||
■ |
配布物
|
上のソースに use strict とかちょっとシンタックスシュガーをまぶしたソースも公開しておく。
更新: | 2018-04-11,2018-04-20,2018-04-25 |
初公開: | 2018年04月11日 21:47:56 |
最新版: | 2018年04月25日 21:03:45 |
2018-04-11 21:48:01 (JST) in Perl | 固定リンク | コメント (3) | トラックバック (0)
コメント
[cocolog:89185782] に今回の感想をひとことしておいた。
投稿: JRF | 2018-04-11 22:20:54 (JST)
Perl を知らない人も読めるようにするため迷ったのだが、splice ぐらいはかまわないか…と、Permutations の途中を splice を使って書き換えておいた。splice の意味がわからない人は、ググるなり、海外の Python バージョンを読むなり、前のバージョンを読むなりして欲しい。
投稿: JRF | 2018-04-20 20:23:48 (JST)
投稿: JRF | 2018-04-25 21:09:57 (JST)