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

Вместо того, чтобы запускать каждую замену отдельно, создайте замыкание, которое может выполнить работу за вас более эффективным способом:

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 2

Вот методика, которая должна работать очень хорошо, если все элементы поиска являются фиксированными строками:

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 компилятор регулярных выражений автоматически оптимизирует время обработки любого большого списка подобных изменений, поэтому я исключил ненужные сложности.

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

Затем вы получите хеш в сочетании с закрытием, как указано в некоторых других ответах здесь У меня еще не было времени протестировать мой код, но он должен работать.