use Benchmark; [was: Re: [Cologne-pm] Regexps nehmen fuer file parsing?]

[Michael Lamertz]

On Wed, Apr 02, 2003 at 11:38:58PM +0200, johannes huettemeister wrote:
> Hi,
> bis jetzt haette ich fuer solche Sachen immer regexp's genommen, aber als
> ich was ueber lexer gelesen hab, frag ich mich, ob ich damit was anfangen
> koennte:
> ich hab ne menge files mit ner menge zeilen wie:
> <id=00001/ab=1/cd=xy/de=20021231(GM)/ef=20030331(GM)/fg=0/gh=/var/log(log)/.
> ..>
> Da ich immer mehrere Kriterien ueberpruefe, bevor ich den Eintrag verarbeite
> (counte),  mach ich sowas wie
> if (($_ =~ m/ab=1/) && ($_ =~ m/de=20021231/)) {
>     $hits{sylvester}++;
> }
> aber das geht doch irgendwie besser, oder?

Nicht wesentlich.

Falls die Reihenfolge der einzelnen Patterns immer dieselbe ist, koennte
man die 2 Tests zu einem zusammenfassen, aber Benchmark hat gezeigt,
dass das - unerwarteterweise - tatsaechlich ein Wenig langsamer ist.

Ist die Reihenfolge wechselnd, so kann man 

    a. alle Muster zu einer fetten Rx zusammenkleben
    b. die Muster nacheinander durchtesten.

Beide Methoden sind langsamer als Deine urspruenglichen Tests, haben
aber natuerlich den Vorteil, dass Du zur Laufzeit bestimmen kanst
wieviele Ausdruecke Du testest.  Im Vergleich ist die einzelne grosse Rx
und die Grep-Methode in etwa gleich schnell.

Die Methode von Aristoteles, die gesamte Zeile in ein Hash zu zerlegen
finde ich in der Anwendung extrem elegant, aber leider ist die im
Vergleich zu allen anderen Methoden grottenlangsam :(  Schade, denn die
Tests werden dadurch schoen deutlich.

Ich habe mir die Freiheit genommen in den Testdaten die '/' im Feld gh
durch '_' zu ersetzen, da sonst das Split aus dem Hash-Verfahren Fehler
wirft.  Hier habe ich auch den Teststring 'de' um '(GM)' erweitert, da
ein Match hier greift, ein 'eq' aber nicht.

Alles in ALlem sind die Benchmark-Ergebnisse so ziemlich was ich
erwartet haette, mit ausnahme von double_rx vs. single_rx.

Mike

-- 
	    Well, then let's give that Java-Wussie a beating... (me)

Michael Lamertz                        |     +49 2234 204947 / +49 171 6900 310
Sandstr. 122                           |                       mike at lamertz.net
50226 Frechen                          |                 http://www.lamertz.net
Germany                                |               http://www.perl-ronin.de 
-------------- next part --------------
#!/usr/bin/perl

use strict;
use warnings;

use Benchmark qw(:all);

use constant LOGFILE => 'logfile.txt';
use constant LOGSIZE => 25_000;

# Avoid warnings for this one...
our %hits;

# Match on these...
our @clauses = qw{
    ab=1
    de=20021231
};

# Used with the array grep method
our @arr_rx = map { qr{\Q$_} } @clauses;

# Used by the compiled rx method
our $compiled_rx = rx_compile(@clauses);


create_testdata() unless -f LOGFILE;
cmpthese(25, {
    double_rx	=> sub { apply_lines(\&double_rx) },
    single_rx	=> sub { apply_lines(\&single_rx) },
    splitted	=> sub { apply_lines(\&splitted) },
    compiled	=> sub { apply_lines(\&compiled) },
    array	=> sub { apply_lines(\&array) },
});


sub apply_lines {
    my $fkt = shift;

    $hits{sylvester} = 0;
    open F, LOGFILE or die "Cannot open test data: $!\n";
    $fkt->($_) while (<F>);
    close F;
#    print STDERR "SYLVESTER: $hits{sylvester}\n";
}

# The initially proposed method
sub double_rx {
    local $_ = shift;
    $hits{sylvester}++ if /ab=1/ && /de=20021231/
}

# An alternatively joined rx.  This will fail on the generated test data, due
# to the order of the fields.
sub single_rx {
    local $_ = shift;
    $hits{sylvester}++ if /ab=1.*?de=20021231/;
}

# Aristoteles' split-into-hash Method
sub splitted {
    local $_ = shift;
    return unless /<(.*)>/;
    my %record = map split(/=/, $_, 2), split m!/!, $1;
    $hits{sylvester}++ if $record{ab} == 1 and $record{de} eq '20021231(GM)';
}

# A fat compiled regexp.  This is independand of the order of the fields
sub compiled {
    local $_ = shift;
    $hits{sylvester}++ if /$compiled_rx/;
}

sub rx_compile {
    my $rx = join '|', rx_shuffle(@_);
    return qr/$rx/;
}

sub rx_shuffle {
    my (@fields) = @_;
    return ( @fields ) if @fields == 1;
    my @res = ();
    foreach my $front (0 .. $#fields) {
	my @next = @fields;
	splice @next, $front, 1;
	push @res, map { $fields[$front] . '.*?' . $_ } rx_shuffle(@next);
    }
    return @res;
}

# Simply match on a list of patterns
sub array {
    local $_ = shift;
    my $line = $_;
    $hits{sylvester}++ if grep { $line =~ /$_/ } @arr_rx;
}

# Create something to work on...
sub create_testdata {
    print STDERR "Creating test data...\n";
    open O, ">" . LOGFILE or die "Cannot create logfile.txt: $!\n";
    print O '<' . join('/', shuffle(qw{id=00001 ab=1 cd=xy de=20021231(GM) ef=20030331(GM) fg=0 gh=_var_log(log)})) . "/>\n"
	foreach (0 .. LOGSIZE);
    close O;

}

sub shuffle {
    my @fields = @_;
    foreach (0 .. rand(10)) {
	my ($a, $b) = (rand(@fields), rand(@fields));
	my $t = $fields[$a];
	$fields[$a] = $fields[$b];
	$fields[$b] = $t;
    }
    return @fields;
}
-------------- next part --------------
nijushiho:~/x$ ./bench 
Creating test data...
Benchmark: timing 25 iterations of array, compiled, double_rx, single_rx, splitted...
     array: 14 wallclock secs (13.42 usr +  0.17 sys = 13.59 CPU) @  1.84/s (n=25)
  compiled: 14 wallclock secs (13.69 usr +  0.16 sys = 13.85 CPU) @  1.81/s (n=25)
 double_rx:  8 wallclock secs ( 7.63 usr +  0.14 sys =  7.77 CPU) @  3.22/s (n=25)
 single_rx:  8 wallclock secs ( 8.44 usr +  0.14 sys =  8.58 CPU) @  2.91/s (n=25)
  splitted: 52 wallclock secs (51.40 usr +  0.21 sys = 51.61 CPU) @  0.48/s (n=25)
             Rate  splitted  compiled     array single_rx double_rx
splitted  0.484/s        --      -73%      -74%      -83%      -85%
compiled   1.81/s      273%        --       -2%      -38%      -44%
array      1.84/s      280%        2%        --      -37%      -43%
single_rx  2.91/s      502%       61%       58%        --       -9%
double_rx  3.22/s      564%       78%       75%       10%        --
nijushiho:~/x$