« デイリーポータルViewerをバージョンアップ(べつやくれい・林雄司両氏結婚記念ではない) | メイン | モダンなPerlを「読む」上で覚えておくとよい構文 第2回「リストを理解すれば配列とハッシュをより活用できる」 »

2010年9月20日

Perlでフィボナッチ数列の高速化とか無名関数の再帰とか

簡単にfibを高速化する方法を読み、おおっと思って、Perlでやってみた。

#!/usr/bin/perl
use strict;
use warnings;
use feature qw/state/;
use Benchmark qw/timethese cmpthese/;
 
sub _fib_ret2 {
   my $n = shift;
   if ( $n == 1 ){
       (1,1);
   }
   else {
       my ( $aa, $bb ) = _fib_ret2($n-1);
       ($aa+$bb, $aa);
   }
}
sub fib_ret2 {
   (_fib_ret2(shift))[0];
}
 
sub fib_memo {
   state @cache;
   my $n = shift;
   $cache[$n] ||= $n <= 1 ? 1 : fib_memo($n-2) + fib_memo($n-1);
}
 
sub fib_normal {
   my $n = shift;
   return 1 if $n <= 1;
   return fib_normal($n-2) + fib_normal($n-1);
}
 
sub fib_no_recv { #まあ、これが一番速いのは分かってるんですよ。
   my $n = shift;
   return 1 if $n <= 1;
   my ( $fib, $prev ) = (1,1);
   ( $fib, $prev ) = ( $fib+$prev, $fib ) for 2..$n;
   $fib;
}
 
my $fib_arg = 30;
cmpthese timethese 0, {
   fib_ret2    => sub { fib_ret2($fib_arg) },
   fib_memo    => sub { fib_memo($fib_arg) },
   fib_normal  => sub { fib_normal($fib_arg) },
   fib_no_recv => sub { fib_no_recv($fib_arg) },
};
fib_memo:  3 wallclock secs ( 3.19 usr +  0.00 sys =  3.19 CPU) @ 1742548.96/s (n=5551761)
fib_no_recv:  3 wallclock secs ( 3.17 usr +  0.00 sys =  3.17 CPU) @ 66800.76/s (n=211892)
fib_normal:  3 wallclock secs ( 3.61 usr +  0.00 sys =  3.61 CPU) @  0.55/s (n=2)
fib_ret2:  3 wallclock secs ( 3.20 usr +  0.00 sys =  3.20 CPU) @ 28944.44/s (n=92738)
                 Rate  fib_normal    fib_ret2 fib_no_recv    fib_memo
fib_normal    0.554/s          --       -100%       -100%       -100%
fib_ret2      28944/s    5224372%          --        -57%        -98%
fib_no_recv   66801/s   12057437%        131%          --        -96%
fib_memo    1742549/s  314529988%       5920%       2509%          --

確かに速い。しかし、メモ化するよりかは遅い?いや、再帰なしのパターンよりか速いのはおかしくね?

違ぁう!そりゃそうだ。メモ化したやつは2回目の試行以降は、単なる配列のインデックスアクセスになっているので速いに決まっているのだ。つまり、実装としては正しいが、ベンチマークとしてはフェアじゃない。

てことで、ベンチマークの試行毎にメモの内容が初期化されて欲しい。しかし、stateが初期化された無名関数を返すにしても、無名関数を再帰する方法はPerlにはデフォルトで無いので、ダサいけど外部にメモを持たせるしかないかなぁと。

#!/usr/bin/perl
use strict;
use warnings;
use Benchmark qw/timethese cmpthese/;
 
sub _fib_ret2 {
   my $n = shift;
   if ( $n == 1 ){
       (1,1);
   }
   else {
       my ( $aa, $bb ) = _fib_ret2($n-1);
       ($aa+$bb, $aa);
   }
}
sub fib_ret2 {
   (_fib_ret2(shift))[0];
}
 
my @memo;
sub fib_memo2 {
   my $n = shift;
   $memo[$n] ||= $n <= 1 ? 1 : fib_memo2($n-2) + fib_memo2($n-1);
}
 
sub fib_no_recv {
   my $n = shift;
   return 1 if $n <= 1;
   my ( $fib, $prev ) = (1,1);
   ( $fib, $prev ) = ( $fib+$prev, $fib ) for 2..$n;
   $fib;
}
 
