M.Hiroi's Home Page

Linux Programming

お気楽 Perl プログラミング超入門

[ PrevPage | Perl | NextPage ]

整数の論理演算とビット操作

今回は Perl のビット操作について取り上げます。Perl のビット演算子は文字列にも適用することができますが、本ページでは integer プラグマを指定して、整数を例に説明することにします。

●integer プラグマ

use integer を指定すると、そこからブロックの終わりまで、算術演算は整数で行われるようになります。次の例を見てください。

リスト : integer プラグマの使用例 (sample1900.pl)

use strict;
use warnings;

my $x = 9223372036854775807;  # 0x7fff_ffff_ffff_ffff;
print 10 / 3, "\n";
print $x, "\n";
print $x + 1, "\n";

use integer;

print 10 / 3, "\n";
print $x, "\n";
print $x + 1, "\n";
$ perl sample1900.pl
3.33333333333333
9223372036854775807
9223372036854775808
3
9223372036854775807
-9223372036854775808

このように use integer を指定すると、10 / 3 の結果は整数値 3 になります。整数の大きさは Perl 処理系によって異なりますが、M.Hiroi が使用している処理系では 64 bit になりました。変数 $x に符号付き 64 bit 整数の最大値 9223372036854775807 (0x7fff_ffff_ffff_ffff) をセットします。use integer を指定しない場合、$x + 1 は 9223372036854775808 (0x8000_0000_0000_0000) になりますが、use integer を指定すると最上位ビットが 1 になるため、最小値 (-9223372036854775808) になります。

●ビット演算子

Perl はビット演算子はC言語と同じです。下表に Perl のビット演算子を示します。

表 : ビット演算子
演算子操作
x & y ビットごとの論理積
x | y ビットごとの論理和
x ^ y ビットごとの排他的論理和
~x ビットごとの否定
x << y x を y ビット左シフト
x >> y x を y ビット右シフト

演算子 & はビットごとの論理積を返します。

5 & 3 => 1
     0101
 AND 0011
---------
     0001

演算子 l はビットごとの論理和を返します。

5 | 3 => 7
    0101
 OR 0011
--------
    0111

演算子 ^ はビットごとの排他的論理和を返します。

5 ^ 3 => 6
     0101
 XOR 0011
---------
     0110

演算子 ~ はビットごとの論理的な否定を返します。

~1 => -2
~0 => -1

<<, >> はビットをシフトする演算子です。左シフトの場合、下位ビットには 0 が挿入されます。右シフトの場合、上位ビットに 0 が挿入されます。右シフトの場合、正の整数では上位ビットに 0 が挿入されます。負の整数では 1 が挿入されます。これを「算術シフト」といいます。

1 << 8 => 256
1 << 16 => 65536
256 >> 8 => 1
65536 >> 8 => 256
-256 >> 8 => -1

なお、integer プラグマを指定しない場合、Perl の右シフトは算術シフトにはなりません。負数の場合でも上位ビットに 0 が挿入されます。ご注意くださいませ。

それでは簡単な例題として、基本的なビット操作関数を作ってみましょう。次のリストを見てください。

リスト : 基本的なビット操作 (sample1901.pl)

use strict;
use warnings;
use integer;

sub test_bit {
    my ($x, $n) = @_;
    ($x & (1 << $n)) != 0 ? 1 : 0;
}

sub set_bit {
    my ($x, $n) = @_;
    $x | (1 << $n);
}

sub clear_bit {
    my ($x, $n) = @_;
    $x & ~(1 << $n);
}

print test_bit(256, 7), "\n";
print test_bit(256, 8), "\n";
print test_bit(256, 9), "\n";
for (my $i = 0; $i < 8; $i++) {
    my $x = set_bit(0, $i);
    print $x, "\n";
    print clear_bit($x, $i), "\n";
}

