Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

Performance: perl vs. grep

0 views
Skip to first unread message

Jörg Sommer

unread,
Aug 27, 2002, 5:21:19 PM8/27/02
to
Hi,

ich wollte mir steak (ein Wörterbuchprogr.) in perl übersetzen, damit man
noch so einige Features aufnehmen kann. Leider musste ich feststellen,
dass ich mit perl die Datei 3-4 Sekunden durchsuche, mit grep aber nur
0.1 Sekunde brauche. Das ich die Zeiten von grep nie erreiche ist mir
klar, aber ich würde wenigstens gern in deren Nähe kommen.

Hier mal die relevanten Zeilen:
#v+
foreach my $f (@files) {
my ($file, $side) = @{$f};

open(DICT, "<", $file) || die "Could not open dictionary file \"$file\"";
line: while(<DICT>) {
next line if (/^#/ || /^$/);

my ($line, $start);
$start=0;
if ($side==0) { # left side
$line = substr($_, 0, index($_, "::"));
} else { # right side
$start=index($_, "::")+2;
$line = $_;
# $line = substr($_, index($_, "::"), -1);
}

if ($andor) { # and
foreach (@words) {
if ($ignore_case) {
next line if (index(lc($line), $_, $start) == -1);
# next line if ($line !~ /$_/i);
} else {
next line if (index($line, $_, $start) == -1);
}
}
} else { # or
my $match=0;

foreach(@words) {
if ($ignore_case) {
if ($line =~ /$_/i) {
$match=1;
last;
}
} else {
# if ($line =~ /$_/) {
if (index($line, $_) != -1) {
$match=1;
last;
}
}
}
next line if (! $match);
}

chop($_);
s/^ *//;
s/ *$//;
if ($side == 0) {
s/ *:: */ :== /;
} else {
s/(.*) *:: *(.*)/$2 :== $1/;
}

print $_."\n";
}
}
#v-

a) Wo kann ich noch alles schrauben?
b) substr() kopiert doch bestimmt die Strings. Das brauche ich aber
nicht. Einen Teil kann ich mit index() und der offset-Angabe lösen.
Jedoch kann ich index() nicht sagen, dass er nur in n-Buchstaben suchen
soll oder ist das möglich?

Jörg.

Janek Schleicher

unread,
Aug 27, 2002, 5:41:37 PM8/27/02
to
Jörg Sommer wrote at Tue, 27 Aug 2002 23:21:19 +0200:

> ich wollte mir steak (ein Wörterbuchprogr.) in perl übersetzen, damit man
> noch so einige Features aufnehmen kann. Leider musste ich feststellen,
> dass ich mit perl die Datei 3-4 Sekunden durchsuche, mit grep aber nur
> 0.1 Sekunde brauche. Das ich die Zeiten von grep nie erreiche ist mir
> klar, aber ich würde wenigstens gern in deren Nähe kommen.

Das wuerde ich bestreiten.
Gleichwertige Aufgaben erledigt Perl zumindestens nicht signifikant langsamer.
(Ich wuerde sogar behaupten, dass Perl schneller ist,
aber da kann ich mich irren)

Etwas anderes ist es, wenn eine grosse Programmlogik implementiert
werden soll.

>
> Hier mal die relevanten Zeilen:
>

> [snipped langen, zumindestens nicht intuitiven Quelltext]


>
> a) Wo kann ich noch alles schrauben?

Zuerst einmal an der Lesbarkeit.
Nimm es mir nicht uebel,
aber zumindestens auf den ersten Blick konnte ich nicht erkennen,
was Dein Script eigentlich tun soll.

Das beste waere, wenn Du das hier mal mit natuerlichen
deutschen/englischen Saetzen beschreibst.
Davon koennte man dann eine fast 1:1 Uebersetzung machen,
was dann der Ausgangspunkt fuer weitere Optimierungen sein koennte.

> b) substr() kopiert doch bestimmt die Strings.

Nein.
Schaue z.B. mal auf diesen Einzeiler:
perl -e '$_ = "abcd"; substr $_, 0, 1 = "A"; print $_'
substr gibt im Prinzip nur eine Referenz
auf den String zurueck mitsamt dem Start-Index und der Laenge.

> Das brauche ich aber
> nicht. Einen Teil kann ich mit index() und der offset-Angabe lösen.
> Jedoch kann ich index() nicht sagen, dass er nur in n-Buchstaben suchen
> soll oder ist das möglich?

substr und index-Methoden brauch man in Perl eigentlich sehr selten.
Regulaere Ausdruecke loesen das Problem meistens eleganter.


MfG Janek

Slaven Rezic

unread,
Aug 27, 2002, 6:41:14 PM8/27/02
to
Jörg Sommer <jo...@alea.gnuu.de> writes:

Ich sehe da einige foreach-Schleifen mit regex-Matches. Es wäre
bestimmt besser, wenn du stattdessen vor der while-Schleife aus allen
Wörtern _ein_ Pattern zusammenbaust (mit join und quotemeta).

Du solltest versuchen, die Option /o beim Matchen zu verwenden. Siehe
perldoc perlop.

Evtl. bringt es etwas, wenn du den gesamten Code in der
while-Schleife (einschließlich) zusammenbaust und per eval ausführst.
Bereits beim Zusammenbauen kannst du die $andor- und $side-Abfragen
durchführen.

Nicht elegant, aber vielleicht auch schnell: in der while-Schleife
zuerst auf die gesamte Zeile matchen und danach nachgucken, ob andor,
side usw. passen.

Wenn die Datei sortiert ist und auf der linken Seite gesucht wird,
dann kannst du evtl. Search::Dict verwenden.

> b) substr() kopiert doch bestimmt die Strings. Das brauche ich aber
> nicht. Einen Teil kann ich mit index() und der offset-Angabe lösen.
> Jedoch kann ich index() nicht sagen, dass er nur in n-Buchstaben suchen
> soll oder ist das möglich?

Gerade wurde bei bleedperl COW (copy on write) eingeführt. Ich weiß
nicht, ob es auch bei substr() greift, aber vielleicht ist es einen
Versuch wert?

Gruß,
Slaven

--
Slaven Rezic - slaven...@berlin.de

tktimex - project time manager
http://sourceforge.net/projects/ptktools/

Jörg Sommer

unread,
Aug 29, 2002, 6:11:02 AM8/29/02
to
Slaven Rezic schrieb :
> Jörg Sommer <jo...@alea.gnuu.de> writes:
>>
>> [Quelltext]

>>
>> a) Wo kann ich noch alles schrauben?
>
> Ich sehe da einige foreach-Schleifen mit regex-Matches. Es wäre
> bestimmt besser, wenn du stattdessen vor der while-Schleife aus allen
> Wörtern _ein_ Pattern zusammenbaust (mit join und quotemeta).

Das habe ich beherzigt.

> Evtl. bringt es etwas, wenn du den gesamten Code in der
> while-Schleife (einschließlich) zusammenbaust und per eval ausführst.
> Bereits beim Zusammenbauen kannst du die $andor- und $side-Abfragen
> durchführen.

Ich denke, so wie ich es jetzt habe, geht es auch oder?

> Nicht elegant, aber vielleicht auch schnell: in der while-Schleife
> zuerst auf die gesamte Zeile matchen und danach nachgucken, ob andor,
> side usw. passen.

Das würde ich nicht machen, da der Match in der linken Seite eventuell
anschlägt und ich dann in einem 2. Match erst feststelle, dass ich ihn
eigentlich in der rechten Seite wollte.

> Wenn die Datei sortiert ist und auf der linken Seite gesucht wird,
> dann kannst du evtl. Search::Dict verwenden.

Nein, das lässt sich nicht machen.

>> b) substr() kopiert doch bestimmt die Strings. Das brauche ich aber
>> nicht. Einen Teil kann ich mit index() und der offset-Angabe lösen.
>> Jedoch kann ich index() nicht sagen, dass er nur in n-Buchstaben suchen
>> soll oder ist das möglich?
>
> Gerade wurde bei bleedperl COW (copy on write) eingeführt. Ich weiß
> nicht, ob es auch bei substr() greift, aber vielleicht ist es einen
> Versuch wert?

Naja, ich will es ja eigentlich nicht. Aber ich habe ja jetzt die
Entscheidung der Seite anders gelöst.

Mein neuer Code:
#v+
my @regexp;
if ($andor) {
if ($ignore_case) {
@regexp = map(qr/$_/oi, map(quotemeta(), @words));
} else {
@regexp = map(qr/$_/o, map(quotemeta(), @words));
}
} else {
my $help = '('.join('|', map(quotemeta(), @words)).')';
if ($ignore_case) {
push(@regexp, qr/$help/oi);
} else {
push(@regexp, qr/($help)/o);
}
}
undef @words;

