|
|
Zajímavě hloupý konečný automat
|
3.11.2005 10:57
Hynek (Pichi) Vychodil
|
Řetězec "Perl" je totiž v 1. případě hledán pouze jednou.
Tahle věta mě hodně zarazila. Říkal jsem si, že ta implementace regulárních výrazů nemůže být tak hloupá, aby to v tom druhém případě dělalo fakt dvakrát. Jistě tomu tak není, ale skutečně je v tom nějaký zádrhel a konečný automat vygenerovaný v druhém případě opravdu je složiťejší a pomalejší než v prvním případě. Na delších řeťězcích roste délka prohledávání na deseti a více násobky. Viz jednoduchý test:#!/usr/bin/env perl
use strict;
use warnings;
use Benchmark qw(:all :hireswallclock); my $r = 100; # string parts repeat
my $i = 1000; # grep repeats
my $l = -2; # test for 2 seconds my $str = 'euiwghiweuh'x$r . 'Perl5' . 'wehjdiuh'x$r . 'Perl6' . 'weiuhiwhjh'x$r; # make string my %regexps = ( # tested regexps
first => qr/Perl(5|6)/o,
second => qr/Perl5|Perl6/o,
first_nomatch => qr/Perl(?:5|6)/o,
); sub makeRegexpTests (\%) { # make hash of tests from regexps
map { # make pairs 'regexp_name' => sub { regexp testing }
my $re = $regexps{$_}; # store regexp in local variable
$_, # regexp name ( return ('regexp_name', testing function) )
sub { # testing function
for (my $c = 0; $c < $i; $c++) {
$str =~ m/$re/g; # here can't use $regexps{$_} because value wasn't finded in compile time
};
}
} keys %{$_[0]}
} cmpthese(
$l, # how long/repeats tests
{ makeRegexpTests %regexps }, # tests
);
P.S.: Mimochodem, proč se uvnitř tagu <pre> strácejí prázdné řádky? BTW proč se mi při opakované editaci objeví < převedené na <? |
|
|
Re: Zajímavě hloupý konečný automat
|
3.11.2005 13:45
Hynek (Pichi) Vychodil
|
Tady je verze pro zkoumani vlivu délky řetězce. Omlouvám se za trošku cryptic způsob zápisu, ale mě to přijde krásně čitelné a už snad ani jinak psát neumím :-)
#!/usr/bin/env perl
use strict;
use warnings;
use Benchmark qw(:all :hireswallclock); my $l = -2; # test for 2 seconds
my @testParams = (
{r=>1, i=>100000}, # r=>string parts repeats, i=>grep repeats
{r=>10, i=>10000},
{r=>100, i=>1000},
);
my %regexps = ( # tested regexps
first => qr/Perl(5|6)/,
second => qr/Perl5|Perl6/,
first_nomatch => qr/Perl(?:5|6)/,
);
sub testString ($) { # make testing string
my ($r) = @_;
'euiwghiweuh'x$r . 'Perl5' . 'wehjdiuh'x$r . 'Perl6' . 'weiuhiwhjh'x$r
} sub makeRegexpTest ($$$) { # make test function
my ($str, $re, $i) = @_; # localize parameters for use in testing function
sub { # testing function (here $str, $re, $i like constants - see perlsub(1))
for (my $c = 0; $c < $i; $c++) {
$str =~ m/$re/g;
};
}
} foreach ( @testParams ) {
my ($r, $i) = @$_{qw(r i)};
print "r: $r, i: $i$/";
cmpthese(
$l, # how long/repeats tests
{ map +($_, makeRegexpTest testString $r, $regexps{$_}, $i), keys %regexps }, # tests
);
} |
|
|
|
|
KOMENTARZE
|
Tylko zarejestrowani użytkownicy mogą dopisywać komentarze.
|
|
Szukanie oprogramowania
|
©Pavel Kysilka - 2003-2024 |
maillinuxsoft.cz | Design:
www.megadesign.cz
|