test_bit は整数 $x の $n 番目のビットが 1 ならば 1 を返します。最下位 (LSB) のビットが 0 番目になります。M.Hiroi が使用している Perl 処理系は整数を 64 bit で扱うので、$n は 0 から 63 になります。1 を $n ビット左シフトして、$x との論理積が 0 でなければ、$n 番目のビットは 1 であることがわかります。

bit_set は $x の $n 番目のビットを 1 にセットします。1 を $n ビット左シフトして、$x との論理和を計算すれば、$n 番目のビットを 1 にすることができます。clear_bit は $x の $n 番目のビットを 0 にクリアします。これは $n 番目以外のビットを 1 に、$n 番目のビットを 0 にして、それと $x の論理積を計算すれば、$n 番目のビットをクリアすることができます。1 を $n ビット左シフトしてその否定を計算すると、$n 番目のビット以外は 1 になります。

それでは実際に試してみましょう。

$ perl sample1901.pl
0
1
0
1
0
2
0
4
0
8
0
16
0
32
0
64
0
128
0

●組み合わせの生成

組み合わせの生成は拙作のページ 順列と組み合わせ で取り上げました。このほかに、n 個の中から m 個を選ぶ組み合わせは、ビットの 0, 1 で表すことができます。たとえば、5 個の数字 (0 - 4) から 3 個を選ぶ場合、数字を 0 番目 から 4 番目のビットに対応させます。そうすると、1, 3, 4 という組み合わせは 11010 と表すことができます。簡単な例題として、ビットを使って組み合わせを求めてみましょう。

組み合わせを求めるプログラムは次のようになります。

リスト : 組み合わせの生成 (sample1902.pl)

use strict;
use warnings;
use integer;

sub comb_sub {
    my ($f, $n, $m, $a) = @_;
    if ($m == 0) {
        $f->($a);
    } elsif ($m == $n) {
        $f->($a | ((1 << $m) - 1));
    } else {
        comb_sub($f, $n - 1, $m, $a);
        comb_sub($f, $n - 1, $m - 1, $a | (1 << ($n - 1)));
    }
}

sub combinations {
    my ($f, $n, $m) = @_;
    comb_sub($f, $n, $m, 0);
}

combinations(sub { print shift, "\n"; }, 5, 3);

関数 combinations は $n 個の中から $m 個を選ぶ組み合わせを生成して、引数の関数 $f に渡します。実際の処理は関数 comb_sub で行います。組み合わせは引数 $a にセットします。$m が 0 になったら、組み合わせがひとつできたので $f->($a) を呼び出します。$n が $m と等しくなったならば、残り $m 個を全て選びます。(1 << $m) - 1 で $m 個のビットをオンにして関数 $f を呼び出します。

あとは comb_sub を再帰呼び出しします。最初の呼び出しは $n 番目の数字を選ばない場合です。$n - 1 個の中から $m 個を選びます。次の呼び出しが $n 番目の数字を選ぶ場合で、$a の $n - 1 番目のビットをオンにします。そして、$n - 1 個の中から $m - 1 個を選びます。

それでは実行してみましょう。

$ perl sample1902.pl
7
11
13
14
19
21
22
25
26
28

この場合、最小値は 7 (111) で最大値は 28 (11100) になります。このように、combinations は組み合わせを表す数を昇順で出力します。

●組み合わせに番号を付ける方法

次は、N 通りある組み合わせに 0 から N - 1 までの番号を付ける方法を紹介しましょう。たとえば、6 個の中から 3 個を選ぶ組み合わせは 20 通りありますが、この組み合わせに 0 から 19 までの番号を付けることができます。1 1 1 0 0 0 を例題に考えてみましょう。次の図を見てください。


    図 : 6C3 の組み合わせ

最初に 5 をチェックします。5 を選ばない場合は \({}_5 \mathrm{C}_3\) = 10 通りありますね。この組み合わせに 0 から 9 までの番号を割り当てることにすると、5 を選ぶ組み合わせの番号は 10 から 19 までとなります。