foreach my $f (@files) {
my ($file, $side) = @{$f};

if ($side==0) { # left side
$_ = qr/$_.*::/ foreach(@regexp);
} else { # right side
$_ = qr/::.*$_/ foreach(@regexp);
}

open(DICT, "<", $file) || die "Could not open dictionary file \"$file\"";
line: while(<DICT>) {
next line if (/^#/ || /^$/);

my $line = $_;
foreach (@regexp) {
next line if ($line !~ /$_/);
}

chop($_);
s/^ *//;
s/ *$//;
if ($side == 0) {
s/ *:: */ :== /;
} else {
s/(.*) *:: *(.*)/$2 :== $1/;
}

print $_."\n";
}
}
#v-

Das ganze ist jetzt wesentlich schnell geworden, so in etwa 2.5 Sekunden,
aber an grep (0.3 Sekunden) kommt es noch nicht heran.

Gruß und danke für die Hilfe, Jörg.

Jörg Sommer

unread,
Aug 29, 2002, 6:28:03 AM8/29/02
to
Janek Schleicher schrieb :

> Jörg Sommer wrote at Tue, 27 Aug 2002 23:21:19 +0200:
>
>> ich wollte mir steak (ein Wörterbuchprogr.) in perl übersetzen, damit man
>> noch so einige Features aufnehmen kann. Leider musste ich feststellen,
>> dass ich mit perl die Datei 3-4 Sekunden durchsuche, mit grep aber nur
>> 0.1 Sekunde brauche. Das ich die Zeiten von grep nie erreiche ist mir
>> klar, aber ich würde wenigstens gern in deren Nähe kommen.
>
> Das wuerde ich bestreiten.

Bis jetzt ist es aber noch so.
Perl => Total Elapsed Time = 2.658656 Seconds
grep => real 0m0.223s

> Gleichwertige Aufgaben erledigt Perl zumindestens nicht signifikant langsamer.
> (Ich wuerde sogar behaupten, dass Perl schneller ist,
> aber da kann ich mich irren)

Das würde ich nicht denken, denn bei perl hängt noch einiges dran, was
bei grep nicht ist.

> Zuerst einmal an der Lesbarkeit.
> Nimm es mir nicht uebel,
> aber zumindestens auf den ersten Blick konnte ich nicht erkennen,
> was Dein Script eigentlich tun soll.

Das kann ich nicht so recht verstehen, aber hilf mir doch mal auf die
Sprünge, was du nich verstanden hast. Ich dachte eigentlich ich schreibe
gut lesbar.

> Das beste waere, wenn Du das hier mal mit natuerlichen
> deutschen/englischen Saetzen beschreibst.

In mehreren Dateien(@files) stehen Übersetzungen, getrennt durch '::'.
Diese sollen nun auf der linken($side==0) oder rechten($side==1) Seite
durchsucht werden. Dabei können die Wörter(@words), die zur Suche
angegeben wurden, durch "und"($andor==1) oder "oder"($andor==0) verknüpft
werden. Dabei kann man die Groß-/Kleinschreibung beachten
($ignore_case==0) oder nicht beachten ($ignore_case==1).

Jörg.

Janek Schleicher

unread,
Aug 29, 2002, 7:36:52 AM8/29/02
to
Jörg Sommer wrote at Thu, 29 Aug 2002 12:28:03 +0200:

>> Jörg Sommer wrote at Tue, 27 Aug 2002 23:21:19 +0200:
>>
>>> ich wollte mir steak (ein Wörterbuchprogr.) in perl übersetzen, damit man
>>> noch so einige Features aufnehmen kann. Leider musste ich feststellen,
>>> dass ich mit perl die Datei 3-4 Sekunden durchsuche, mit grep aber nur
>>> 0.1 Sekunde brauche. Das ich die Zeiten von grep nie erreiche ist mir
>>> klar, aber ich würde wenigstens gern in deren Nähe kommen.
>>
>> Das wuerde ich bestreiten.
>
> Bis jetzt ist es aber noch so.
> Perl => Total Elapsed Time = 2.658656 Seconds
> grep => real 0m0.223s

Wie lautet denn die grep-Kommandozeile und
der analoge Perl-Einzeiler.

>> Gleichwertige Aufgaben erledigt Perl zumindestens nicht signifikant langsamer.
>> (Ich wuerde sogar behaupten, dass Perl schneller ist,
>> aber da kann ich mich irren)
>
> Das würde ich nicht denken, denn bei perl hängt noch einiges dran, was
> bei grep nicht ist.

Vor allem die Compilierungszeit,
die liegt aber deutlich unter 2 Sekunden.

>> Zuerst einmal an der Lesbarkeit.
>> Nimm es mir nicht uebel,
>> aber zumindestens auf den ersten Blick konnte ich nicht erkennen,
>> was Dein Script eigentlich tun soll.
>
> Das kann ich nicht so recht verstehen, aber hilf mir doch mal auf die
> Sprünge, was du nich verstanden hast. Ich dachte eigentlich ich schreibe
> gut lesbar.

Ich kann schon die einzelnen Zeilen verstehen,
(sie sehen sehr C/Java-maessig aus :-))
nur nicht auf den ersten Blick den gesamten Absatz (also Dein Skript) auf einmal.
Da Perlish naeher verwandt zu Englisch ist als zu anderen Sprachen,
sollte dies eigentlich immer moeglich sein.

Ich muss aber zugeben,
dass ich auch einfach keine Lust hatte,
mich durch den Quelltext zu kaempfen.

>
>> Das beste waere, wenn Du das hier mal mit natuerlichen
>> deutschen/englischen Saetzen beschreibst.
>
> In mehreren Dateien(@files) stehen Übersetzungen, getrennt durch '::'.
> Diese sollen nun auf der linken($side==0) oder rechten($side==1) Seite
> durchsucht werden. Dabei können die Wörter(@words), die zur Suche
> angegeben wurden, durch "und"($andor==1) oder "oder"($andor==0) verknüpft
> werden. Dabei kann man die Groß-/Kleinschreibung beachten
> ($ignore_case==0) oder nicht beachten ($ignore_case==1).

D.h. also so etwas wie

use constant ENGLISH => 0; # Eigentlich nur eine Form der Doku :-))
use constant GERMAN => 1;

my $translate_from = $side;
my @search_words = @words;
my $search_method = $andor ? "AND" : "OR";

my @search_re = map {$ignore_case ? qr/\Q$_/i : qr/\Q$_/} @search_words;

local @ARGV = @files;
TRANSLATION: while (<>) {
my $word = ($split /::/, $_)[$translate_from];
SEARCH_WORD: foreach my $re (@search_re) {
if ($word =~ /$re/) {
last SEARCH_WORD if $search_method eq "OR";
} else {
next TRANSLATION if $search_method eq "AND";
}
}
print;
}

[ungetestet]


Selbsverstaendlich liesse sich obiges noch optimieren,
das ist aber ein anderes Thema

Slaven Rezic

unread,
Aug 29, 2002, 10:39:54 AM8/29/02
to
Jörg Sommer <jo...@alea.gnuu.de> writes:

> Slaven Rezic schrieb :
> > Jörg Sommer <jo...@alea.gnuu.de> writes:

[...]


>
> > Wenn die Datei sortiert ist und auf der linken Seite gesucht wird,
> > dann kannst du evtl. Search::Dict verwenden.
>
> Nein, das lässt sich nicht machen.
>

Es würde sich lohnen. Zur Not kannst du zwei Dateien erstellen.

$ time perl -MSearch::Dict -e 'open(F, "/usr/share/dict/words");look *F, "zoo"; print scalar <F>;'
zoo
0.029u 0.009s 0:00.03 66.6% 1470+1030k 0+0io 0pf+0w

$ time perl -e 'open(F, "/usr/share/dict/words");while(<F>) { print $_ if /^zoo/ }'
0.561u 0.020s 0:00.58 100.0% 784+286k 0+0io 0pf+0w

Mit Search::Dict wäre es *schneller* als mit grep.

Gruß,
Slaven

--
Slaven Rezic - slaven...@berlin.de

Berlin Perl Mongers - http://berliner.pm.org

Slaven Rezic

unread,
Aug 29, 2002, 10:36:52 AM8/29/02
to
Jörg Sommer <jo...@alea.gnuu.de> writes:

Wenn @words==1 ist, dann einfach $help=@words setzen.

