原创力文档- 1、原创力文档（book118）网站文档一经付费（服务费），不意味着购买了该文档的版权，仅供个人/单位学习、研究之用，不得用于商业用途，未经授权，严禁复制、发行、汇编、翻译或者网络传播等，侵权必究。。
- 2、本站所有内容均由合作方或网友上传，本站不对文档的完整性、权威性及其观点立场正确性做任何保证或承诺！文档内容仅供研究参考，付费前请自行鉴别。如您付费，意味着您自己接受本站规则且自行承担风险，本站不退款、不进行额外附加服务；查看《如何避免下载的几个坑》。如果您已付费下载过本站文档，您可以点击 这里二次下载。
- 3、如文档侵犯商业秘密、侵犯著作权、侵犯人身权等，请点击“版权申诉”（推荐），也可以打举报电话：400-050-0827(电话支持时间：9:00-18:30)。
- 4、该文档为VIP文档，如果想要下载，成为VIP会员后，下载免费。
- 5、成为VIP后，下载本文档将扣除1次下载权益。下载后，不支持退款、换文档。如有疑问请联系我们。
- 6、成为VIP后，您将拥有八大权益，权益包括：VIP文档下载权益、阅读免打扰、文档格式转换、高级专利检索、专属身份标志、高级客服、多端互通、版权登记。
- 7、VIP文档为合作方或网友上传，每下载1次， 网站将根据用户上传文档的质量评分、类型等，对文档贡献者给予高额补贴、流量扶持。如果你也想贡献VIP文档。上传文档
查看更多
trie树的perl优化方案
从《Effective Perl》上学习到一个module：Regexp::Trie。它属于正则优化类的module，具体说来，就是提取出备选项文本的公共部分，构造“检索树”，以便最大程度上减少回溯，提升效率。
试用了一下。对于简单的例子，它的效果很惊艳；对于复杂的例子，这个优化器的“机器人”的性格就显示出来了，感觉不如手工写得更高效，更有针对性。见例子：
#!/usr/bin/perl
#author: rex
#blog:
#filename a.pl
#created: 2010-08-01
use Regexp::Trie;
my @simple=qw/foobar foobah fooxar foozap fooza/;
my @complex=qw/AuthenticViagra BestDealsOnViagra BestMaleTablets GenuineOnlineViagra GreatViagraShop OriginalViagra TopViagraShop VIAGRA ViagraBestOnlineShop ViagraBrandReseller ViagraPills onlineshop/;
#the simple one
my $t_s=Regexp::Trie-new;
foreach (@simple){
$t_s-add($_);
}
#the complex one
my $t_c=Regexp::Trie-new;
foreach (@complex){
$t_c-add($_);
}
print simple regex trie: , $t_s-regexp, \n;
print complex regex trie: , $t_c-regexp, \n;
输出结果
simple regex trie: (?-xism:foo(?:ba[hr]|xar|zap?))
complex regex trie:
(?-xism:(?:AuthenticViagra|Best(?:DealsOnViagra|MaleTablets)|G(?:enuineOnlineViagra|reatViagraShop)|OriginalViagra|TopViagraShop|V(?:IAGRA|iagra(?:B(?:estOnlineShop|randReseller)|Pills))|onlineshop))
对于第2个例子，可以看出来，Trie是基于单个字符来优化的，而不是基于单词。虽然如此，它还是会极大地减少程序员的手工劳动。毕竟，未经优化的多选结构的效率之差不言而喻的，只要经过Trie的优化，其效率就会有质的飞跃；而手工的调教，只是在该飞跃的基础上再有一点点提升而已。对正则表达式比较头痛的程序员，更是可以无视自己的优化，直接使用该module而已。、
Perl 5.10 之后的版本，已经内置了类似于Trie的优化机制，因此没有手动优化的必要了。不过，我还是好奇于它的实现：
package Regexp::Trie;
use 5.008001;
use strict;
use warnings;
our $VERSION = sprintf %d.%02d, q$Revision: 0.2 $ =~ /(\d+)/g;
# use overload q() = sub { shift-regexp };
sub new{ bless {} = shift }
sub add{
my $self = shift;
my $str = shift;
my $ref = $self;
for my $char (split //, $str){
$ref-{$char} ||= {};
$ref = $ref-{$char};
}
$ref-{} = 1; # { = 1 } as terminator
$self;
}
sub _regexp{
my $self = shift;
return if $self-{} and scalar keys %$self == 1; # terminator
my (@alt, @cc);
my $q = 0;
for my $char (sort keys %$self){
my $qchar = quotemeta $char;
if (ref $self-{$char}){
文档评论（0）