次に、4 をチェックします。4 を選ばない場合は、\({}_4 \mathrm{C}_2\) = 6 通りあります。したがって、5 を選んで 4 を選ばない組み合わせに 10 から 15 までの番号を割り当てることにすると、5 と 4 を選ぶ組み合わせには 16 から 19 までの番号となります。

最後に、3 をチェックします。同様に 3 を選ばない場合は 3 通りあるので、これに 16 から 18 までの番号を割り当て、5, 4, 3 を選ぶ組み合わせには 19 を割り当てます。これで組み合わせ 1 1 1 0 0 0 の番号を求めることができました。

では、0 0 0 1 1 1 はどうなるのでしょうか。左から順番にチェックしていくと、最初の 1 が見つかった時点で、その数字を選ばない組み合わせは存在しません。つまり、残りの数字をすべて選ぶしかないわけです。したがって、これが 0 番目となります。

このように、数字を選ぶときに、数字を選ばない場合の組み合わせの数を足し算していけば、その組み合わせの番号を求めることができるのです。

●組み合わせを番号に変換

組み合わせを番号に変換するプログラムは次のようになります。

リスト : 組み合わせを番号に変換

# 組み合わせの数
sub comb_num {
    my ($n, $r) =@_;
    if ($n == $r || $r == 0) {
        1;
    } else {
        comb_num($n, $r - 1) * ($n - $r + 1) / $r;
    }
}

# 組み合わせを番号に変換
sub comb_to_num_sub {
    my ($c, $n, $r, $value) = @_;
    if ($r == 0 || $n == $r) {
        $value;
    } elsif (test_bit($c, $n - 1)) {
        comb_to_num_sub($c, $n - 1, $r - 1, $value + comb_num($n - 1, $r));
    } else {
        comb_to_num_sub($c, $n - 1, $r, $value);
    }
}

sub comb_to_num {
    my ($c, $n, $r) = @_;
    return comb_to_num_sub($c, $n, $r, 0);
}

関数 comb_num は組み合わせの数を求めます。comb_to_num の引数 $c はビットのオンオフで表した組み合わせ、引数 $n と $r は \({}_n \mathrm{C}_r\) の n と r を表しています。実際の処理は comb_to_num_sub で行います。引数 $value は求める番号を表します。$n と $r の値が同じになるか、もしくは $r が 0 になれば、組み合わせの番号を計算できたので $value を返します。

そうでない場合、$c の $n - 1 ビットの値を調べます。ビットがオンであれば、$value に comb_num($n - 1, $r) の値を足し算し、$r を -1 して comb_to_num_sub を再帰呼び出しします。そうでなければ、$value と $r の値はそのままで comb_to_num_sub を再帰呼び出しします。

●番号を組み合わせに変換

逆に、番号から組み合わせを求めるプログラムも簡単に作ることができます。次のリストを見てください。

リスト : 番号を組み合わせに変換

sub num_to_comb_sub {
    my ($value, $n, $r, $c) = @_;
    if ($r == 0) {
        $c;
    } elsif ($n == $r) {
        $c | ((1 << $n) - 1);
    } else {
        my $k = comb_num($n - 1, $r);
        if ($value >= $k) {
            num_to_comb_sub($value - $k, $n - 1, $r - 1, set_bit($c, $n - 1));
        } else {
            num_to_comb_sub($value, $n - 1, $r, $c);
        }
    }
}

sub num_to_comb {
    my ($value, $n, $r) =@_;
    num_to_comb_sub($value, $n, $r, 0);
}

引数 $value が番号で、引数 $n と $r は \({}_n \mathrm{C}_r\) の n と r を表しています。実際の処理は num_to_comb_sub で行います。引数 $c が求める組み合わせです。たとえば、n = 5, r = 3 の場合、ビットが 1 になるのは \({}_4 \mathrm{C}_2\) = 6 通りあり、0 になるのは \({}_4 \mathrm{C}_3\) = 4 通りあります。したがって、数値が 0 - 3 の場合はビットを 0 にし、4 - 9 の場合はビットを 1 にすればいいわけです。

ビットを 0 にした場合、残りは \({}_4 \mathrm{C}_3\) = 4 通りになるので、同様に次のビットを決定します。ビットを 1 にした場合、残りは \({}_4 \mathrm{C}_2\) = 6 通りになるので、$value から 4 を引いて num_to_comb を再帰呼び出しして次のビットを決定します。

$r が 0 の場合は、組み合わせが完成したので $c を返します。$n と $r が等しい場合は、残りのビットをすべて 1 にセットしてから $c を返します。それ以外の場合は、\({}_{n-1} \mathrm{C}_r\) の値を comb_num($n - 1, $r) で求めて変数 $k にセットします。$value が $k 以上であれば変数 $c のビットを 1 にセットし、$value から $k を引き算して num_to_comb_sub を再帰呼び出しします。そうでなければ、num_to_comb_sub を再帰呼び出しするだけです。

それでは、n = 5, r = 3 の場合の実行例を示します。

リスト : 簡単なテスト

for (my $i = 0; $i < 10; $i++) {
    my $x = num_to_comb($i, 5, 3);
    my $y = comb_to_num($x, 5, 3);
    print "$i -> $x -> $y\n";
}
$ perl sample1903.pl
0 -> 7 -> 0
1 -> 11 -> 1
2 -> 13 -> 2
3 -> 14 -> 3
4 -> 19 -> 4
5 -> 21 -> 5
6 -> 22 -> 6
7 -> 25 -> 7
8 -> 26 -> 8
9 -> 28 -> 9

正常に動作していますね。この方法を使うと、n 個ある組み合わせの中の i 番目 (0 <= i < n) の組み合わせを簡単に求めることができます。

●ちょっと便利なビット操作

最も右側 (LSB 側) にある 1 を 0 にクリアする、逆に最も右側にある 0 を 1 にセットすることは簡単にできます。

(1) 右側にある 1 をクリア => x & (- x)

x     : 1 1 1 1
x - 1 : 1 1 1 0
----------------
 AND  : 1 1 1 0

x     : 1 0 0 0
x - 1 : 0 1 1 1
----------------
 AND  : 0 0 0 0

(2) 右側にある 0 を 1 にセット => x | (x + 1)

x     : 0 0 0 0
x + 1 : 0 0 0 1
----------------
  OR  : 0 0 0 1

x     : 0 1 1 1
x - 1 : 1 0 0 0
----------------
  OR  : 1 1 1 1

上図 (1) を見てください。x から 1 を引くと、右側から連続している 0 は桁借りにより 1 になり、最初に出現する 1 が 0 になります。したがって、x & (x - 1) を計算すると、最も右側にある 1 を 0 にクリアすることができます。(2) の場合、x に 1 を足すと、右側から連続している 1 は桁上がりにより 0 になり、最初に出現する 0 が 1 になります。x | (x + 1) を計算すれば、最も右側にある 0 を 1 にセットすることができます。

また、最も右側にある 1 を取り出すことも簡単にできます。簡単な例として 4 ビットの整数値を考えてみます。負の整数を 2 の補数で表した場合、4 ビットで表される整数は -8 から 7 になります。次の図を見てください。

 0 : 0000
 1 : 0001    -1 : 1111    1 & (-1) => 0001
 2 : 0010    -2 : 1110    2 & (-2) => 0010
 3 : 0011    -3 : 1101    3 & (-3) => 0001
 4 : 0100    -4 : 1100    4 & (-4) => 0100
 5 : 0101    -5 : 1011    5 & (-5) => 0001
 6 : 0110    -6 : 1010    6 & (-6) => 0010
 7 : 0111    -7 : 1001    7 & (-7) => 0001
             -8 : 1000


        図 : 最も右側にある 1 を取り出す方法

2 の補数はビットを反転した値 (1 の補数) に 1 を加算することで求めることができます。したがって、x と -x の論理積 x & (-x) は、最も右側にある 1 だけが残り、あとのビットはすべて 0 になります。

●ビットが 1 の個数を求める

