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循环为您执行此操作）。

Answer 3

我很可能会制作一个为我创建模式的子模型。这样我所要做的就是传递一个我想要标准化的标题数组。例如：

sub make_pattern {
    my $list_ref = shift;
    my %patterns;
    for my $title ( @{$list_ref} ) {
        my $result = uc $title;
        my $pattern = '/' . join( '\s*', (//, $title)) . '\.*/i';
        $patterns{$pattern} = $result;
    }
return \%patterns;
}

my @titles = qw (PHD MD DR PROF ) #... plus whatever other titles you have
my $conversion_hash = make_pattern(\@titles);

然后你得到的哈希与一个闭包一起在这里的一些其他答案中列出。我还没有时间测试我的代码，但它应该可以工作。

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

3 个答案: