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;
}

如果您运行的 Perl 版本早于 5.10.0 或 5.8.9，则应考虑使用 Regexp::Trie或Regexp::Assemble构建正则表达式，但在当前的 perls 上，正则表达式编译器会自动优化任何像这样的大的替换列表，所以我省略了不必要的复杂化。