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

[thread]15515[/thread]

Wörter zählen in Textdaten (Perl 5.8)

Leser: 30

Articles: hide open all | hide show old branches

+6 replies

GwenDragon

2010-10-07 12:25

User since
2005-01-17
14555 Artikel
Admin1

Ich will Textdateien einlesen und die Worthäufigkeit ermitteln (zwecks einfachem Spamfilter).

Mein Testschnippsel:

Code (perl): (dl )

#/usr/bin/perl -w

use strict;
use warnings;

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

sub checkSpam {
        my $line = shift;
        foreach my $spam_word (@blacklist_entries) {
                while ($line =~ 
                        /(?<=^|\b)\Q$spam_word\E(?=\b|$)/ig # Wort beginnt mit Zeilenanfang und/oder wird mit Wortbegrenzer getrennt
                      ) 
                { 
                        $words{$spam_word}++;
                }
        }
}

while (my $line = <DATA>) {
        checkSpam($line);
}

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

__DATA__
Das ist ein VIAGRA Text für Viagra.
ViaGrA or Zenic BuY thS!

$VIAGRA! 
************ Möbelkauf ganz billig.
$VIAGRA
$VIAGRA:
schnellstmöglich Bußgeld Führerschein neu!
pOr N.

    POrn---------.
 :sxx: download

porN.

vIaGrH.

Ist das Regex so sinnvoll?
Übersehe ich gerade eine Falle bei bestimmten Wörtern?
Gibt es eine schnellere Lösung?

//EDIT:
Die Wortlisten kommen später aus Textdateien oder einer Datenbank.
Die Textdaten kommen aus großen Textdateien, Datenbanken oder auch CGI-Daten.
Last edited: 2010-10-07 13:21:50 +0200 (CEST)

die Drachin, Gwendolyn

Unterschiedliche Perl-Versionen auf Windows (fast wie perlbrew) • Meine Perl-Artikel

bianca

2010-10-07 12:35

User since
2009-09-13
6978 Artikel
BenutzerIn

Kann leider auf die Frage nicht antworten, hatte mich daran selbst mal vergeblich versucht. Das lag aber an der Logik, nicht am Code.

An der Endlösung wäre ich interessiert. Wäre nett von Dir, wenn Du die posten würdest, wenn sie fertig ist.
10 print "Hallo"
20 goto 10
+4 replies
Gast wer

2010-10-07 12:57
Ich glaube so wäre es schneller:
Code (perl): (dl )

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37

#/usr/bin/perl -w use strict; use warnings; use utf8; my %words; my @blacklist_entries = qw( insurance Sxx porn buy viagra ZENIC Möbelkauf Bußgeld Führerschein); my $regexp=join('|',map{qr/\Q$_\E/i}@blacklist_entries); $regexp=qr/(?<=^|\b)($regexp)(?=\b|$)/; while (my $line = <DATA>) { $words{lc($1)}++ while ($line =~/$regexp/gi); } while (my ($key, $value) = each %words) { print "$key=$value\n"; } __DATA__ Das ist ein VIAGRA Text für Viagra. ViaGrA or Zenic BuY thS! $VIAGRA! ************ Möbelkauf ganz billig. $VIAGRA $VIAGRA: schnellstmöglich Bußgeld Führerschein neu! pOr N. POrn---------. :sxx: download porN. vIaGrH.
Last edited: 2010-10-07 13:02:04 +0200 (CEST)
- +2 replies
- GwenDragon
  
  2010-10-07 13:20
  
  User since
  2005-01-17
  14555 Artikel
  Admin1
  
  Eine Lösung mit Regex kann auch langsam werden.
  Wenn ich einige Hundert oder gar Tausend Spamwörter habe, die aus einer Datenbak oder Textdatei kommen, wird nach deiner Lösung das Regex zu einem Bandwurm.
  Das Regex aus der kompletten Wortliste (@blacklist_entries) mittels join und | (regex alternate op) aufzubauen, ist nur bei kleinen Wortlisten sinnvoll, denke ich.
  Oder täusche ich mich?
  
  Müsste ich in jedem Fall mal testen.
  Last edited: 2010-10-07 13:23:16 +0200 (CEST)
  die Drachin, Gwendolyn
  
  Unterschiedliche Perl-Versionen auf Windows (fast wie perlbrew) • Meine Perl-Artikel
  - pktm
    
    2010-10-07 17:00
    
    User since
    2003-08-07
    2921 Artikel
    BenutzerIn
    
    Kannst du die denn nicht vorkompilieren oder so?
    Einmal bauen und dann immer wieder verwenden.
    Wenn dahinter ein endlicher Automat steckt, dann ist der Schnitt doch von linearer Komplexität.
    http://www.intergastro-service.de (mein erstes CMS :) )
- clms
  
  2010-10-08 00:42
  User since
  2010-08-29
  373 Artikel
  BenutzerIn
  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 )
  
  1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16
  
  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 )
  
  1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18
  
  # 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"; }

View all threads created 2010-10-07 12:25.