Perl Regex - Groupes condensants de recherche/remplacement

Question

J'utilise Perl pour effectuer un nettoyage de fichiers et je rencontre des problèmes de performance. L'une des parties principales de mon code implique 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 courir tant de (littéralement des centaines) de chaîne spécifique remplace des dizaines de des milliers (probablement des centaines de milliers) de disques vont nuire à la performance.

Existe-t-il une meilleure façon de mettre en œuvre ce genre de logique que ce que je fais actuellement?

Merci

Modifier: note rapide, toutes les fonctions sont remplacer simplement la suppression des délais et des espaces. Il y a des suppressions de chaîne, des groupes soundex, etc.

Answer 1

est ici une technique qui devrait fonctionner assez bien si tous vos articles 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 de 5,10 .0 ou 5.8.9, vous devriez utiliser Regexp::Trie ou Regexp::Assemble pour construire la regex, mais sur les perls actuels, le compilateur regex optimisera automatiquement toute grande liste d'alternatives comme ça, donc j'ai omis la complication inutile.

Answer 2

Plutôt que de courir chaque substitution séparément, créez une fermeture qui peut faire le travail pour vous d'une 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 le plus rapide de passer rien et utiliser $_ aliasé à la valeur du tableau (que la boucle for fait pour vous).

Answer 3

Je ferais très probablement un sous qui a créé mes modèles pour moi. De cette façon, tout ce que je devrais faire est 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); 

Puis vous obtenez 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 cela devrait fonctionner.