Perl Regex - 查找/替换的冷凝组

Question

我正在使用Perl执行一些文件清理,并遇到一些性能问题.我的代码的一个主要部分涉及标准化名称字段.我有几个部分看起来像这样:

sub substitute_titles
{
    my ($inStr) = @_;
    ${$inStr} =~ s/ PHD./ PHD /;
    ${$inStr} =~ s/ P H D / PHD   /;
    ${$inStr} =~ s/ PROF./ PROF /;
    ${$inStr} =~ s/ P R O F / PROF    /;
    ${$inStr} =~ s/ DR./ DR /;
    ${$inStr} =~ s/ D.R./ DR  /;
    ${$inStr} =~ s/ HON./ HON /;
    ${$inStr} =~ s/ H O N / HON   /;
    ${$inStr} =~ s/ MR./ MR /;
    ${$inStr} =~ s/ MRS./ MRS /;
    ${$inStr} =~ s/ M R S / MRS   /;
    ${$inStr} =~ s/ MS./ MS /;
    ${$inStr} =~ s/ MISS./ MISS /;
}

我通过引用来尝试并获得至少一点速度,但我担心在数万个(最终可能是数十万个)记录中运行这么多(几百个)特定的字符串替换会损害性能.

有没有比我目前正在做的更好的方法来实现这种逻辑？

谢谢

编辑:快速注释,并非所有替换功能都只是删除句点和空格.有字符串删除,soundex组等.

Answer 1

如果所有搜索项都是固定字符串,这里的技术应该可以正常工作:

my %title_replacements = (
  ' PHD.' => ' PHD ',
  ' P H D ' => ' PHD  ',
  # ...,
);

my $titles_to_replace = join '|',
  map quotemeta, 
  keys %title_replacements;

$titles_to_replace = qr/$titles_to_replace/;

sub substitute_titles {
  my ($in) = @_;
  $$in =~ s/($titles_to_replace)/$title_replacements{$1}/g;
}

如果你运行的是早于5.10.0或5.8.9的perl,你应该考虑使用Regexp :: Trie或Regexp :: Assemble来构建正则表达式,但是在当前的perls上,正则表达式编译器会自动优化任何大的像这样的变化列表,所以我省去了不必要的复杂性.

Answer 2

而不是单独运行每个替换,创建一个闭包,可以更有效地为您完成工作:

sub make_translator {
    my %table = @_;
    my $regex = join '|' => map {quotemeta} keys %table;
    $regex = qr/$regex/;

    return sub {s/($regex)/$table{$1}/g}
}

my $translator = make_translator
    ' PHD.'   => ' PHD ',
    ' P H D ' => ' PHD   ',
    ' PROF.'  => ' PROF ';   # ... the rest of the pairs

my @list_of_strings = qw/.../;

$translator->() for @list_of_strings;

最快的是不传递任何东西并使用$_别名来表示数组值(for循环为你做的).