次は、ビットが 1 の個数を数える処理を作ってみましょう。プログラムは次のようになります。

リスト : ビットカウント

sub bit_count {
    my $m = shift;
    my $c = 0;
    while ($m != 0) {
        $m &= $m - 1;
        $c++;
    }
    return $c;
}

整数 n の右側から順番に 1 をクリアしていき、0 になるまでの回数を求めます。とても簡単ですね。64 個のビットを順番に調べるよりも高速です。

整数を 64 bit とする場合、次の方法で 1 の個数をもっと高速に求めることができます。

リスト : ビットカウント (2)

# 定数の定義
use constant {
    BC1 => 6148914691236517205, # 0x5555555555555555
    BC2 => 3689348814741910323, # 0x3333333333333333
    BC3 => 1085102592571150095, # 0x0f0f0f0f0f0f0f0f
    BC4 => 71777214294589695,   # 0x00ff00ff00ff00ff
    BC5 => 281470681808895,     # 0x0000ffff0000ffff
}; 

sub bit_count1 {
    my $n = shift;
    my $a = ($n & BC1) + (($n >>  1) & BC1);
    my $b = ($a & BC2) + (($a >>  2) & BC2);
    my $c = ($b & BC3) + (($b >>  4) & BC3);
    my $d = ($c & BC4) + (($c >>  8) & BC4);
    my $e = ($d & BC5) + (($d >> 16) & BC5);
    return ($e & 0xffffffff) + ($e >> 32);
}

最初に、整数を 2 bit ずつに分割して、1 の個数を求めます。たとえば、整数 n を 4 bit で考えてみましょう。5 を 2 進数で表すと 0101 になり、n と論理積を計算すると 0, 2 番目のビットが 1 であれば、結果の 0, 2 番目のビットは 1 になります。同様に n を 1 ビット右シフトして論理積を計算すると、1, 3 番目のビットが 1 であれば、結果の 0, 2 番目のビットは 1 になります。あとは、それを足し算すれば 2 bit の中にある 1 の個数を求めることができます。

変数 a には 2 ビットの中の 1 の個数が格納されています。左隣の 2 ビットの値を足し算すれば、4 ビットの中の 1 の個数を求めることができます。次に、左隣の 4 ビットの値を足し算して 8 ビットの中の 1 の個数を求め、左隣の 8 ビットの値を足し算して、というように順番に値を加算していくと 64 ビットの中にある 1 の個数を求めることができます。

bit_count は 1 の個数が多くなると遅くなりますが、bit_count1 は 1 の個数に関係なく高速に動作します。興味のある方は試してみてください。

●参考 URL

ビットが 1 の個数を数える方法は フィンローダさん初級C言語Q&A(15) を参考にさせていただきました。フィンローダさんに感謝いたします。


●プログラムリスト

リスト : 整数のビット操作 (sample1903.pl)

use strict;
use warnings;
use integer;

sub test_bit {
    my ($x, $n) = @_;
    ($x & (1 << $n)) != 0 ? 1 : 0;
}

sub set_bit {
    my ($x, $n) = @_;
    $x | (1 << $n);
}

sub clear_bit {
    my ($x, $n) = @_;
    $x & ~(1 << $n);
}

# 組み合わせの数
sub comb_num {
    my ($n, $r) =@_;
    if ($n == $r || $r == 0) {
        1;
    } else {
        comb_num($n, $r - 1) * ($n - $r + 1) / $r;
    }
}

# 組み合わせを番号に変換
sub comb_to_num_sub {
    my ($c, $n, $r, $value) = @_;
    if ($r == 0 || $n == $r) {
        $value;
    } elsif (test_bit($c, $n - 1)) {
        comb_to_num_sub($c, $n - 1, $r - 1, $value + comb_num($n - 1, $r));
    } else {
        comb_to_num_sub($c, $n - 1, $r, $value);
    }
}

sub comb_to_num {
    my ($c, $n, $r) = @_;
    return comb_to_num_sub($c, $n, $r, 0);
}