> if ($ignore_case) {
> push(@regexp, qr/$help/oi);
> } else {
> push(@regexp, qr/($help)/o);

Warum die Klammern hier?

> }
> }
> undef @words;
>
> foreach my $f (@files) {
> my ($file, $side) = @{$f};
>
> if ($side==0) { # left side
> $_ = qr/$_.*::/ foreach(@regexp);
> } else { # right side
> $_ = qr/::.*$_/ foreach(@regexp);
> }
>
> open(DICT, "<", $file) || die "Could not open dictionary file \"$file\"";
> line: while(<DICT>) {
> next line if (/^#/ || /^$/);

Mach mal einen Benchmark, ob es sich lohnt, die beiden Regexps in eine
unterzubringen.

> my $line = $_;
> foreach (@regexp) {
> next line if ($line !~ /$_/);

Ich glaube, dass das /o von oben hier gar nicht greift. Am schnellsten
ist noch immer eine statische Regexp, siehe Benchmark unten.

Vielleicht hilft es, wenn du mit eval() die Schleife zusammenbaust und
manuelles "loop unrolling" machst, d.h. statt der foreach-Schleife die
Zeile entsprechend oft wiederholst.

> }
>
> chop($_);
> s/^ *//;
> s/ *$//;
> if ($side == 0) {
> s/ *:: */ :== /;
> } else {
> s/(.*) *:: *(.*)/$2 :== $1/;
> }
>
> print $_."\n";
> }
> }
> #v-
>
> Das ganze ist jetzt wesentlich schnell geworden, so in etwa 2.5 Sekunden,
> aber an grep (0.3 Sekunden) kommt es noch nicht heran.

Sind die Abfragen überhaupt vergleichbar? Nicht dass du mit grep eine
einfach Abfrage machst und mit perl eine kompliziertere andor-Abfrage.

Hier der Benchmark:

use Benchmark;
use strict;

my $foo = "some variable";
my $rx = 'var';
my $qr = qr/$rx/;
my $qro = qr/$rx/o;

timethese(-1, {
'qr' => sub {
$foo =~ $qr;
},
'qr/o' => sub {
$foo =~ $qro;
},
'no qr' => sub {
$foo =~ /$rx/;
},
'/o' => sub {
$foo =~ /$rx/o;
},
'static' => sub {
$foo =~ /var/;
},
}
);

__END__

Ergebnisse:

Linux 2.4.x, 600 MHz:

perl 5.6.1
Benchmark: running /o, no qr, qr, qr/o, static, each for at least 1 CPU seconds...
/o: 1 wallclock secs ( 1.14 usr + 0.00 sys = 1.14 CPU) @ 1207241.23/s (n=1376255)
no qr: 0 wallclock secs ( 1.14 usr + 0.00 sys = 1.14 CPU) @ 919803.51/s (n=1048576)
qr: 1 wallclock secs ( 1.13 usr + 0.00 sys = 1.13 CPU) @ 936865.49/s (n=1058658)
qr/o: 1 wallclock secs ( 1.05 usr + 0.00 sys = 1.05 CPU) @ 936227.62/s (n=983039)
static: 1 wallclock secs ( 1.06 usr + 0.00 sys = 1.06 CPU) @ 1303974.53/s (n=1382213)

perl 5.8.0
Benchmark: running /o, no qr, qr, qr/o, static for at least 1 CPU seconds...
/o: 1 wallclock secs ( 1.09 usr + 0.00 sys = 1.09 CPU) @ 901871.56/s (n=983040)
no qr: 0 wallclock secs ( 1.05 usr + 0.00 sys = 1.05 CPU) @ 689852.38/s (n=724345)
qr: 2 wallclock secs ( 1.05 usr + 0.00 sys = 1.05 CPU) @ 728177.14/s (n=764586)
qr/o: 2 wallclock secs ( 1.07 usr + 0.00 sys = 1.07 CPU) @ 714566.36/s (n=764586)
static: 1 wallclock secs ( 1.04 usr + 0.00 sys = 1.04 CPU) @ 945229.81/s (n=983039)

FreeBSD 4.6, 466 MHz:

perl 5.6.1
Benchmark: running /o, no qr, qr, qr/o, static, each for at least 1 CPU seconds...
/o: 0 wallclock secs ( 1.02 usr + 0.00 sys = 1.02 CPU) @ 825954.46/s (n=838860)
no qr: 1 wallclock secs ( 1.07 usr + 0.00 sys = 1.07 CPU) @ 587814.31/s (n=629145)
qr: 2 wallclock secs ( 1.12 usr + 0.00 sys = 1.12 CPU) @ 522432.45/s (n=583655)
qr/o: 0 wallclock secs ( 1.12 usr + 0.00 sys = 1.12 CPU) @ 522432.45/s (n=583655)
static: 1 wallclock secs ( 1.02 usr + 0.00 sys = 1.02 CPU) @ 867252.18/s (n=880803)

perl 5.8.0
Benchmark: running /o, no qr, qr, qr/o, static for at least 1 CPU seconds...
/o: 2 wallclock secs ( 1.17 usr + 0.00 sys = 1.17 CPU) @ 626349.23/s (n=734003)
no qr: 0 wallclock secs ( 1.05 usr + 0.00 sys = 1.05 CPU) @ 494919.64/s (n=518119)
qr: 0 wallclock secs ( 1.09 usr + 0.01 sys = 1.09 CPU) @ 473708.80/s (n=518119)
qr/o: 0 wallclock secs ( 1.06 usr + 0.00 sys = 1.06 CPU) @ 487641.41/s (n=518119)
static: 2 wallclock secs ( 1.09 usr + 0.00 sys = 1.09 CPU) @ 648879.88/s (n=704643)

--
Slaven Rezic - slaven...@berlin.de

babybike - routeplanner for cyclists in Berlin
handheld (e.g. Compaq iPAQ with Linux) version of bbbike
http://bbbike.sourceforge.net

Slaven Rezic

unread,
Aug 29, 2002, 10:20:04 AM8/29/02
to
Janek Schleicher <bi...@kamelfreund.de> writes:

> Jörg Sommer wrote at Thu, 29 Aug 2002 12:28:03 +0200:
>
> >> Jörg Sommer wrote at Tue, 27 Aug 2002 23:21:19 +0200:
> >>
> >>> ich wollte mir steak (ein Wörterbuchprogr.) in perl übersetzen, damit man
> >>> noch so einige Features aufnehmen kann. Leider musste ich feststellen,
> >>> dass ich mit perl die Datei 3-4 Sekunden durchsuche, mit grep aber nur
> >>> 0.1 Sekunde brauche. Das ich die Zeiten von grep nie erreiche ist mir
> >>> klar, aber ich würde wenigstens gern in deren Nähe kommen.
> >>
> >> Das wuerde ich bestreiten.
> >
> > Bis jetzt ist es aber noch so.
> > Perl => Total Elapsed Time = 2.658656 Seconds
> > grep => real 0m0.223s
>
> Wie lautet denn die grep-Kommandozeile und
> der analoge Perl-Einzeiler.
>

grep ist schon wesentlich schneller. Hier ein Beispiel (ich habe hier
perl5.8.0):

$ time grep ^zoo /usr/share/dict/words
0.009u 0.029s 0:00.03 66.6% 96+400k 0+0io 0pf+0w

$ time perl -e 'open(F, "/usr/share/dict/words");while(<F>) { print $_ if /^zoo/ }'

0.529u 0.049s 0:00.58 96.5% 812+296k 0+0io 0pf+0w

Gruß,
Slaven

--
Slaven Rezic - slaven...@berlin.de

tkruler - Perl/Tk program for measuring screen distances
http://ptktools.sourceforge.net/#tkruler

Fabian Pilkowski

unread,
Aug 29, 2002, 11:51:26 AM8/29/02
to
=?iso-8859-1?Q?J=F6rg?= Sommer schrieb:

Ich hab nur kurz druebergeschaut und die einzelnen Operationen ein wenig
zusammengefasst.


foreach my $f ( @files ) {
my( $file, $side ) = @{ $f };

open DICT, '<', $file or die "Cannot open file: $!";
while ( <DICT> ) {
next if /^#/ || /^$/;

my $mod = $ignore_case ? 'i' : '';
my $func = ( $side == 0 )
? sub { map { quotemeta() . '.*?::' } @_ }
: sub { map { '::.*?' . quotemeta() } @_ };
my $reg = join '|', $func->( @words );
next unless m/(?$mod:$reg)/;

chomp;
s/^(.*) *:: *(.*?) *$/
$side == 0 ? "$1 :== $2" : "$2 :== $1" /e;
print $_, "\n";
}
close DICT or die "Cannot close file: $!";

Fabian Pilkowski

unread,
Aug 29, 2002, 12:33:59 PM8/29/02
to
Sorry, hatte das Posting gestern Nacht vorbereitet und in die "Outbox"
gelegt, obwohl es nur schnell hingeschrieben war. Jetzt hatte ich nicht
daran gedacht, dass das noch da ist, und somit ergaenze ich mich hiermit
:)

Fabian Pilkowski schrieb:


> >
> > ich wollte mir steak (ein Wörterbuchprogr.) in perl übersetzen, damit man
> > noch so einige Features aufnehmen kann. Leider musste ich feststellen,
> > dass ich mit perl die Datei 3-4 Sekunden durchsuche, mit grep aber nur
> > 0.1 Sekunde brauche. Das ich die Zeiten von grep nie erreiche ist mir
> > klar, aber ich würde wenigstens gern in deren Nähe kommen.
>

> Ich hab nur kurz druebergeschaut und die einzelnen Operationen ein wenig
> zusammengefasst.
>
> foreach my $f ( @files ) {
> my( $file, $side ) = @{ $f };
>
> open DICT, '<', $file or die "Cannot open file: $!";
> while ( <DICT> ) {
> next if /^#/ || /^$/;
>
> my $mod = $ignore_case ? 'i' : '';
> my $func = ( $side == 0 )
> ? sub { map { quotemeta() . '.*?::' } @_ }
> : sub { map { '::.*?' . quotemeta() } @_ };
> my $reg = join '|', $func->( @words );
> next unless m/(?$mod:$reg)/;
>
> chomp;
> s/^(.*) *:: *(.*?) *$/
> $side == 0 ? "$1 :== $2" : "$2 :== $1" /e;
> print $_, "\n";
> }
> close DICT or die "Cannot close file: $!";
> }

Getestet war davon letzte Nacht noch gar nichts, aber ich habe es noch
mal kurz ausprobiert: Es funktioniert alles wie gewuenscht.

Gebenchmarkt hab ich jetzt nichts, aber wie aus anderen Postings
inzwischen hervorging, ist Perl ohnehin langsamer als `grep`. Trotzdem
sollte mein Code unwesentlich schneller sein als der von Dir
vorgeschlagene.

Allerdings sehe ich gerade, dass die Ueberpruefung auf /^$/ eigentlich
unnoetig ist, denn mindestens ein "\n" sollte doch schon in jeder Zeile
stehen, oder? Ansonsten ist es trickreich, alle Vergleiche mit einer
einzigen RegEx abzudecken -- diese wird in meinem obigen Code allerdings
unnoetigerweise fuer jede eingelesene Zeile erstellt und nicht einfach
nur einmal pro Datei. Nachgebessert sieht das dann wie folgt aus:


#!/usr/bin/perl -w
use strict;

my @files = ( [ 'dict.txt', 1 ] );
my $ignore_case = 0;
my @words = qw( monday sunday );

foreach my $f ( @files ) {

my( $file, $side ) = @$f;


my $mod = $ignore_case ? 'i' : '';
my $func = ( $side == 0 )
? sub { map { quotemeta() . '.*?::' } @_ }
: sub { map { '::.*?' . quotemeta() } @_ };
my $reg = join '|', $func->( @words );

open DICT, '<', $file or die "Cannot open file: $!";
while ( <DICT> ) {
next unless m/(?$mod:$reg)/ && ! /^#/;


chomp;
s/^(.*) *:: *(.*?) *$/
$side == 0 ? "$1 :== $2" : "$2 :== $1" /e;
print $_, "\n";
}
close DICT or die "Cannot close file: $!";
}

__END__


>
> > Jedoch kann ich index() nicht sagen, dass er nur in n-Buchstaben suchen
> > soll oder ist das möglich?

Brauchst Du auch nicht. Wenn man seine RegEx geschickt formuliert, kann
man damit recht viel erreichen ;)

