Perl Regex - Condenser les groupes de recherche/remplacement

Question

J'utilise Perl pour effectuer un nettoyage de fichiers et je rencontre quelques problèmes de performance. L'une des principales parties de mon code concerne la normalisation des champs de nom. J'ai plusieurs sections qui ressemblent à ceci :

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

Je passe par référence pour essayer d'obtenir au moins un peu de vitesse, mais je crains que l'exécution d'un si grand nombre (littéralement des centaines) de remplacements de chaînes spécifiques sur des dizaines de milliers (probablement des centaines de milliers à terme) d'enregistrements ne nuise aux performances.

Existe-t-il une meilleure façon d'implémenter ce type de logique que ce que je fais actuellement ?

Merci

Edit : Note rapide, toutes les fonctions de remplacement ne suppriment pas seulement les points et les espaces. Il y a des suppressions de chaînes de caractères, des groupes soundex, etc.

Answer 1

Voici une technique qui devrait fonctionner assez bien si tous vos éléments de recherche sont des chaînes fixes :

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

Si vous utilisez un perl plus ancien que 5.10.0 ou 5.8.9, vous devriez envisager d'utiliser Regexp::Trie o Regexp::Assemble pour construire la regex, mais sur les perls actuels, le compilateur de regex optimisera automatiquement toute grande liste d'alternances comme celle-ci, donc j'ai laissé de côté cette complication inutile.

Answer 2

Plutôt que d'exécuter chaque substitution séparément, créez une fermeture qui peut faire le travail pour vous de manière plus efficace :

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;

Il est plus rapide de ne rien passer et d'utiliser $_ alias à la valeur du tableau (que la fonction for boucle le fait pour vous).

Answer 3

Je ferais très probablement un sous-marin qui créerait mes modèles pour moi. De cette façon, tout ce que j'aurais à faire serait de passer dans un tableau des titres que je veux normaliser. Exemple :

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

Ensuite, vous utilisez le hachage résultant en conjonction avec une fermeture comme indiqué dans certaines des autres réponses ici. Je n'ai pas encore eu le temps de tester mon code, mais il devrait fonctionner.