# 番号を組み合わせに変換
sub num_to_comb_sub {
    my ($value, $n, $r, $c) = @_;
    if ($r == 0) {
        $c;
    } elsif ($n == $r) {
        $c | ((1 << $n) - 1);
    } else {
        my $k = comb_num($n - 1, $r);
        if ($value >= $k) {
            num_to_comb_sub($value - $k, $n - 1, $r - 1, set_bit($c, $n - 1));
        } else {
            num_to_comb_sub($value, $n - 1, $r, $c);
        }
    }
}

sub num_to_comb {
    my ($value, $n, $r) =@_;
    num_to_comb_sub($value, $n, $r, 0);
}

# ビットカウント
sub bit_count {
    my $m = shift;
    my $c = 0;
    while ($m != 0) {
        $m &= $m - 1;
        $c++;
    }
    return $c;
}

# 定数の定義
use constant {
    BC1 => 6148914691236517205, # 0x5555555555555555
    BC2 => 3689348814741910323, # 0x3333333333333333
    BC3 => 1085102592571150095, # 0x0f0f0f0f0f0f0f0f
    BC4 => 71777214294589695,   # 0x00ff00ff00ff00ff
    BC5 => 281470681808895,     # 0x0000ffff0000ffff
}; 

sub bit_count1 {
    my $n = shift;
    my $a = ($n & BC1) + (($n >>  1) & BC1);
    my $b = ($a & BC2) + (($a >>  2) & BC2);
    my $c = ($b & BC3) + (($b >>  4) & BC3);
    my $d = ($c & BC4) + (($c >>  8) & BC4);
    my $e = ($d & BC5) + (($d >> 16) & BC5);
    return ($e & 0xffffffff) + ($e >> 32);
}

# 簡単なテスト
for (my $i = 0; $i < 10; $i++) {
    my $x = num_to_comb($i, 5, 3);
    my $y = comb_to_num($x, 5, 3);
    print "$i -> $x -> $y\n";
}

print bit_count(0xffff0000ffff0000), "\n";
print bit_count1(0xffff0000ffff0000), "\n";
print bit_count(0xffffffffffffffff), "\n";
print bit_count1(0xffffffffffffffff), "\n";

初版 2015 年 6 月 7 日
改訂 2023 年 3 月 21 日

メモ化と遅延評価

今回は「たらいまわし関数」を例題にして、「メモ化」と「遅延評価」について説明します。

●たらいまわし関数

最初に「たらいまわし関数」について説明します。次のリストを見てください。

リスト : たらいまわし関数

sub tarai {
    my ($x, $y, $z) = @_;
    if ($x <= $y) {
        $y;
    } else {
        tarai(tarai($x - 1, $y, $z), tarai($y - 1, $z, $x), tarai($z - 1, $x, $y));
    }
}

sub tak {
    my ($x, $y, $z) = @_;
    if ($x <= $y) {
        $z;
    } else {
        tak(tak($x - 1, $y, $z), tak($y - 1, $z, $x), tak($z - 1, $x, $y));
    }
}

関数 tarai や tak は「たらいまわし関数」といって、再帰的に定義されています。これらの関数は、引数の与え方によっては実行に時間がかかるため、Lisp などのベンチマークに利用されることがあります。

関数 tarai は通称「竹内関数」と呼ばれていて、日本の代表的な Lisper である竹内郁雄氏によって考案されたそうです。そして、関数 tak は関数 tarai のバリエーションで、John Macarthy 氏によって作成されたそうです。たらいまわし関数が Lisp のベンチマークで使われていたことは知っていましたが、このような由緒ある関数だとは思ってもいませんでした。

それでは、さっそく実行してみましょう。

リスト : たらいまわし関数の実行

use strict;
use warnings;
use Time::HiRes;

#
# 関数定義は省略
#

my $s = Time::HiRes::time;
print tarai(12, 6, 0), "\n";
print Time::HiRes::time - $s, "\n";
$s = Time::HiRes::time;
print tak(18, 9, 0), "\n";
print Time::HiRes::time - $s, "\n";