> >
> > Jörg.

so long,
fabian

Philip Newton

unread,
Aug 30, 2002, 1:58:32 AM8/30/02
to
On 29 Aug 2002 16:20:04 +0200, Slaven Rezic <slaven...@berlin.de>
wrote:

> Janek Schleicher <bi...@kamelfreund.de> writes:
>
> > Wie lautet denn die grep-Kommandozeile und
> > der analoge Perl-Einzeiler.
>
> grep ist schon wesentlich schneller. Hier ein Beispiel (ich habe hier
> perl5.8.0):
>
> $ time grep ^zoo /usr/share/dict/words
> 0.009u 0.029s 0:00.03 66.6% 96+400k 0+0io 0pf+0w
>
> $ time perl -e 'open(F, "/usr/share/dict/words");while(<F>) { print $_ if /^zoo/ }'
> 0.529u 0.049s 0:00.58 96.5% 812+296k 0+0io 0pf+0w

Ich hätte den Einzeiler wohl eher als "perl -ne 'print if /^zoo/'
/usr/share/dict words" geschrieben. Auf die Performance dürfte das
allerdings kaum Einfluss haben.

-n und -p (evtl. auch -l) sind bei Einzeilern meine Freunde.

Gruß,
Philip
--
Philip Newton <nospam...@gmx.li>
That really is my address; no need to remove anything to reply.
If you're not part of the solution, you're part of the precipitate.

Jörg Sommer

unread,
Aug 30, 2002, 9:11:59 AM8/30/02
to
Janek Schleicher schrieb :

> Jörg Sommer wrote at Thu, 29 Aug 2002 12:28:03 +0200:
>
>>> Jörg Sommer wrote at Tue, 27 Aug 2002 23:21:19 +0200:
>>>
>>>> ich wollte mir steak (ein Wörterbuchprogr.) in perl übersetzen, damit man
>>>> noch so einige Features aufnehmen kann. Leider musste ich feststellen,
>>>> dass ich mit perl die Datei 3-4 Sekunden durchsuche, mit grep aber nur
>>>> 0.1 Sekunde brauche. Das ich die Zeiten von grep nie erreiche ist mir
>>>> klar, aber ich würde wenigstens gern in deren Nähe kommen.
>>>
>>> Das wuerde ich bestreiten.
>>
>> Bis jetzt ist es aber noch so.
>> Perl => Total Elapsed Time = 2.658656 Seconds
>> grep => real 0m0.223s
>
> Wie lautet denn die grep-Kommandozeile und
> der analoge Perl-Einzeiler.

$ time { cat /usr/share/trans/de-en | grep Franz > /dev/null; }

real 0m0.193s
user 0m0.080s
sys 0m0.120s
$ time { cat /usr/share/trans/de-en | perl -e 'while(<>) { print /Franz/; }' > /dev/null; }

real 0m1.015s
user 0m0.820s
sys 0m0.070s

>>> Zuerst einmal an der Lesbarkeit.
>>> Nimm es mir nicht uebel,
>>> aber zumindestens auf den ersten Blick konnte ich nicht erkennen,
>>> was Dein Script eigentlich tun soll.
>>
>> Das kann ich nicht so recht verstehen, aber hilf mir doch mal auf die
>> Sprünge, was du nich verstanden hast. Ich dachte eigentlich ich schreibe
>> gut lesbar.
>
> Ich kann schon die einzelnen Zeilen verstehen,
> (sie sehen sehr C/Java-maessig aus :-))

Man kann seine Herkunft einfach nicht verbergen :-))

>>> Das beste waere, wenn Du das hier mal mit natuerlichen
>>> deutschen/englischen Saetzen beschreibst.
>>
>> In mehreren Dateien(@files) stehen Übersetzungen, getrennt durch '::'.
>> Diese sollen nun auf der linken($side==0) oder rechten($side==1) Seite
>> durchsucht werden. Dabei können die Wörter(@words), die zur Suche
>> angegeben wurden, durch "und"($andor==1) oder "oder"($andor==0) verknüpft
>> werden. Dabei kann man die Groß-/Kleinschreibung beachten
>> ($ignore_case==0) oder nicht beachten ($ignore_case==1).
>
> D.h. also so etwas wie
>
> use constant ENGLISH => 0; # Eigentlich nur eine Form der Doku :-))
> use constant GERMAN => 1;

Ach Konstanten gibt es auch in Perl.

> my @search_re = map {$ignore_case ? qr/\Q$_/i : qr/\Q$_/} @search_words;

Wieso kann man eigtenlich der qr() keine variable als 2. Argument reichen?

