Wörter zählen in Textdaten (Perl 5.8) - #141778 (Allgemeines zu Perl)

clms

2010-10-08 00:42

User since
2010-08-29
373 Artikel
BenutzerIn
[default_avatar]

Noch ein paar Ideen zur Optimierung:

1. ^, \b und $ sind eh zero-width. Deshalb kann man das look-ahead und look-behind in den Regex weglassen und einfach (^|\b) bzw. (\b|$) schreiben.

2. Statt die ganzen Matches case-insensitive durchzuführen (wo die Matching-Unit dann immer alle Varianten berücksichtigen muss), würde ich String und Suchbegriffe jeweils einmal nach lower case (oder wahlweise upper case) transformieren.

3. Optimierung der Matches.
Bei der Variante von wer mit der festen Regex würde ich beim Match die Option 'o' angeben, um sicher zu gehen, dass die Regex nur einmal compiliert wird (obwohl das qr() wahrscheinlich reicht).

Bei der ursprünglichen Variante von GwenDrangon könnte man die tausenden Regex mittels qr() vorcomplieren. Außerdem wäre $line ein heißer Kandidat für study. Der Code-Abschnitt würde dann so aussehen:

Code (perl): (dl )

my %words;
my @blacklist_entries = qw(insurance Sxx porn buy viagra ZENIC 
                           Möbelkauf Bußgeld Führerschein);

my %rx_tab = map {$_ => qr:(^|\b)\Q$_\E(\b|$):} map {lc} @blacklist_entries;

while (my $line = lc <DATA>) {
  study $line;
  foreach my $k (keys %rx_tab) {
    $words{$k}++ while ($line =~ /$rx_tab{$k}/g);
  }
}

while (my ($key, $value) = each %words) {
  print "$key=$value\n";
}

Wenn man auf die Option verzichtet, Wortkombinationen wie "cheap pills" oder "Sp@m" in die Blacklist einzutragen und auch in Zukunft dort nur Wörter hat, die auf /\b\w+\b/ matchen, kann man auf die häufigen Matches ganz verzichten, indem man die Zeile in einzelne Wörter zerlegt, die man in über ein Hash filtert:

Code (perl): (dl )

# settings damit Umlaute den Wörtern zugeschlagen werden
use locale;
use POSIX qw(locale_h);
setlocale(LC_CTYPE, "de_DE.ISO8859-1");

my %words;
my @blacklist_entries = qw(insurance Sxx porn buy viagra 
                           ZENIC Möbelkauf Bußgeld Führerschein);

my %lookup = map {lc($_) => 1} @blacklist_entries;

while (my $line = lc <DATA>) {
  $words{$_}++ foreach grep {$lookup{$_}} split(/\W+/,$line);
}

while (my ($key, $value) = each %words) {
  print "$key=$value\n";
}