Time::Hires は高精度の時刻やタイマーに関する関数を提供するモジュールです。Perl の関数 time は 1970 年 1 月 1 日 UTC からの秒数を返しますが、Time::Hires::time は小数点数 6 桁 (ナノ秒) まで計測します。

それでは実行してみましょう。

$ perl tarai.pl
12
2.81726503372192
9
3.55909490585327

実行環境 : Perl v5.34.0, Ubunts 22.04 LTS (WSL2, Windows 10), Intel Core i5-6200U 2.30GHz

このように、たらいまわし関数は引数の値が小さくても実行に時間がかかります。

●メモ化による高速化

たらいまわし関数が遅いのは、同じ値を何度も計算しているためです。この場合、表 (table) を使って処理を高速化することができます。同じ値を何度も計算することがないように、計算した値は表に格納しておいて、2 回目以降は表から計算結果を求めるようにします。このような手法を「表計算法」とか「メモ化 (memoization または memoisation)」といいます。

ハッシュを使うと、たらいまわし関数のメモ化は次のようになります。

リスト : たらいまわし関数のメモ化 (1)

use strict;
use warnings;
use Time::HiRes;

# メモ用のハッシュ
our %table = ();

sub tarai {
    my ($x, $y, $z) = @_;
    my $key = "$x $y $z";
    if (!$table{$key}) {
        $table{$key} = $x <= $y ? $y : tarai(tarai($x - 1, $y, $z),
                                             tarai($y - 1, $z, $x),
                                             tarai($z - 1, $x, $y));
    }
    $table{$key};
}

my $s = Time::HiRes::time;
print tarai(12, 6, 0), "\n";
print Time::HiRes::time - $s, "\n";

関数 tarai の値を格納するハッシュを大域変数 %table に用意します。関数 tarai では、引数 $x, $y, $z を文字列 "$x $y $z" に変換し、それをキー ($key) にして %table を検索します。%table に $key があればその値を返します。そうでなければ、tarai を計算して %table にセットし、その値を返します。

それでは実行してみましょう。

$ perl tarai_memo.pl
12
0.000413179397583008

実行環境 : Perl v5.34.0, Ubunts 22.04 LTS (WSL2, Windows 10), Intel Core i5-6200U 2.30GHz

とても速くなりましたね。

●Memoize によるメモ化

このように関数をメモ化することは簡単にできますが、メモ化を行うたびに関数を修正するのは面倒です。このような場合、関数をメモ化する「メモ化関数」があると便利です。Perl の場合、モジュール Memoize を使うと簡単に関数をメモ化することができます。

プログラムは次のようになります。

リスト : Memoize によるメモ化 (tarai1.pl)

use strict;
use warnings;
use Memoize;
use Time::HiRes;

sub tarai {
    my ($x, $y, $z) = @_;
    if ($x <= $y) {
        $y;
    } else {
        tarai(tarai($x - 1, $y, $z), tarai($y - 1, $z, $x), tarai($z - 1, $x, $y));
    }
}

sub tak {
    my ($x, $y, $z) = @_;
    if ($x <= $y) {
        $z;
    } else {
        tak(tak($x - 1, $y, $z), tak($y - 1, $z, $x), tak($z - 1, $x, $y));
    }
}

# メモ化
memoize('tarai');
memoize('tak');

my $s = Time::HiRes::time;
print tarai(12, 6, 0), "\n";
print Time::HiRes::time - $s, "\n";
$s = Time::HiRes::time;
print tak(18, 9, 0), "\n";
print Time::HiRes::time - $s, "\n";

メモ化は簡単です。memoize('関数名') でメモ化する関数を指定するだけです。

それでは実際に実行してみましょう。

$ perl tarai1.pl
12
0.00148510932922363
9
0.00447702407836914

実行環境 : Perl v5.34.0, Ubunts 22.04 LTS (WSL2, Windows 10), Intel Core i5-6200U 2.30GHz