> local @ARGV = @files;
> TRANSLATION: while (<>) {

Interessante Sache. Da werden alle Dateien geöffnet und was sonst noch
dazu gehört? Das ist ja praktisch. Aber ich dachte mit <> liest man immer
von stdin. Und wie kann man hier sagen, dass die Dateien nur zum Lesen
geöffnet werden sollen?

> Selbsverstaendlich liesse sich obiges noch optimieren,
> das ist aber ein anderes Thema

Ich habe mein Script (anderes Posting) jetzt schon wieder soweit
geändert, dass es zu deinem überhaupt nicht passt. Aber das Optimieren
war ja gerade mein Anliegen.

Jörg Sommer

unread,
Aug 30, 2002, 5:44:19 AM8/30/02
to
Slaven Rezic schrieb :

> Es würde sich lohnen. Zur Not kannst du zwei Dateien erstellen.

Es geht nicht. Die Zeilen sehen stellenweise so aus:
#v+
Darstellung {f} | isometrische Darstellung {f}; maßgleiche Darstellung {f} :: re
Darstellung {f}; Inbegriff {m} | Darstellungen {pl}; Inbegriffe {pl} :: embodime
Darstellung {f}; Vertretung {f} :: representation
Darstellung {f}; Behauptung {f}; Äußerung {f} :: statement
#v-

Und wenn ich dann nach Behauptung suche, müsste ich die Datei erst
zerlegen und diese Zerlegung erstmal sortieren.

>
> $ time perl -MSearch::Dict -e 'open(F, "/usr/share/dict/words");look *F, "zoo"; print scalar <F>;'
> zoo
> 0.029u 0.009s 0:00.03 66.6% 1470+1030k 0+0io 0pf+0w
>
> $ time perl -e 'open(F, "/usr/share/dict/words");while(<F>) { print $_ if /^zoo/ }'
> 0.561u 0.020s 0:00.58 100.0% 784+286k 0+0io 0pf+0w
>
> Mit Search::Dict wäre es *schneller* als mit grep.

Leider geht es nicht. Schade :-((

Jörg Sommer

unread,
Aug 30, 2002, 6:29:25 AM8/30/02
to
Fabian Pilkowski schrieb :

> Allerdings sehe ich gerade, dass die Ueberpruefung auf /^$/ eigentlich
> unnoetig ist, denn mindestens ein "\n" sollte doch schon in jeder Zeile

Wie matched man dann leere Zeilen? Ich dachte die sehen immer ^$ so aus.

> stehen, oder? Ansonsten ist es trickreich, alle Vergleiche mit einer
> einzigen RegEx abzudecken -- diese wird in meinem obigen Code allerdings

Tatsächlich. Ich hätte nie geglaubt, dass /^(#|$)/ das gleicht ist.

> foreach my $f ( @files ) {
> my( $file, $side ) = @$f;
> my $mod = $ignore_case ? 'i' : '';
> my $func = ( $side == 0 )
> ? sub { map { quotemeta() . '.*?::' } @_ }
> : sub { map { '::.*?' . quotemeta() } @_ };

Wenn ich jetzt die beiden Zeilen richtig interpretiere, wird das Wort
gequotet und hintendran .*?:: (oder davor ::.*?) gesetzt. Dann käme ja
aaa.*?::|bbb.*?:: raus. Damit kann ich aber schlecht meine
und-Verknüpfung machen.

Was bewirkt das ? hinter ".*"?

> my $reg = join '|', $func->( @words );
>
> open DICT, '<', $file or die "Cannot open file: $!";
> while ( <DICT> ) {
> next unless m/(?$mod:$reg)/ && ! /^#/;

Und das verstehe ich jetzt garnicht. Du matched hier doch auf $mod oder
$reg. Das sind doch aber 2 verschiedene Sachen. $mod gehört doch
hintendran.

Jörg.

Jörg Sommer

unread,
Aug 30, 2002, 9:11:30 AM8/30/02
to
Slaven Rezic schrieb :
> Jörg Sommer <jo...@alea.gnuu.de> writes:
>
>> Slaven Rezic schrieb :

>> Mein neuer Code:
>> #v+
>> my @regexp;
>> if ($andor) {
>> if ($ignore_case) {
>> @regexp = map(qr/$_/oi, map(quotemeta(), @words));
>> } else {
>> @regexp = map(qr/$_/o, map(quotemeta(), @words));
>> }
>> } else {
>> my $help = '('.join('|', map(quotemeta(), @words)).')';
>
> Wenn @words==1 ist, dann einfach $help=@words setzen.

a) Die Klammern habe ich gesetzt, weil ich nicht so recht voraussagen
kann, wie sich perl verhält, wenn es auch "aaa|bbb|ccc.*::" trifft.
b) Bräuchte ich nicht auch für den Fall @words==1 ein
$help=quotemeta(@words)? Gut die Klammern könnte man dann weglassen, aber
ist das ein Unterschied? - Ja, es ist ein erheblicher Unterschied.

>> if ($ignore_case) {
>> push(@regexp, qr/$help/oi);
>> } else {
>> push(@regexp, qr/($help)/o);
>
> Warum die Klammern hier?

Weil ich da gepennt habe. :-))

>> }
>> }
>> undef @words;
>>
>> foreach my $f (@files) {
>> my ($file, $side) = @{$f};
>>
>> if ($side==0) { # left side
>> $_ = qr/$_.*::/ foreach(@regexp);
>> } else { # right side
>> $_ = qr/::.*$_/ foreach(@regexp);
>> }
>>
>> open(DICT, "<", $file) || die "Could not open dictionary file \"$file\"";
>> line: while(<DICT>) {
>> next line if (/^#/ || /^$/);
>
> Mach mal einen Benchmark, ob es sich lohnt, die beiden Regexps in eine
> unterzubringen.

#v+


my $foo = "some variable";

my $qr1 = qr/^#/o;
my $qr2 = qr/^#/o;
my $qr12 = qr/^(#|$)/o;

timethese(-1, {
'geteilt' => sub {
$foo =~ $qr1 or $foo =~ $qr2;
},
'zusammen' => sub {
$foo =~ $qr12;
},
});
#v-

Ergebins:

Benchmark: running geteilt, zusammen, each for at least 1 CPU seconds...
geteilt: 1 wallclock secs ( 1.12 usr + 0.00 sys = 1.12 CPU) @ 236307.14/s (n=264664)
zusammen: 1 wallclock secs ( 1.04 usr + 0.00 sys = 1.04 CPU) @ 254484.62/s (n=264664)

Ist das ein Unterschied? Ich habe aber herausgefunden, dass mich das $
0.5 Sekunden kostest. Da kann ich es aauch weglassen und leere Zeilen
treffen ja so und so nicht den eigentlichen Test.

>> my $line = $_;
>> foreach (@regexp) {
>> next line if ($line !~ /$_/);

Die regexp läuft schneller ohne die umgebenden //.

> Ich glaube, dass das /o von oben hier gar nicht greift. Am schnellsten
> ist noch immer eine statische Regexp, siehe Benchmark unten.

Aber nur unwesentlich gegenüber /o

> Vielleicht hilft es, wenn du mit eval() die Schleife zusammenbaust und
> manuelles "loop unrolling" machst, d.h. statt der foreach-Schleife die
> Zeile entsprechend oft wiederholst.

Verstehe jetzt nicht ganz, was du meinst.

>> Das ganze ist jetzt wesentlich schnell geworden, so in etwa 2.5 Sekunden,
>> aber an grep (0.3 Sekunden) kommt es noch nicht heran.
>
> Sind die Abfragen überhaupt vergleichbar? Nicht dass du mit grep eine
> einfach Abfrage machst und mit perl eine kompliziertere andor-Abfrage.

Mit perl lasse ich nach "Franz" suchen und mit grep lasse ich nach
"Franz" suchen.

Mein neuer Quelltext:
#v+
@words = map(quotemeta(), @words);
foreach my $f (@files) {
my ($file, $side) = @$f;

my @regexp;
if ($andor) {


if ($side==0) { # left side

$_ .= ".*::" foreach(@words);
} else { # right side
$_ = "::.*$_" foreach(@words);
}

if ($ignore_case) {
@regexp = map(qr/$_/i, @words);
} else {
push(@regexp, qr/$_/o) foreach(@words);
# @regexp = map(qr/$_/o, @words);
exit 0;
#v-

Und hier steckt ein Fehler. Ich bekomme bei mehreren Wörtern (Franz,
isch) nur eine Regexp angezeigt ( 2mal "(?-xism:Franz.*::)" ). Das
gleiche ist mit map. Was heißt eigentlich xism? Hoffentlich nicht
extended, case-insensitive, single line, multiple lines.

#v+
}
print $_."\n" foreach(@words);
print $_."\n" foreach(@regexp);
} else {
my $help;
if (@words == 1) {
$help = @words;
} else {
$help = '('.join('|', @words).')';


}

if ($side==0) { # left side

$help .= ".*::";
} else { # right side
$help = "::.*$help";
}
if ($ignore_case) {
push(@regexp, qr/$help/io);
} else {
push(@regexp, qr/$help/o);
}
}

open(DICT, "<", $file) || die "Cannot open dictionary file \"$file\": $!";
line: while(<DICT>) {
next line if (/^#/);

my $line = $_;
foreach (@regexp) {

next line if ($line !~ $_);
}

chomp($_);
s/^ *(.*) *$/$1/;
if ($side==0) {


s/ *:: */ :== /;
} else {

s/^(.*) *:: *(.*)$/$2 :== $1/;
}
print $_,"\n";
}
close(DICT) || die "Cannot close file: $!";
}
#v-

Jörg.

Slaven Rezic

unread,
Aug 30, 2002, 9:59:25 AM8/30/02
to
Jörg Sommer <jo...@alea.gnuu.de> writes:

> Slaven Rezic schrieb :
> > Jörg Sommer <jo...@alea.gnuu.de> writes:
> >
> >> Slaven Rezic schrieb :
> >> Mein neuer Code:
> >> #v+
> >> my @regexp;
> >> if ($andor) {
> >> if ($ignore_case) {
> >> @regexp = map(qr/$_/oi, map(quotemeta(), @words));
> >> } else {
> >> @regexp = map(qr/$_/o, map(quotemeta(), @words));
> >> }
> >> } else {
> >> my $help = '('.join('|', map(quotemeta(), @words)).')';
> >
> > Wenn @words==1 ist, dann einfach $help=@words setzen.
>
> a) Die Klammern habe ich gesetzt, weil ich nicht so recht voraussagen
> kann, wie sich perl verhält, wenn es auch "aaa|bbb|ccc.*::" trifft.
> b) Bräuchte ich nicht auch für den Fall @words==1 ein
> $help=quotemeta(@words)?

Je nachdem, ob du regexpes als Eingabe akzeptierst oder nicht.

> Gut die Klammern könnte man dann weglassen, aber
> ist das ein Unterschied? - Ja, es ist ein erheblicher Unterschied.
>
> >> if ($ignore_case) {
> >> push(@regexp, qr/$help/oi);
> >> } else {
> >> push(@regexp, qr/($help)/o);
> >
> > Warum die Klammern hier?
>
> Weil ich da gepennt habe. :-))
>
> >> }
> >> }
> >> undef @words;
> >>
> >> foreach my $f (@files) {
> >> my ($file, $side) = @{$f};
> >>
> >> if ($side==0) { # left side
> >> $_ = qr/$_.*::/ foreach(@regexp);
> >> } else { # right side
> >> $_ = qr/::.*$_/ foreach(@regexp);
> >> }
> >>
> >> open(DICT, "<", $file) || die "Could not open dictionary file \"$file\"";
> >> line: while(<DICT>) {
> >> next line if (/^#/ || /^$/);
> >
> > Mach mal einen Benchmark, ob es sich lohnt, die beiden Regexps in eine
> > unterzubringen.
>
> #v+
> my $foo = "some variable";
> my $qr1 = qr/^#/o;
> my $qr2 = qr/^#/o;

^^^
Müsste das nicht:

my $qr2 = qr/^$/o;

sein? Übringens kannst du /o wohl weglassen, da keine Variablen in den
Regexpes vorkommen.

> my $qr12 = qr/^(#|$)/o;
>
> timethese(-1, {
> 'geteilt' => sub {
> $foo =~ $qr1 or $foo =~ $qr2;
> },
> 'zusammen' => sub {
> $foo =~ $qr12;
> },
> });
> #v-
>
> Ergebins:
>
> Benchmark: running geteilt, zusammen, each for at least 1 CPU seconds...
> geteilt: 1 wallclock secs ( 1.12 usr + 0.00 sys = 1.12 CPU) @ 236307.14/s (n=264664)
> zusammen: 1 wallclock secs ( 1.04 usr + 0.00 sys = 1.04 CPU) @ 254484.62/s (n=264664)
>
> Ist das ein Unterschied? Ich habe aber herausgefunden, dass mich das $
> 0.5 Sekunden kostest. Da kann ich es aauch weglassen und leere Zeilen
> treffen ja so und so nicht den eigentlichen Test.

Hier sind es je nach Perl-Version und Betriebssystem zwischen 4% und
12%. Nicht viel, aber es läppert sich zusammen :-)

>
> >> my $line = $_;
> >> foreach (@regexp) {
> >> next line if ($line !~ /$_/);
>
> Die regexp läuft schneller ohne die umgebenden //.
>
> > Ich glaube, dass das /o von oben hier gar nicht greift. Am schnellsten
> > ist noch immer eine statische Regexp, siehe Benchmark unten.
>
> Aber nur unwesentlich gegenüber /o
>
> > Vielleicht hilft es, wenn du mit eval() die Schleife zusammenbaust und
> > manuelles "loop unrolling" machst, d.h. statt der foreach-Schleife die
> > Zeile entsprechend oft wiederholst.
>
> Verstehe jetzt nicht ganz, was du meinst.

Den Sourcecode so zusammenbauen, dass:

next line if ($line !~ /wort1/);
next line if ($line !~ /wort2/);
next line if ($line !~ /wort3/);

herauskommt. Das macht z.B. der gcc, wenn man ihm die Option
-funroll-loops mitgibt.

Ungetestet:

$code = "";
foreach (@regexp) {
$code .= q{ next line if $line !~ / } . $_ . q{ /; };
}
eval $code;

Das lohnt sich natürlich, wenn der gesamte Code der while-Schleife so
zusammengebaut werden würde, weil ein eval() in einer Schleife teuer
wäre.

Ja. Allerdings werden mit "-" die Optionen ausgeschaltet.

Gruß,
Slaven

--
Slaven Rezic - slaven...@berlin.de

Tired of using file selectors? Real programmers use the TAB key for
completion and not for jumping around. Try
http://search.cpan.org/search?mode=module&query=Tk::PathEntry

Janek Schleicher

unread,
Aug 30, 2002, 11:46:11 AM8/30/02
to
Jörg Sommer wrote at Fri, 30 Aug 2002 15:11:59 +0200:

>> Wie lautet denn die grep-Kommandozeile und
>> der analoge Perl-Einzeiler.
>
> $ time { cat /usr/share/trans/de-en | grep Franz > /dev/null; }
>
> real 0m0.193s
> user 0m0.080s
> sys 0m0.120s
> $ time { cat /usr/share/trans/de-en | perl -e 'while(<>) { print /Franz/; }' > /dev/null; }

Hier wird jede Zeile *doppelt* bearbeitet,
einmal von cat und einmal von Perl.
Darueber hinaus muessen die noch ueber eine Pipe arbeiten.

>
> real 0m1.015s
> user 0m0.820s
> sys 0m0.070s

Probier statt dessen mal

time { perl -ne 'print if /Franz/' /usr/share/trans/de-en > /dev/null; }

Das ist im Groessenordnungen schneller.
(Zugegebener Massen immer noch etwas langsamer als grep).

>> D.h. also so etwas wie
>>
>> use constant ENGLISH => 0; # Eigentlich nur eine Form der Doku :-))
>> use constant GERMAN => 1;
>
> Ach Konstanten gibt es auch in Perl.

Im wesentlichen gibt es alle sinnvollen, bekannten
Programmier-Konzepte in Perl.

>> my @search_re = map {$ignore_case ? qr/\Q$_/i : qr/\Q$_/} @search_words;
>
> Wieso kann man eigtenlich der qr() keine variable als 2. Argument reichen?

qr/.../ ist keine Funktion,
sondern definiert ein regulaeren Ausdruck.
Deswegen kann man dort im wesentlichen nur das hineinschreiben,
was man auch in einen m/.../ Ausdruck schreiben kann.

Man haette an dieser Stelle allerdings auch so etwas wie

my $imodifier = $ignore_case ? "i" : "";
my @search-re = map {eval "qr/\Q\$_/$imodifier"} @search_words;

schreiben koennen.
Ist vielleicht sogar die elegantere Loesung.

>> local @ARGV = @files;
>> TRANSLATION: while (<>) {
>
> Interessante Sache. Da werden alle Dateien geöffnet und was sonst noch
> dazu gehört? Das ist ja praktisch. Aber ich dachte mit <> liest man immer
> von stdin.

Wenn man keine Dateien angegeben haette,
wuerde versucht werden von STDIN zu lesen
(ebenso, wenn man mehr als die vorhandenen Dateien auslesen will).
Will man von STDIN direkt lesen, benutzt man eigentlich
<STDIN>.

> Und wie kann man hier sagen, dass die Dateien nur zum Lesen
> geöffnet werden sollen?

Sie werden automatisch nur lesend geoeffnet.

>> Selbsverstaendlich liesse sich obiges noch optimieren,
>> das ist aber ein anderes Thema
>
> Ich habe mein Script (anderes Posting) jetzt schon wieder soweit
> geändert, dass es zu deinem überhaupt nicht passt. Aber das Optimieren
> war ja gerade mein Anliegen.

Ich habe die Erfahrung gemacht,
dass die lesbarsten Programme auch meist mit zu den schnellsten gehoeren.
Deswegen habe ich mir angewoehnt, so lesbar wie moeglich zu schreiben,
und erst danach mit dem Optimieren anzufangen,
und auch nur dann, wenn ich ohne dem Nachteile haette.

In dem von mir gegebenen Beispiel duerfte es schwer sein,
noch triviale Optimierungen zu machen.
Eine Moeglichkeit waere, wenn man sich die innerste Bedingungsauswertung
(Ist Suchmethode "AND" oder "OR")
in jeder Schleife abgefragt.
Da dies aber sich von Schleifenlauf zu Schleifenlauf nicht ändert,
könnte man etwa zwei Schleifenmethoden bauen,
eine für die AND und eine für die OR-Methode.
Mittels eval liesse sich das auch ohne Verwendung von
doppelten Quelltext machen.

Eine andere Optimierungsmoeglichkeit koennte sein,
dass man die Suchwoerter zuerst einmal sortiert und mit den kleinsten anfaengt.
Ziel ist, dass bei einer ODER-Suche die Suche moeglichst schnell abbricht.
Da kleine Teil-Strings häufiger vorkommen als grosse (etwa -en <=> Tellerwäscher),
koennte dies eine gute Heuristik sein.
Bei einer UND-Verknüpfung muesste vermutlich die grössten Wörter zuerst
ueberprueft werden, in der Hoffnung moeglichst fruehzeitig
einen Nicht-Treffer zu finden.

Man koennte auch genauso Woerter mit seltenen Buchstaben zuerst Matchen
bei UND-Verknuepfungen bzw. zuletzt bei ODER-Verknuepfungen.

Weiterhin koennte es Geschwindigkeitsvorteile bringen,
wenn man die Spalte nicht direkt berechnet,
sondern speziell fuer jede Spalte.
Also statt

my $word = ($split /::/, $_)[$translate_from];

my ($word) = /^(.*?)::/; # fuer translate_from == 0
my ($word) = /::(.*)$/; # fuer translate_from == 1

Ueber all dies lohnt es sich aber erst zu reden,
wenn das Skript ueberhaupt tut, was es tun soll.

Aber mal ganz ehrlich:
Wenn einfach nur nach Worten in einer zweispaltigen Tabelle gesucht werden soll,
warum das ganze dann nicht gleich in C schreiben,
wenn die Geschwindigkeit so eine immense Rolle spielt.


MfG Janek

Tassilo v. Parseval

unread,
Aug 30, 2002, 12:52:45 PM8/30/02
to
Also sprach Janek Schleicher:

>>> my @search_re = map {$ignore_case ? qr/\Q$_/i : qr/\Q$_/} @search_words;
>>
>> Wieso kann man eigtenlich der qr() keine variable als 2. Argument reichen?
>
> qr/.../ ist keine Funktion,
> sondern definiert ein regulaeren Ausdruck.
> Deswegen kann man dort im wesentlichen nur das hineinschreiben,
> was man auch in einen m/.../ Ausdruck schreiben kann.
>
> Man haette an dieser Stelle allerdings auch so etwas wie
>
> my $imodifier = $ignore_case ? "i" : "";
> my @search-re = map {eval "qr/\Q\$_/$imodifier"} @search_words;
>
> schreiben koennen.
> Ist vielleicht sogar die elegantere Loesung.

Das bezweifele ich. Das schreibt man besser als:

my $modifier = $ignore_case ? "i" : "";
my @search_re = map { qr/(?$modifier)\Q$_/ } @search_words;

Perl bietet genau dieses (?imsx-imsx) Konstrukt an, um die Modifier zu
inlinen, damit sie dynamisch übergeben werden können.

Tassilo
--
$_=q!",}])(tsuJ[{@"tnirp}3..0}_$;//::niam/s~=)]3[))_$-3(rellac(=_$({
pam{rekcahbus;})(rekcah{lrePbus;})(lreP{rehtonabus;})(rehtona{tsuJbus!;
$_=reverse;s/sub/(reverse"bus").chr(32)/xge;tr~\n~~d;eval;

Janek Schleicher

unread,
Aug 30, 2002, 3:50:01 PM8/30/02
to
Tassilo v. Parseval wrote at Fri, 30 Aug 2002 18:52:45 +0200:

>> Man haette an dieser Stelle allerdings auch so etwas wie
>>
>> my $imodifier = $ignore_case ? "i" : "";
>> my @search-re = map {eval "qr/\Q\$_/$imodifier"} @search_words;
>>
>> schreiben koennen.
>> Ist vielleicht sogar die elegantere Loesung.
>
> Das bezweifele ich. Das schreibt man besser als:
>
> my $modifier = $ignore_case ? "i" : "";
> my @search_re = map { qr/(?$modifier)\Q$_/ } @search_words;
>
> Perl bietet genau dieses (?imsx-imsx) Konstrukt an, um die Modifier zu
> inlinen, damit sie dynamisch übergeben werden können.

Oh ja richtig,
da habe ich mal wieder den Wald vor lauter Baeumen nicht gesehen.


MfG Janek

Jörg Sommer

unread,
Aug 30, 2002, 3:07:37 PM8/30/02
to
Slaven Rezic schrieb :
> Jörg Sommer <jo...@alea.gnuu.de> writes:
>
>> Slaven Rezic schrieb :
>> > Jörg Sommer <jo...@alea.gnuu.de> writes:
>> >
>> my $qr12 = qr/^(#|$)/o;
>>
>> timethese(-1, {
>> 'geteilt' => sub {
>> $foo =~ $qr1 or $foo =~ $qr2;
>> },
>> 'zusammen' => sub {
>> $foo =~ $qr12;
>> },
>> });
>> #v-
>>
>> Ergebins:
>>
>> Benchmark: running geteilt, zusammen, each for at least 1 CPU seconds...
>> geteilt: 1 wallclock secs ( 1.12 usr + 0.00 sys = 1.12 CPU) @ 236307.14/s (n=264664)
>> zusammen: 1 wallclock secs ( 1.04 usr + 0.00 sys = 1.04 CPU) @ 254484.62/s (n=264664)
>>
>> Ist das ein Unterschied? Ich habe aber herausgefunden, dass mich das $
>> 0.5 Sekunden kostest. Da kann ich es aauch weglassen und leere Zeilen
>> treffen ja so und so nicht den eigentlichen Test.
>
> Hier sind es je nach Perl-Version und Betriebssystem zwischen 4% und
> 12%. Nicht viel, aber es läppert sich zusammen :-)

Die Versionen untereinander scheinen schon schlechter zu werden.
Jedenfalls hatte ich den Eindruck bei den Benmarks aus dem vorhergehenden
Posting. Trügt der Schein?

>> > Vielleicht hilft es, wenn du mit eval() die Schleife zusammenbaust und
>> > manuelles "loop unrolling" machst, d.h. statt der foreach-Schleife die
>> > Zeile entsprechend oft wiederholst.
>>
>> Verstehe jetzt nicht ganz, was du meinst.
>
> Den Sourcecode so zusammenbauen, dass:
>
> next line if ($line !~ /wort1/);
> next line if ($line !~ /wort2/);
> next line if ($line !~ /wort3/);

Das war eine spitzen Idee. Das Programm ist um eine Sekunde (das ist die
Hälfte) schneller geworden.

> Das lohnt sich natürlich, wenn der gesamte Code der while-Schleife so
> zusammengebaut werden würde, weil ein eval() in einer Schleife teuer
> wäre.

Ich hab's so gemacht:
#v+


open(DICT, "<", $file) || die "Cannot open dictionary file \"$file\": $!";

my $check;
foreach (@regexp) {
$check .= 'next if ($_ !~ /'.$_.'/'.($ignore_case?'i':'').');';
}

eval('while(<DICT>) {'.
'next if (/^#/);'.
$check.
'chomp($_);'.
($side==0?
's/^ *(.*) *:: *(.*) *$/$1 :== $2/;'
:
's/^ *(.*) *:: *(.*) *$/$2 :== $1/;').
'print $_,"\n";'.
'}');

close(DICT) || die "Cannot close file: $!";
#v-

>> push(@regexp, qr/$_/o) foreach(@words);


>> # @regexp = map(qr/$_/o, @words);
>> exit 0;
>> #v-
>>
>> Und hier steckt ein Fehler. Ich bekomme bei mehreren Wörtern (Franz,
>> isch) nur eine Regexp angezeigt ( 2mal "(?-xism:Franz.*::)" ). Das

Warum ist hier der Fehler mit den RegExp?

>> gleiche ist mit map. Was heißt eigentlich xism? Hoffentlich nicht
>> extended, case-insensitive, single line, multiple lines.
>
> Ja. Allerdings werden mit "-" die Optionen ausgeschaltet.

Dazu habe ich nichts in der Doku gefunden. qr//- geht nicht.

Fabian Pilkowski

unread,
Aug 30, 2002, 5:48:52 PM8/30/02
to
=?iso-8859-1?Q?J=F6rg?= Sommer schrieb:

> >
> > Allerdings sehe ich gerade, dass die Ueberpruefung auf /^$/ eigentlich
> > unnoetig ist, denn mindestens ein "\n" sollte doch schon in jeder Zeile
>
> Wie matched man dann leere Zeilen? Ich dachte die sehen immer ^$ so aus.

So sehen *leere Zeilen* aus, nachdem Du sie mit chomp() bearbeitet hast.
Vorher beinhaltet Deine *leere Zeile* einen Zeilenumbruch.

>
> > stehen, oder? Ansonsten ist es trickreich, alle Vergleiche mit einer
> > einzigen RegEx abzudecken -- diese wird in meinem obigen Code allerdings
>
> Tatsächlich. Ich hätte nie geglaubt, dass /^(#|$)/ das gleicht ist.
>
> > foreach my $f ( @files ) {
> > my( $file, $side ) = @$f;
> > my $mod = $ignore_case ? 'i' : '';
> > my $func = ( $side == 0 )
> > ? sub { map { quotemeta() . '.*?::' } @_ }
> > : sub { map { '::.*?' . quotemeta() } @_ };
>
> Wenn ich jetzt die beiden Zeilen richtig interpretiere, wird das Wort
> gequotet und hintendran .*?:: (oder davor ::.*?) gesetzt. Dann käme ja
> aaa.*?::|bbb.*?:: raus. Damit kann ich aber schlecht meine
> und-Verknüpfung machen.

Sorry, mein Code repraesentierte nur die *oder*-Verknüpfung. Fuer *und*
ist es imho sinnvoll, die einzelnen Pattern in ein Array zu packen und
dieses dann durchzugehen -- also so, wie Du es bereits in einem anderen
Posting realisiert hattest.

>
> Was bewirkt das ? hinter ".*"?

"Non-greedy", dh nicht gierig. spielt aber eigentlich nur eine Rolle,
wenn in den einzelnen Woertern evtl ein doppelter Doppelpunkt '::'
vorkommen kann -- vermutlich also uninteressant.

>
> > my $reg = join '|', $func->( @words );
> >
> > open DICT, '<', $file or die "Cannot open file: $!";
> > while ( <DICT> ) {
> > next unless m/(?$mod:$reg)/ && ! /^#/;
>
> Und das verstehe ich jetzt garnicht. Du matched hier doch auf $mod oder
> $reg. Das sind doch aber 2 verschiedene Sachen. $mod gehört doch
> hintendran.

Man kann die Modifier damit variabel halten. Die beiden folgenden Zeilen
sind gleichwertig:

m/var/i;
m/(?i:var)/;

Evtl willst Du Dir auch einmal `perldoc perlre` durchlesen. Auch wenn
vieles davon *jetzt* keine Rolle spielt, eine interessante Lektuere ist
es fuer Interessierte allemal :)

>
> Jörg.

gruss,
fabian

Tina Mueller

unread,
Aug 30, 2002, 6:19:11 PM8/30/02
to
Fabian Pilkowski <pilk...@mathematik.uni-marburg.de> wrote:
> =?iso-8859-1?Q?J=F6rg?= Sommer schrieb:
>> >
>> > Allerdings sehe ich gerade, dass die Ueberpruefung auf /^$/ eigentlich
>> > unnoetig ist, denn mindestens ein "\n" sollte doch schon in jeder Zeile
>>
>> Wie matched man dann leere Zeilen? Ich dachte die sehen immer ^$ so aus.

> So sehen *leere Zeilen* aus, nachdem Du sie mit chomp() bearbeitet hast.
> Vorher beinhaltet Deine *leere Zeile* einen Zeilenumbruch.

trotzdem matcht /^$/ eine leere zeile:
tina@tox:~> cat testdatei
eins

drei
tina@tox:~> perl -we'
while(<>) {
print "zeile $.: [$_]\n" if /^$/
}' testdatei
zeile 2: [
]

aus perldoc perlre:
| In particular the following metacharacters have their
| standard egrep-ish meanings:
| [...]
| $ Match the end of the line (or before newline at the end)

gruss, tina
--
http://www.tinita.de \ enter__| |__the___ _ _ ___
http://Movies.tinita.de/ \ / _` / _ \/ _ \ '_(_-< of
http://PerlQuotes.tinita.de/ \ \ _,_\ __/\ __/_| /__/ perception

Slaven Rezic

unread,
Aug 31, 2002, 6:05:39 AM8/31/02
to
Jörg Sommer <jo...@alea.gnuu.de> writes:

Nein, das ist anscheinend der normale Lauf der Dinge. *Jegliche*
Software scheint bei neueren Versionen langsamer zu werden. Das ist
der Preis für mehr Features und Komfort.

Das geht auch nur innerhalb von (?:). Somit kann man z.B. die
case-insensitive-Option für Teile der Regexp ausschalten:

$string =~ /case insensitive match(?-i:case sensitive match)/i;

Gruß,
Slaven

--
Slaven Rezic - slaven...@berlin.de

BBBike - route planner for cyclists in Berlin
WWW version: http://www.bbbike.de
Perl/Tk version: http://bbbike.sourceforge.net

Jörg Sommer

unread,
Aug 31, 2002, 5:56:34 AM8/31/02
to
Janek Schleicher schrieb :

> Jörg Sommer wrote at Fri, 30 Aug 2002 15:11:59 +0200:
>
> Das ist im Groessenordnungen schneller.
> (Zugegebener Massen immer noch etwas langsamer als grep).

Etwas? Perl braucht das 7-fache an Zeit. (Gut, bei solch kleinen Werten
sollte man nicht multipilzieren, aber der Unterschied ist IMO nicht wenig.)

$ time grep Franz /usr/share/trans/de-en > /dev/null

real 0m0.101s
user 0m0.050s
sys 0m0.050s
$ time perl -wne "print if /Franz/" /usr/share/trans/de-en > /dev/null

real 0m0.706s
user 0m0.660s
sys 0m0.050s

Naja, ein heutiger Rechner ist natürlich schneller als meiner
(K6-300MHz), da ist dann kein wirklicher Unterschied mehr zwischen beiden.

>>> Selbsverstaendlich liesse sich obiges noch optimieren,
>>> das ist aber ein anderes Thema
>>
>> Ich habe mein Script (anderes Posting) jetzt schon wieder soweit
>> geändert, dass es zu deinem überhaupt nicht passt. Aber das Optimieren
>> war ja gerade mein Anliegen.
>
> Ich habe die Erfahrung gemacht,
> dass die lesbarsten Programme auch meist mit zu den schnellsten gehoeren.
> Deswegen habe ich mir angewoehnt, so lesbar wie moeglich zu schreiben,
> und erst danach mit dem Optimieren anzufangen,
> und auch nur dann, wenn ich ohne dem Nachteile haette.

Das ist richtig, so sehe ich das auch. Und meine ursprüngliche Version
verschleuderte für eine einfache Suche 5 Sekunden. Die jetzige Version
hingegen 1 Sekunde und hat, so finde ich, in keinster Weise an Lesbarkeit
eingebüßt. Man muss halt bloß etwas perl können, um das dortige richtig
lesen zu können.

> Eine andere Optimierungsmoeglichkeit koennte sein,
> dass man die Suchwoerter zuerst einmal sortiert und mit den kleinsten anfaengt.
> Ziel ist, dass bei einer ODER-Suche die Suche moeglichst schnell abbricht.
> Da kleine Teil-Strings häufiger vorkommen als grosse (etwa -en <=> Tellerwäscher),
> koennte dies eine gute Heuristik sein.
> Bei einer UND-Verknüpfung muesste vermutlich die grössten Wörter zuerst
> ueberprueft werden, in der Hoffnung moeglichst fruehzeitig
> einen Nicht-Treffer zu finden.
>
> Man koennte auch genauso Woerter mit seltenen Buchstaben zuerst Matchen
> bei UND-Verknuepfungen bzw. zuletzt bei ODER-Verknuepfungen.

Also ich weiß nicht, ob dass wirklich noch was bringt. Oftmals denke ich,
wird nur nach einem Wort gesucht und höchstens mal 3.

> Ueber all dies lohnt es sich aber erst zu reden,
> wenn das Skript ueberhaupt tut, was es tun soll.

Das tut es.

> Aber mal ganz ehrlich:
> Wenn einfach nur nach Worten in einer zweispaltigen Tabelle gesucht werden soll,
> warum das ganze dann nicht gleich in C schreiben,
> wenn die Geschwindigkeit so eine immense Rolle spielt.

Eine *so große* Rolle spielt die Geschwindigkeit nicht, aber es gibt eine
Version von dem Script für die Shell und ich kann wohl kaum einen dazu
überreden dieses perl-Script zu verwenden, wenn er damit nach einem
einfachen Wort 5 Sekunden sucht, mit dem aber schon bestehenden
Shellscript 0.5 Sekunden. Mit dem jetzigen Script geht es in 1 Sekunde
und man hat die Annehmlichkeiten von Perl.

Warum nicht C? Wenn es in Perl nicht gegangen wäre, hätte ich halt auf
die Annehmlichkeiten verzichtet und mir wieder das Shell-Cript genommen.
C fände ich dafür etwas übertrieben.

Aber Perl kann's doch!

Jörg.

0 new messages