数値を格納した配列 buff から重複した要素を取り除く関数 remove_dup(buff) を定義してください。remove_dup は引数の配列を破壊せずに新しい配列を返すものとします。
remove_dup([1, 2, 3, 1, 2, 3, 4, 1, 2, 3, 4, 5]) => [1, 2, 3, 4, 5]
集合を配列で表すことにします。集合の和、集合の積、集合の差を求める関数 union(xs, ys), intersection(xs, ys), difference(xs, y) を定義してください。これらの関数は引数の配列を破壊せずに新しい配列を返すものとします。
union([1, 2, 3, 4], [3, 4, 5, 6]) => [1, 2, 3, 4, 5, 6] intersection([1, 2, 3, 4], [3, 4, 5, 6]) => [3, 4] difference([1, 2, 3, 4], [3, 4, 5, 6]) => [1, 2]
シェルソート (shell sort) は挿入ソートの改良版ともいえる方法です。最初は遠く離れた要素間でソートを開始し、徐々に間隔を狭めていきます。最後は隣り合った要素間でソートします。つまり、単純挿入ソートと同じになります。
間隔が大きいときは要素の個数が少ないので、単純なアルゴリズムでもソートにかかる時間は少なくてすみます。間隔が小さくなると要素の個数は多くなりますが、大まかにソートされているので挿入ソートでも高速にソートすることが可能です。
9 5 3 7 6 4 2 8 最初の状態
9 6 間隔を 4 で分割する
5 4
3 8
7 2
6 9 各群をソートする
4 5
3 8
2 7
6 3 9 8 間隔を 2 で分割する
4 2 5 7
3 6 8 9 各群をソートする
2 4 5 7
3 2 6 4 8 5 9 7 間隔を 1 で分割する（単純挿入ソートと同じ）
2 3 4 5 6 7 8 9 ソート完了
図 : シェルソート
数値を格納した配列 buff をシェルソートする関数 shell_sort(buff) を定義してください。
ソートは昔から研究されている分野で、優秀なアルゴリズムが確立しています。その中でもクイックソート (quick sort) は高速なソートアルゴリズムとして有名です。クイックソートはある値を基準にして、要素をそれより大きいものと小さいものの 2 つに分割していくことでソートを行います。2 つに分けた各々のグループを同様に分割して 2 つのグループに分けます。最後はグループの要素が一つになってソートが完了します。
9 5 3 7 6 4 2 8 最初の状態
9 5 3 7 6 4 2 8 7 を枢軸にして左側から 7 以上の値を探し、
L R 右側から 7 以下の値を探す。
2 5 3 7 6 4 9 8 交換する
L R
2 5 3 7 6 4 9 8 検索する
L R
2 5 3 4 6 7 9 8 交換する
L R
2 5 3 4 6 7 9 8 検索する。R と L が交差したら分割終了。
R L
[2 5 3 4 6] [7 9 8] この 2 つのグループについて再び
同様な分割を行う
図 : クイックソート
基準になる値のことを「枢軸 (pivot)」といいます。枢軸は要素の中から適当な値を選びます。今回は区間の真ん中にある要素を選ぶことにしましょう。上図を見てください。左側から枢軸 7 以上の要素を探し、左側から 7 以下の要素を探します。探索のときは枢軸が番兵 [*1] の役割を果たすので、ソート範囲外の要素を探索することはありません。見つけたらお互いの要素を交換します。探索位置が交差したら分割は終了です。
あとは同じ手順を分割した 2 つのグループに適用します。これは再帰定義を使えば簡単に実現できます。分割したグループの要素数が 1 になったときが再帰の停止条件になります。
数値を格納した配列 buff をクイックソートする関数 quick_sort(buff) を定義してください。
自然数 n を素因数分解する関数 factorization(n) を定義してください。返り値は配列 [p, q] を格納した配列で、[p, q] は pq を表します。なお、計算は use integer を指定して整数で行うものとします。
factorization(24) => [[2, 3], [3, 1]] factorization(12345678) => [[2, 1], [3, 2], [47, 1], [14593, 1]] factorization(123456789) => [[3, 2], [3607, 1], [3803, 1]] factorization(1234567890) => [[2, 1], [3, 2], [5, 1], [3607, 1], [3803, 1]] factorization(1111111111) => [[11, 1], [41, 1], [271, 1], [9091, 1]]
自然数 n の約数の個数を求める関数 divisor_num(n) を定義してください。なお、計算は use integer を指定して整数で行うものとします。
divisor_num(24) => 8 divisor_num(12345678) => 24 divisor_num(123456789) => 12 divisor_num(1234567890) => 48 divisor_num(1111111111) => 16
自然数 n の約数の合計値を求める関数 divisor_sum を定義してください。なお、計算は use integer を指定して整数で行うものとします。
divisor_sum(24) => 60 divisor_sum(12345678) => 27319968 divisor_sum(123456789) => 178422816 divisor_sum(1234567890) => 3211610688 divisor_sum(1111111111) => 1246404096
自然数 n の約数をスライスに格納して返す関数 divisor を定義してください。なお、計算は use integer を指定して整数で行うものとします。
divisor(24) => [1, 2, 3, 4, 6, 8, 12, 24] divisor(12345678) => [1, 2, 3, 6, 9, 18, 47, 94, 141, 282, 423, 846, 14593, 29186, 43779, 87558, 131337, 262674, 685871, 1371742, 2057613, 4115226, 6172839, 12345678] divisor(123456789) => [1, 3, 9, 3607, 3803, 10821, 11409, 32463, 34227, 13717421, 41152263, 123456789] divisor(1234567890) => [1, 2, 3, 5, 6, 9, 10, 15, 18, 30, 45, 90, 3607, 3803, 7214, 7606, 10821, 11409, 18035, 19015, 21642, 22818, 32463, 34227, 36070, 38030, 54105, 57045, 64926, 68454, 108210, 114090, 162315, 171135, 324630, 342270, 13717421, 27434842, 41152263, 68587105, 82304526, 123456789, 137174210, 205761315, 246913578, 411522630, 617283945, 1234567890] divisor(1111111111) => [1, 11, 41, 271, 451, 2981, 9091, 11111, 100001, 122221, 372731, 2463661, 4100041, 27100271, 101010101, 1111111111]
完全数 - Wikipedia によると、『完全数（かんぜんすう，perfect number）とは、その数自身を除く約数の和が、その数自身と等しい自然数のことである。』 とのことです。自然数 n 以下の完全数を求める関数 perfect_number(n) を定義してください。
perfect_number(10000) => (画面に出力) 6 28 496 8128
友愛数 - Wikipedia によると、『友愛数（ゆうあいすう）とは、異なる2つの自然数の組で、自分自身を除いた約数の和が、互いに他方と等しくなるような数をいう。』 とのことです。自然数 n 以下の友愛数を求める関数 yuuai_number(n) を定義してください。
yuuai_number(100000) => (画面に出力) 220 284 1184 1210 2620 2924 5020 5564 6232 6368 10744 10856 12285 14595 17296 18416 63020 76084 66928 66992 67095 71145 69615 87633 79750 88730
リスト : 重複要素の削除
sub member {
my ($x, $xs) = @_;
foreach my $n (@$xs) {
return 1 if $n == $x;
}
0;
}
sub remove_dup {
my $buff = shift;
my $zs = [];
foreach my $x (@$buff) {
push @$zs, $x if !member($x, $zs);
}
$zs;
}
関数 member は配列の先頭から順番に要素と引数 $x を比較して、同じ要素があれば真 (1) を返します。見つからない場合は偽 (0) を返します。関数 remove_dup は member を使うと簡単です。最初に空の配列を生成して変数 $zs にセットします。次に、$xs から要素を順番に取り出し、要素 $x が $ys に含まれているか member でチェックします。含まれていない場合は $x を push で $zs に追加します。
リスト : 和集合
sub union {
my ($xs, $ys) = @_;
my $zs = [@$xs];
foreach my $n (@$ys) {
push @$zs, $n if !member($n, $zs);
}
$zs;
}
union の場合、最初に $xs をコピーした配列 $zs を作ります。そして、$ys から要素を順番に取り出して変数 $n にセットし、それが $zs に含まれているか member でチェックします。そうであれば、push で $n を $zs に追加します。
リスト : 積集合
sub intersection {
my ($xs, $ys) = @_;
my $zs = [];
foreach my $n (@$xs) {
push @$zs, $n if member($n, $ys);
}
$zs;
}
intersection の場合、空の配列を生成して変数 $zs にセットします。次に、$xs から要素を順番に取り出して変数 $n にセットし、それが $ys に含まれているか member でチェックします。そうであれば、push で $zs に $n を追加します。これで、重複した要素を zs に集めることができます。
リスト : 差集合
sub difference {
my ($xs, $ys) = @_;
my $zs = [];
foreach my $n (@$xs) {
push @$zs, $n if !member($n, $ys);
}
$zs;
}
difference は intersection と似ています。違いは、$xs の要素 $n が $ys に含まれていなければ、$n を push で $zs に追加するところです。これで、$xs から $ys の要素を取り除くことができます。
リスト : シェルソート
sub shell_sort {
my $buff = shift;
my $k = @$buff;
for (my $gap = $k >> 1; $gap > 0; $gap >>= 1) {
for (my $i = $gap; $i < $k; $i++) {
my $temp = $buff->[$i];
my $j = $i - $gap;
for (; $j >= 0 && $temp < $buff->[$j]; $j -= $gap) {
$buff->[$j + $gap] = $buff->[$j];
}
$buff->[$j + $gap] = $temp;
}
}
$buff;
}
最初のループで間隔を徐々に狭めていきます。ここでは単純に 2 で割っていくことにしました。次のループで比較する要素を取り出します。最後のループでこの要素を挿入する位置を探索します。このときの探索は隣り合った要素ではなく $gap 離れた要素を比較します。
2 番目のループでは、各群を並列にソートしていることに注意してください。群のひとつの要素を取り出して位置を決めたら、次の群の要素を取り出して位置を決めています。最後に $gap は 1 になるので、挿入ソートと同じになりソートが完了します。
シェルソートの場合、gap を常に奇数になるようにすると、実行速度はデータの個数 n の 1.5 乗に比例します。また、クヌース先生によると、gap の値に次の数列を用いると、シェルソートは n の 1.25 乗に比例するそうです。
gap = ..., 121, 40, 13, 4, 1
この数列は 3 倍して 1 を加えることで得られる数列を逆にしたものです。これをプログラムすると、次のようになります。
リスト : シェルソートの改良版
sub shell_sort1 {
my $buff = shift;
my $k = @$buff;
my $gap = 1;
while ($gap < int($k / 9)) {
$gap *= 3;
}
for (; $gap > 0; $gap = int($gap / 3)) {
for (my $i = $gap; $i < $k; $i++) {
my $temp = $buff->[$i];
my $j = $i - $gap;
for (; $j >= 0 && $temp < $buff->[$j]; $j -= $gap) {
$buff->[$j + $gap] = $buff->[$j];
}
$buff->[$j + $gap] = $temp;
}
}
$buff;
}
シェルソートは実装が簡単で、極端に要素数が大きくなければ十分実用になるソートだと思います。
リスト : クイックソート
sub qsort {
my ($buff, $low, $high) = @_;
my $pivot = $buff->[$low + int(($high - $low) / 2)];
my $i = $low;
my $j = $high;
while (1) {
while ($pivot > $buff->[$i]) { $i++; }
while ($pivot < $buff->[$j]) { $j--; }
last if $i >= $j;
my $temp = $buff->[$i];
$buff->[$i] = $buff->[$j];
$buff->[$j] = $temp;
$i++;
$j--;
}
qsort($buff, $low, $i - 1) if $low < $i - 1;
qsort($buff, $j + 1, $high) if $high > $j + 1;
}
sub quick_sort {
my $buff = shift;
qsort($buff, 0, @$buff - 1);
$buff;
}
実際の処理は関数 qsort で行います。引数 $buff がソートする配列、$low が区間の下限値、$high が区間の上限値です。qsort は $buff の $low から $high までの区間をソートします。
最初に、区間の真ん中にあるデータを枢軸として選び、変数 $pivot にセットします。次の while ループで、左側から枢軸以上の要素を探しています。ここでは枢軸以上という条件を、枢軸より小さい間は探索位置を進める、というように置き換えています。
同様に次の while ループで右側から枢軸以下の要素を探します。お互いの探索位置 $i, $j が交差したら分割は終了です。last 文で while ループから脱出します。そうでなければお互いの要素を交換します。交換したあと $i と $j の値を更新しておくことを忘れないでください。
そして、分割した区間に対して qsort を再帰呼び出しします。このとき要素数をチェックして、2 個以上ある場合に再帰呼び出しを行います。この停止条件を忘れると正常に動作しません。ご注意ください。
クイックソートは、枢軸の選び方で効率が大きく左右されます。区間の中央値を枢軸に選ぶと、区間をほぼ半分に分割することができます。この場合がいちばん効率が良く、データ数をN とすると N * log2 N に比例する時間でソートすることができます。
逆に、区間での最大値または最小値を枢軸に選ぶと、区間はその要素と残りの要素の 2 つに分割にされることになります。これが最悪の場合で、分割のたびに最大値もしくは最小値を選ぶと、実行時間は要素数の 2 乗に比例することになります。これは遅いソートアルゴリズムであるバブルソートや単純挿入ソートと同じです。
この問題は枢軸の選び方を工夫することで、完全ではありませんが回避することができます。区間の中からいくつかの要素を選び、その中で中央の値を持つ要素を枢軸とします。たくさんの要素を選ぶとそれだけ最悪の枢軸を選ぶ危険性は少なくなりますが、値を選ぶのに時間がかかってしまいます。実際には数個の要素を選び、その中央値を枢軸とする場合が多いようです。特に、9 個の要素から枢軸を選ぶ median-of-9 という方法は優秀です。興味のある方は拙作のページ お気楽Ｃ言語プログラミング超入門 ソート をお読みください。
リスト : 素因数分解
sub factor_sub {
my ($n, $m) = @_;
my $c = 0;
while ($n % $m == 0) {
$c++;
$n /= $m;
}
($c, $n);
}
sub factorization {
my $n = shift;
my $xs = [];
my ($c, $m) = factor_sub($n, 2);
push @$xs, [2, $c] if $c > 0;
for (my $i = 3; $m >= $i * $i; $i += 2) {
($c, $m) = factor_sub($m, $i);
push @$xs, [$i, $c] if $c > 0;
}
push @$xs, [$m, 1] if $m > 1;
$xs;
}
素因数分解は素数 2, 3, 5, ... で順番に割り算していけばいいのですが、いちいち素数を求めるのは大変なので、2 と 3 以上の奇数列で割り算していきます。関数 factor_sub は $n を $m で割り算します。このとき、$m で割り切れる回数を求めます。factor_sub は $m で割った回数と商をリストコンテキストで返します。
次に、factor_sub を呼び出して $n を 2 で割り算します。それから、for ループで奇数列を生成します。変数 $i は 3 で初期化します。$xs は結果を格納する配列です。√$m < $i になったら for ループを終了します。そうでなければ、factor_sub を呼び出して $m を $i で割り算します。奇数列には素数ではないものがありますが、その前に小さな素数で素因数分解されているので、$n がその値で割り切れることはありません。最後に $m が 1 より大きければ [$m, 1] を $xs に追加します。
n の素因数分解ができると、約数の個数を求めるのは簡単です。n = pa * qb * rc とすると、約数の個数は (a + 1) * (b + 1) * (c + 1) になります。たとえば、12 は 22 * 31 になるので、約数の個数は 3 * 2 = 6 になります。実際、12 の約数は 1, 2, 3, 4, 6, 12 の 6 個です。
プログラムは次のようになります。
リスト : 約数の個数
sub divisor_num {
my $xs = factorization(shift);
my $a = 1;
foreach my $ys (@$xs) {
$a *= $ys->[1] + 1
}
$a;
}
divisor_num は foreach で配列 $xs の要素を順番に取り出して変数 $ys にセットし、$ys->[1] + 1 を $a に掛け算していくだけです。
n の素因数分解ができると、約数の合計値を求めるのは簡単です。n の素因数分解が pa だった場合、その約数の合計値は次の式で求めることができます。
σ(p, a) = pa + pa-1 + ... + p2 + p + 1
たとえば、8 の素因数分解は 23 になり、素数の合計値は 8 + 4 + 2 + 1 = 15 になります。
pa の約数の合計値を σ(p, a) で表すことにします。n = pa * qb * rc の場合、n の約数の合計値は σ(p, a) * σ(q, b) * σ(r, c) になります。たとえば、12 は 22 * 3 に素因数分解できますが、その合計値は (4 + 2 + 1) * (3 + 1) = 28 となります。12 の約数は 1, 2, 3, 4, 6, 12 なので、その合計値は確かに 28 になります。
プログラムは次のようになります。
リスト : 約数の合計値
# σ(p, n) の計算
sub div_sum_sub {
my ($p, $n) = @_;
my $a = 0;
for (; $n > 0; $n--) {
$a += $p ** $n;
}
$a + 1;
}
sub divisor_sum {
my $xs = factorization(shift);
my $a = 1;
foreach my $x (@$xs) {
$a *= div_sum_sub($x->[0], $x->[1]);
}
$a;
}
関数 div_sum_sub は σ(p, n) を計算します。あとは foreach で div_sum_sub の返り値を累積変数 a に掛け算していくだけです。
p が素数の場合、pa の約数は次のように簡単に求めることができます。
pa, pa-1, ... p2, p, 1
n の素因数分解が pa * qb だったとすると、その約数は次のようになります。
(pa, pa-1, ... p2, p, 1) * qb,
(pa, pa-1, ... p2, p, 1) * qb-1,
.....
(pa, pa-1, ... p2, p, 1) * q2,
(pa, pa-1, ... p2, p, 1) * q,
(pa, pa-1, ... p2, p, 1) * 1
たとえば、12 の約数は 24 = (1, 2, 4) と 3 = (1, 3) から、(1, 2, 4) * 1 と (1, 2, 4) * 3 のすべての要素 (1, 2, 4, 3, 6, 12) になります。
プログラムは次のようになります。
リスト : 約数をすべて求める
sub divisor_sub {
my ($p, $q) = @_;
my $a = [];
for (my $i = 0; $i <= $q; $i++) {
push @$a, $p ** $i;
}
$a;
}
# 互いの要素を掛け算する
sub product {
my ($xs, $ys) = @_;
my $zs = [];
foreach my $xs1 (@$xs) {
foreach my $ys1 (@$ys) {
push @$zs, $xs1 * $ys1;
}
}
$zs;
}
sub divisor {
my $xs = factorization(shift);
my $ys = divisor_sub($xs->[0][0], $xs->[0][1]);
for (my $i = 1; $i < @$xs; $i++) {
$ys = product(divisor_sub($xs->[$i][0], $xs->[$i][1]), $ys);
}
shell_sort($ys);
}
関数 divisor_sub は pn の約数を配列に格納して返します。関数 product は 2 つの配列 $xs、$ys の要素を掛け合わせたものを配列に格納して返します。あとは for ループで素因数分解した結果を順番に取り出し、[p, q] を divisor_sub で配列に変換して、それを product で累積変数 $ys の配列と掛け合わせていくだけです。
リスト : 完全数
sub perfect_number {
my $n = shift;
for (my $x = 2; $x <= $n; $x++) {
print $x, "\n" if divisor_sum($x) - $x == $x;
}
}
完全数を求める perfect_number は簡単です。$x の約数の合計値を divisor_sum で求め、その値から $x を引いた値が $x と等しければ完全数です。print で $x を表示します。
リスト : 友愛数
sub yuuai_number {
my $n = shift;
for (my $x = 2; $x <= $n; $x++) {
my $m = divisor_sum($x) - $x;
print "($x, $m)\n" if ($x < $m) && ($x == divisor_sum($m) - $m);
}
}
友愛数を求める yuuai_number も簡単です。divisor_sum で $x の約数の合計値を求め、その値から $x を引いた値を変数 $m にセットします。$m の約数の合計値から $m を引いた値が $x と等しければ、$x と $m は友愛数です。print で $x と $m を表示します。同じ組を表示しないようにするため、$x < $m を条件に入れています。