メモ化の効果は十分に出ていると思います。また、同じ計算を再度実行すると、メモ化の働きにより値をすぐに求めることができます。

●遅延評価による高速化

関数 tarai は「遅延評価 (delayed evaluation または lazy evaluation)」を行う処理系、たとえば関数型言語の Haskell では高速に実行することができます。また、Scheme でも delay と force を使って遅延評価を行うことができます。

tarai のプログラムを見てください。x <= y のときに y を返しますが、このとき引数 z の値は必要ありませんね。引数 z の値は x > y のときに計算するようにすれば、無駄な計算を省略することができます。なお、関数 tak は x <= y のときに z を返しているため、遅延評価で高速化することはできません。ご注意ください。

完全ではありませんが、Perl でもクロージャを使って遅延評価を行うことができます。次のリストを見てください。

リスト : クロージャによる遅延評価

use strict;
use warnings;
use Time::HiRes;

sub tarai {
    my ($x, $y, $z) = @_;
    if ($x <= $y) {
        $y;
    } else {
        my $zz = $z->();
        tarai(tarai($x - 1, $y, sub { $zz }),
              tarai($y - 1, $zz, sub { $x }),
              sub { tarai($zz - 1, $x, sub { $y }); });
    }
}

my $s = Time::HiRes::time;
print tarai(12, 6, sub { 0 }), "\n";
print Time::HiRes::time - $s, "\n";

遅延評価したい処理をクロージャに包んで引数 $z に渡します。そして、$x > $y のときに引数 $z の関数を呼び出します。すると、クロージャ内の処理が評価されて $z の値を求めることができます。たとえば、sub { 0 } を $z に渡す場合、$z->() とすると返り値は 0 になります。sub { $x } を渡せば、$x に格納されている値が返されます。sub { tarai( ...); } を渡せば、関数 tarai が実行されてその値が返されるわけです。

それでは、実際に実行してみましょう。

$ perl tarai_clo.pl
12
0.000205039978027344

実行環境 : Perl v5.34.0, Ubunts 22.04 LTS (WSL2, Windows 10), Intel Core i5-6200U 2.30GHz

メモ化よりも速くなりました。tarai 関数の場合、遅延評価の効果はとても大きいですね。ところで、クロージャを使わなくても tarai 関数を高速化する方法があります。C++:language&libraries (cppll) [リンク切れ] で Akira Higuchi さんが書かれたC言語の tarai 関数はとても高速です。Perl でプログラムすると次のようになります。

リスト : tarai 関数の遅延評価 (2)

use strict;
use warnings;
use Time::HiRes;

sub tarai_lazy {
    my ($x, $y, $xx, $yy, $zz) = @_;
    if ($x <= $y) {
        $y;
    } else {
        my $z = tarai($xx, $yy, $zz);
        tarai_lazy(tarai($x - 1, $y, $z), tarai($y - 1, $z, $x), $z - 1, $x, $y);
    }
}

sub tarai {
    my ($x, $y, $z) = @_;
    if ($x <= $y) {
        $y;
    } else {
        tarai_lazy(tarai($x - 1, $y, $z), tarai($y - 1, $z, $x), $z - 1, $x, $y);
    }
}

my $s = Time::HiRes::time;
print tarai(12, 6, 0), "\n";
print Time::HiRes::time - $s, "\n";

関数 tarai_lazy の引数 $xx, $yy, $zz で $z の値を表すところがポイントです。つまり、$z の計算に必要な値を引数に保持し、$z の値が必要になったときに tarai($xx, $yy, $zz) で計算するわけです。

それでは実行してみましょう。

$ perl tarai_lazy.pl
12
0.0001068115234375

Perl でも高速に実行することができました。このような簡単な方法で tarai 関数を高速化できるとは驚きました。Akira Higuchi さんに感謝いたします。


初版 2015 年 6 月 14 日
改訂 2023 年 3 月 21 日

Copyright (C) 2015-2023 Makoto Hiroi
All rights reserved.

[ PrevPage | Perl | NextPage ]