my $arg = 50;
cmpthese timethese 0, {
   fib_ret2    => sub { fib_ret2($arg) },
   fib_memo    => sub { @memo=();fib_memo2($arg) },
   fib_no_recv => sub { fib_no_recv($arg) },
};
fib_memo:  3 wallclock secs ( 3.22 usr +  0.02 sys =  3.23 CPU) @ 12827.77/s (n=41485)
fib_no_recv:  3 wallclock secs ( 3.14 usr +  0.02 sys =  3.16 CPU) @ 34344.42/s (n=108391)
fib_ret2:  4 wallclock secs ( 3.30 usr +  0.00 sys =  3.30 CPU) @ 17243.33/s (n=56834)
               Rate    fib_memo    fib_ret2 fib_no_recv
fib_memo    12828/s          --        -26%        -63%
fib_ret2    17243/s         34%          --        -50%
fib_no_recv 34344/s        168%         99%          --

確かに一回だけの計算だったら、二つ返すほうがメモ化よりも速いことが分かる。

理由を考えてみると、値を二つ返すパターンだと、単に実行コンテキストをスタックに詰んでいって戻ってくるのが一本道だと言うことが分かる。

メモ化のパターンだと関数内で関数が2回呼ばれるので、その分関数の呼び出し回数が指数的に増えていってしまうので、そこがネックになるのでしょう。

なるほど。考えた人すごい。

おまけ

無名関数の再帰が出来なくてスマートに記述できなかったのが悔しかったので、Sub::Recursiveを使って書き直してみた。Sub::Recursiveを使ったのは、「Perlで無名関数再帰のベンチ」で一番速いって書いてあったし、そこにあったベンチマークスクリプトを走らせても圧倒的にSub::Recursiveが速かったので。

#!/usr/bin/perl
use strict;
use warnings;
use feature qw/state/;
use Benchmark qw/timethese cmpthese/;
use Sub::Recursive qw/$REC recursive/;
 
sub _fib_ret2 {
   my $n = shift;
   if ( $n == 1 ){
       (1,1);
   }
   else {
       my ( $aa, $bb ) = _fib_ret2($n-1);
       ($aa+$bb, $aa);
   }
}
sub fib_ret2 {
   (_fib_ret2(shift))[0];
}
 
sub fib_ret2_lambda{
   ((recursive {
       my $n = shift;
       if ( $n == 1 ){
           (1,1);
       }
       else {
           my ( $aa, $bb ) = $REC->($n-1);
           ($aa+$bb, $aa);
       }
   })->(shift))[0];
}
 
my @memo;
sub fib_memo2 {
   my $n = shift;
   $memo[$n] ||= $n <= 1 ? 1 : fib_memo2($n-2) + fib_memo2($n-1);
}
 
sub fib_memo_lambda {
   recursive {
       state @cache;
       my $n = shift;
       $cache[$n] ||= $n <= 1 ? 1 : $REC->($n-2) + $REC->($n-1);
   };
}
 
my $fib_arg = 50;
cmpthese timethese 0, {
   fib_ret2        => sub { fib_ret2($fib_arg) },
   fib_ret2_lambda => sub { fib_ret2_lambda($fib_arg) },
   fib_memo        => sub { @memo=();fib_memo2($fib_arg) },
   fib_memo_lambda => sub { fib_memo_lambda()->($fib_arg) },
};
fib_memo:  4 wallclock secs ( 3.17 usr +  0.00 sys =  3.17 CPU) @ 13341.11/s (n=42318)
fib_memo_lambda:  3 wallclock secs ( 3.20 usr +  0.00 sys =  3.20 CPU) @ 6907.90/s (n=22126)
fib_ret2:  3 wallclock secs ( 3.22 usr +  0.00 sys =  3.22 CPU) @ 16680.96/s (n=53696)
fib_ret2_lambda:  3 wallclock secs ( 3.25 usr +  0.00 sys =  3.25 CPU) @ 15201.23/s (n=49404)
                   Rate fib_memo_lambda     fib_memo fib_ret2_lambda    fib_ret2
fib_memo_lambda  6908/s              --         -48%            -55%        -59%
fib_memo        13341/s             93%           --            -12%        -20%
fib_ret2_lambda 15201/s            120%          14%              --         -9%
fib_ret2        16681/s            141%          25%             10%          --

まあ、やっぱ余計なことしないほうが速いに決まってますよね。

投稿者 Songmu : 2010年9月20日 23:07