WEB+DB PRESS vol. 42の岡野原さんの記事を読んでいたら、昔放置した奴思い出して、ついムラムラと作りました。
Txじゃないのは、Txはまだちょっとインターフェイスが少なかったから。でも余裕があればText::Tx
とかも作ってみたいところ。
Darts #0.31以降をインストールしてから、普通にmakeしてください。
SYNOPSISuse Text::Darts; my $td = Text::Darts->new(qw/ALGOL ANSI ARCO ARPA ARPANET ASCII/); my $newstr = $td->gsub("ARPANET is a net by ARPA", sub{ "<<$_[0]>>" }); # $newstr is now "<<ARPANET>> is a net by <<ARPA>>". # or my $td = Text::Darts->open("words.darts"); my $newstr = $td->gsub($str, sub{ qq(<a href="http://dictionary.com/browse/$_[0]">$_[0]</a>) }); # link'em all!
見てのとおり、単語のリストを与えてその場でdartsも作れますし、mkdarts
したdartsファイルを読み込むことも出来ます。あとは見てのとおりです。
きまぐれ日記: はてなキーワードを高速に付与 (SWIG を使って Perl モジュール)にあるように、はてなキーワードリンクのSWIGバージョンはKudohさんご本人が作ってらっしゃっているのですが、こちらの方が使い勝手がいいと思います。
普通にRegexpした場合と比較したBenchmarkも取ってみました。Benchmarkスクリプト自身に含まれる単語を全て見つけて置換しています。
Perl-5.8.8;FreeBSD 6-Stable; Dual Xeon 2.8GHzBenchmark: running Darts, Naive, R::A for at least 3 CPU seconds... Darts: 4 wallclock secs ( 3.45 usr + 0.09 sys = 3.54 CPU) @ 1546.45/s (n=5473) Naive: 3 wallclock secs ( 3.02 usr + 0.00 sys = 3.02 CPU) @ 555.77/s (n=1676) R::A: 3 wallclock secs ( 3.34 usr + 0.00 sys = 3.34 CPU) @ 387.59/s (n=1296) Rate R::A Naive Darts R::A 388/s -- -30% -75% Naive 556/s 43% -- -64% Darts 1546/s 299% 178% --Perl-5.10.0;Mac OS X v10.4.11; Core 2 Duo 2.33GHz
Benchmark: running Darts, Naive, R::A for at least 3 CPU seconds... Darts: 3 wallclock secs ( 3.14 usr + 0.08 sys = 3.22 CPU) @ 1118.63/s (n=3602) Naive: 3 wallclock secs ( 3.06 usr + 0.02 sys = 3.08 CPU) @ 843.83/s (n=2599) R::A: 3 wallclock secs ( 3.23 usr + 0.01 sys = 3.24 CPU) @ 538.89/s (n=1746) Rate R::A Naive Darts R::A 539/s -- -36% -52% Naive 844/s 57% -- -25% Darts 1119/s 108% 33% --
あらためてKudohさんに感謝しつつ、Enjoy!
Dan the Perl Monger
#!/usr/local/bin/perl use strict; use warnings; use Text::Darts; use Regexp::Assemble; use Benchmark qw/cmpthese timethese/; my $str = do { open my $fh, __FILE__; local $/; my $s = <$fh>; close $fh; $s }; my @words = do { my %h; $h{$_}++ for split /\W+/, $str; keys %h }; my $td = Text::Darts->new(@words); my $ra = Regexp::Assemble->new; $ra->add($_) for @words; my $re_ra = $ra->re; my $re_nv = do{ my $str = join '|', @words; qr/(?:$str)/ }; cmpthese( timethese( 0, { Darts => sub { $td->gsub( $str, sub { "<$_[0]>" } ); }, 'R::A' => sub { my $tmp = $str; $tmp =~ s{ ($re_ra) }{ "<$1>" }msgex; }, 'Naive' => sub { my $tmp = $str; $tmp =~ s{ ($re_nv) }{ "<$1>" }msgex; }, } ) );
このブログにコメントするにはログインが必要です。
さんログアウト
この記事には許可ユーザしかコメントができません。