[21690] in Perl-Users-Digest
Perl-Users Digest, Issue: 3894 Volume: 10
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Tue Oct 1 14:10:49 2002
Date: Tue, 1 Oct 2002 11:10:17 -0700 (PDT)
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Perl-Users Digest Tue, 1 Oct 2002 Volume: 10 Number: 3894
Today's topics:
Re: Question about srand ctcgag@hotmail.com
Re: Question about srand <koos_pol@NO.nl.JUNK.compuware.MAIL.com>
Re: Question about srand ctcgag@hotmail.com
Re: Question about srand <brittedg@student.gvsu.edu>
Re: Question about srand <flavell@mail.cern.ch>
Simple Regex help needed (BUCK NAKED1)
Re: Simple Regex help needed (Helgi Briem)
Re: Simple Regex help needed (BUCK NAKED1)
Speed optimization (with code) <heather710101@yahoo.com>
Re: Speed optimization (with code) <bigj@kamelfreund.de>
Store as BLOB vs as file <me@me.com>
Top posting (was Re: How can I count files in a directo (Tad McClellan)
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: 01 Oct 2002 15:23:00 GMT
From: ctcgag@hotmail.com
Subject: Re: Question about srand
Message-Id: <20021001112300.580$Aw@newsreader.com>
Koos Pol <koos_pol@NO.nl.JUNK.compuware.MAIL.com> wrote:
> David Britten wrote (Tuesday 01 October 2002 07:10):
>
> > I've got a feeling the answer is no, but if I were to use srand to seed
> > two different systems (i.e. different OS, architecture) with the same
> > seed value, is there any chance that rand will generate the same
> > sequence of numbers on those two systems?
Yes, there is a nonzero chance it will.
perl -e 'srand 89; print rand,"\n" foreach (0..9);'
Produces the same result on 5.6.1 linux and 5.6.1 irix (except a presumably
formatting difference in number of decimal digits printed), but
a very different result on 5.00503 SunOS.
> > I suppose I could always write my own random number generator to ensure
> > consistency, but even a simple algorithm might make my program too
> > large to be any fun to look at.
That's what modules (or at least subroutines) are for!
>
> Didn't 'perldoc -f srand' give any clues?
No.
Xho
--
-------------------- http://NewsReader.Com/ --------------------
Usenet Newsgroup Service
------------------------------
Date: Tue, 01 Oct 2002 17:31:36 +0200
From: Koos Pol <koos_pol@NO.nl.JUNK.compuware.MAIL.com>
Subject: Re: Question about srand
Message-Id: <newscache$o47b3h$fz6$1@news.emea.compuware.com>
David Britten wrote (Tuesday 01 October 2002 15:50):
> On 10/1/02 2:58 AM, in article
> newscache$0eja3h$4v6$1@news.emea.compuware.com, "Koos Pol"
> <koos_pol@NO.nl.JUNK.compuware.MAIL.com> wrote:
>
>> David Britten wrote (Tuesday 01 October 2002 07:10):
>>
>>> I've got a feeling the answer is no, but if I were to use srand to seed
>>> two different systems (i.e. different OS, architecture) with the same
>>> seed value, is there any chance that rand will generate the same
>>> sequence of numbers on those two systems?
[snip]
>>> -David Britten
>>
>> Didn't 'perldoc -f srand' give any clues?
>
> It didn't really tell what it's using to generate random numbers. It could
> be built in to Perl; it could be a system dependent routine.
[snip]
> -David Britten
I don't understand what more you want to know besides:
srand EXPR
srand Sets the random number seed for the "rand" opera-
tor. If EXPR is omitted, uses a semi-random value
supplied by the kernel (if it supports the
-> /dev/urandom device) or based on the current time <-
-> and process ID, among other things. <-
Seems pretty random to me.
--
KP
------------------------------
Date: 01 Oct 2002 15:41:54 GMT
From: ctcgag@hotmail.com
Subject: Re: Question about srand
Message-Id: <20021001114154.227$zN@newsreader.com>
Koos Pol <koos_pol@NO.nl.JUNK.compuware.MAIL.com> wrote:
>
> I don't understand what more you want to know besides:
> srand EXPR
> srand Sets the random number seed for the "rand" opera-
> tor. If EXPR is omitted, uses a semi-random value
> supplied by the kernel (if it supports the
> -> /dev/urandom device) or based on the current time <-
> -> and process ID, among other things. <-
>
> Seems pretty random to me.
Notice the "If EXPR is omitted" part. Clearly, David did not plan
on omitting EXPR.
Xho
--
-------------------- http://NewsReader.Com/ --------------------
Usenet Newsgroup Service
------------------------------
Date: Tue, 01 Oct 2002 11:44:26 -0400
From: David Britten <brittedg@student.gvsu.edu>
Subject: Re: Question about srand
Message-Id: <B9BF3B1A.4BA5%brittedg@student.gvsu.edu>
On 10/1/02 10:35 AM, in article krbcna.iu2.ln@moldev.cmagroup.co.uk,
"news@roaima.freeserve.co.uk" <news@roaima.freeserve.co.uk> wrote:
> David Britten <brittedg@student.gvsu.edu> wrote:
>> I've got a feeling the answer is no, but if I were to use srand to seed two
>> different systems (i.e. different OS, architecture) with the same seed
>> value, is there any chance that rand will generate the same sequence of
>> numbers on those two systems?
>
> That sounds like you really want a predictable number generator that
> appears to provide statistically random results (!)
Yeah, that's more or less what I'm going for. :-) The idea is to find the
particular seed and the number of calls to rand I need to make in order to
start getting a 'desirable' set of data. That way I can define the entire
data set using only the seed and offset, thus making my program illegibly
compact.
>> I'm being optimistic, because this will be a really cool little program if
>> it will work on more than just my machine...
>
> The following one-liner produces the same result using "perl v5.6.1
> built for i686-linux" and "perl v5.6.0 built for sun4-solaris":
>
> $ perl -e 'srand 123; print rand, rand, rand' | cksum
> 3990100614 49
That's a good sign. Apparently, Perl uses its own generation routines.
Still, I can't help thinking that the results might be affected by the size
of int (or some other data type, perhaps) on a given system. It's not any
terrible problem though; this is just silly experimental code, not something
that will be used to control medical machinery. If it fails on a few
systems, no big deal.
-David Britten
------------------------------
Date: Tue, 1 Oct 2002 18:39:50 +0200
From: "Alan J. Flavell" <flavell@mail.cern.ch>
Subject: Re: Question about srand
Message-Id: <Pine.LNX.4.40.0210011831330.4865-100000@lxplus074.cern.ch>
On Oct 1, Koos Pol inscribed on the eternal scroll:
> >> David Britten wrote (Tuesday 01 October 2002 07:10):
> >>
> >>> ... if I were to use srand to seed
> >>> two different systems (i.e. different OS, architecture) with the same
> >>> seed value, is there any chance that rand will generate the same
> >>> sequence of numbers on those two systems?
> I don't understand what more you want to know besides:
> srand EXPR
> srand Sets the random number seed for the "rand" opera-
> tor. If EXPR is omitted, uses a semi-random value
> supplied by the kernel (if it supports the
> -> /dev/urandom device) or based on the current time <-
> -> and process ID, among other things. <-
Hadn't you noticed that what you have quoted does not shed the
slightest light on the hon Usenaut's original question?
He basically wants to know whether rand uses an architecture-
independent algorithm. In fact, the documentation doesn't answer that
question directly, but I'm pretty sure the answer is "no".
------------------------------
Date: Tue, 1 Oct 2002 10:20:35 -0500 (CDT)
From: dennis100@webtv.net (BUCK NAKED1)
Subject: Simple Regex help needed
Message-Id: <2678-3D99BD43-107@storefull-2277.public.lawson.webtv.net>
My first regex isn't working? I'm not getting any errors. It just
doesn't delete the first 7 lines of the file that I read in. Why?
open (FH, $log) or print "Cannot FIND the file: $!\n";
while (<FH>) {
s/^(.*\n){7}//o;
s/Net::SSL(.*?) /<BR>/g;
print
};
close FH or print "Can't close file: $!\n";
------------------------------
Date: Tue, 01 Oct 2002 16:07:23 GMT
From: helgi@decode.is (Helgi Briem)
Subject: Re: Simple Regex help needed
Message-Id: <3d99c640.1928016831@news.cis.dfn.de>
On Tue, 1 Oct 2002 10:20:35 -0500 (CDT), dennis100@webtv.net
(BUCK NAKED1) wrote:
>My first regex isn't working? I'm not getting any errors. It just
>doesn't delete the first 7 lines of the file that I read in. Why?
>
>open (FH, $log) or print "Cannot FIND the file: $!\n";
>while (<FH>) {
>s/^(.*\n){7}//o;
>s/Net::SSL(.*?) /<BR>/g;
>print
>};
>close FH or print "Can't close file: $!\n";
perldoc -q matching
2nd entry, also known as: "I'm having trouble matching over
more than one line. What's wrong?" would have told you.
In any case, I don't think a regex is the right way to go
about this. It is an evil misuse of that fine invention.
Here is another way:
# There may be reasons other than a nonexistent
# file why the open may fail and the errors should
# be printed to STDERR via warn or die, not STDOUT
my $lines_to_skip = 7;
open FH, $log or die "Cannot open $log:$!\n";
while (<FH>)
{
if ($. > $lines_to_skip)
{
s/Net::SSL(.*?) /<BR>/g;
print;
}
}
--
Regards, Helgi Briem
helgi AT decode DOT is
A: Top posting
Q: What is the most irritating thing on Usenet?
- "Gordon" on apihna
------------------------------
Date: Tue, 1 Oct 2002 12:00:34 -0500 (CDT)
From: dennis100@webtv.net (BUCK NAKED1)
Subject: Re: Simple Regex help needed
Message-Id: <4062-3D99D4B2-19@storefull-2271.public.lawson.webtv.net>
Thanks Heidi. I really appreciate it.
------------------------------
Date: Tue, 1 Oct 2002 15:21:05 +0000 (UTC)
From: Da Witch <heather710101@yahoo.com>
Subject: Speed optimization (with code)
Message-Id: <anceh1$jcu$1@reader1.panix.com>
I originally posted the post quoted below, but many respondents said
that they could not comment without seeing a description of the
algorithm and/or the code. Here I post both.
Thanks!
h
>I have implemented an algorithm in Perl that is 6-10x slower than it
>needs to be. I've tried all the tricks for speeding up Perl given in
>the speed optimization section of the Camel book.
>Is there any other repository of speed optimization ideas for Perl?
>What tools are good for profiling Perl code? I've used SmallProf, but
>it gives me strange results. (For example, one of the lines that it
>lists as taking up the most time is something like "my $a = 1e-06;"
>which is executed only once during the whole program!)
>Thanks,
>h
>P.S. In case you're wondering why I need to make *this* particular
>algorithm faster:
> 1. My boss has assigned the implementation to me, and he wants it
> to be in Perl, because that's what most people use in our field.
> 2. Another Perl implementation of this algorithm exists, but, for
> legal reasons, I may not look at it.
> 3. The person who wrote this implementation did so while working at
> another company, but now he works for our company; he can act as
> a consultant to me as I re-implement this algorithm, but, again,
> for obscure legal reasons, he can't implement it himself (he
> doesn't have access to the original code either).
> 4. Even though I've used all the ideas he has given me on how to
> implement this algorithm, his version (which we can run over the
> web at his former company's website), is about 6-10x faster than
> what I have implemented.
Here's the algorithm and the code. The description below is skimpy
despite its length. That is because the algorithm is somewhat
complicated (that's the reason I originally didn't post any code). A
full description would have made this post even less readable than it
is.
The problematic part is the one in the subroutine main.
This algorithm analyzes a collection of "adjectives", each of which is
associated with a set of "names" (in the sample data, both adjectives
and names are simulated as zero-padded 4-digit positive integers).
These associations are encoded in the hash-of-hashes %adj: the keys of
%adj are the adjectives; each value of %adj is a hashref pointing to a
hash whose keys are names, and whose values are all a boolean true.
The analysis is based on an ordered list of "names" called @nameslist.
All the names mentioned in %adj appear exactly once in @nameslist. An
"initial segment" is any slice of @nameslist of the form
$nameslist[0..$m], where 0 <= $m <= $#nameslist. For any "adjective"
A (key of %adj), and any initial segment S, one can compute a measure
P of how A is over- or underrepresented in S (when compared with its
overall frequency statistics in %adj). For each adjective, the
algorithm determines the initial segment with a smallest value of P
(keeping track of whether this value refers to an over- or
underrepresentation).
For a given A and S, P can be computed as follows. Define:
a = number of names in S that are associated with A
b = number of names in S that are not associated with A
c = number of names not in S that are associated with A
d = number of names not in S that are not associated with A
ab = a+b
cd = c+d
ac = a+c
bd = b+d
tot = a+b+c+d
top = max(ab, ac)
If a > (ab*ac/tot), then (formally) P is the sum obtained from the
loop (in pseudocode):
sum = 0
while(a <= top)
sum = sum + ab!*cd!*ac!*bd!/(a!*b!*c!*d!*tot!)
a = a+1
d = d+1
b = b-1
c = c-1
end
If a < (ab*ac/tot), then P is the sum obtained from the loop:
sum = 0
while(a >= 0)
sum = sum + ab!*cd!*ac!*bd!/(a!*b!*c!*d!*tot!)
a = a-1
d = d-1
b = b+1
c = c+1
end
If a == (ab*ac/tot), then we use the first loop if top - a < a, and
the second loop otherwise.
In addition to using exponentiations of sums of logs of factorials to
compute the individual terms in the sum, the algorithm uses several
tricks to speed up the computation of P. It relies on the fact that
the result of the sum doesn't change for certain permutations of a, b,
c, and d, but it is faster to compute when a is the smallest of all
four numbers. (Permuting these arguments can toggle variable that
keeps track of whether P corresponds to an over- or
underrepresentation.) Also, since the terms of the sum decrease
monotonically, we use a heuristic to stop the summation loop once we
reached the desired accuracy (which is not very high).
For a given adjective A, to find the smallest P (or actually, since P
is always between 0 and 1, the largest -log P) for all the initial
segments the algorithm uses one further shortcut. The array @namelist
can be regarded as an alternating succession of blocks such that all
the names 'N' in each block have the same value (true or false) for
$adj{'A'}{'N'}. The initial segment with the smallest P cannot
contain only part of such a block. Therefore, to find the smallest P
it is necessary look only at the values of P for initial segments that
consist of whole blocks.
h
========================================================================
#!/usr/bin/perl
use strict;
my %adj; # Hash of hashes keyed by
# "adjectives"; $adj{'xyz'} is a
# hashref whose keys are "names" and
# whose values are all a boolean true.
my %tallies; # Hash whose keys are the same as the
# keys of %adj, and whose values are
# the number of "names" associated
# with each "adjective" in %adj.
my @nameslist; # A list of "names".
my $tot; # The size of @nameslist.
my @lf; # Precomputed logs of factorials.
my $TRUE = (1 == 1);
my $PRECISION = 5e-02;
sub main {
for my $x (keys %adj) {
my $adj = $adj{$x};
my $a = 0;
my $b = 0;
my $c = $tallies{$x};
next unless $c;
my $d = $tot - $c;
my @subtallies;
my $s;
my $state = $s = $adj->{$nameslist[0]};
my $cume = 0;
my $i = 0;
for (@nameslist[1..$#nameslist]) {
++$cume;
if ($state != $adj->{$_}) {
$subtallies[$i++] = $cume;
$cume = 0;
$state = !$state;
}
}
$subtallies[$i] = ++$cume;
my $mx = -1;
my @argmx;
for my $subtally (@subtallies) {
if ($s) {
$a += $subtally;
$c -= $subtally;
}
else {
$b += $subtally;
$d -= $subtally;
}
$s = !$s;
my ($aa, $bb, $cc, $dd) = ($a, $b, $c, $d);
my $pty = $TRUE;
# Normalize inputs so that $aa is smallest
if ($dd < $cc) {
if ($dd < $bb) {
if ($dd < $aa) { # $dd smallest
($aa, $bb, $cc, $dd) = ($dd, $cc, $bb, $aa);
}
}
elsif ($bb < $aa) { # $bb smallest
($aa, $bb) = ($bb, $aa);
($cc, $dd) = ($dd, $cc);
$pty = !$pty;
}
}
elsif ($cc < $bb) {
if ($cc < $aa) { # $cc smallest
($aa, $cc) = ($cc, $aa);
($bb, $dd) = ($dd, $bb);
$pty = !$pty;
}
}
elsif ($bb < $aa) { # $bb smallest
($aa, $bb) = ($bb, $aa);
($cc, $dd) = ($dd, $cc);
$pty = !$pty;
}
my ($ab, $ac) = ($aa + $bb, $aa + $cc);
my $num =
$lf[$ab] + $lf[$cc + $dd] +
$lf[$ac] + $lf[$bb + $dd] - $lf[$tot];
my $p = 0;
my $high;
my $top;
my $check = ($ab*$ac)/$tot;
if ($aa == $check) {
$top = $ab < $ac ? $ab : $ac;
$high = ($top - $aa < $aa);
}
else {
$high = $aa > $check;
$top = $ab < $ac ? $ab : $ac;
}
if ($high) {
while ($aa <= $top) {
my $add = exp($num - ($lf[$aa] + $lf[$bb] +
$lf[$cc] + $lf[$dd]));
$p += $add;
last if $add*($top-$aa) < $PRECISION*$p;
++$aa; --$bb; --$cc; ++$dd;
}
}
else {
while ($aa >= 0) {
my $add = exp($num - ($lf[$aa] + $lf[$bb] +
$lf[$cc] + $lf[$dd]));
$p += $add;
last if $add*$aa < $PRECISION*$p;
--$aa; ++$bb; ++$cc; --$dd;
}
}
my $result = -log($p);
if ($mx < $result) {
$mx = $result;
@argmx = ($a + $b, $result, $high == $pty);
}
}
printf "%s %4d %f %c\n", $x,
$argmx[0], $argmx[1], $argmx[2] ? '+' : '-';
}
}
sub initialize {
my ($adj, $q, $t) = &makedata;
%adj = %{$adj};
@nameslist = @{$q};
%tallies = %{$t};
$tot = @nameslist;
@lf = (0);
$lf[$_] = $lf[$_-1] + log($_) for (@lf..$tot);
}
sub makedata {
srand(0);
my $N = 6000;
my $M = 4000;
my %adj = map { sprintf("%04d", $_) => [] } (1..$M);
my %nm;
my %tallies;
my @adj = @{rp([keys %adj])};
for my $x (0..$#adj) {
my $y = $tallies{$adj[$x]} = int(-3 + 10000/($x+3));
my %tmp;
while ((scalar keys %tmp) < $y) {
my $w = sprintf("%04d", int(rand($N)+1));
$nm{$w} = $tmp{$w} = $TRUE;
}
$adj{$adj[$x]} = { map { $_ => $TRUE }
sort { $a <=> $b } keys %tmp };
}
(\%adj, rp([keys %nm]), \%tallies);
}
sub rp { # "randomly" permutes array in place
my $p = shift;
my $n = $#$p+1;
for(my $i = $n; $i > 1; --$i) {
my $j = int(rand($i));
($p->[$i-1], $p->[$j]) = ($p->[$j], $p->[$i-1]);
}
$p;
}
&initialize();
&main();
------------------------------
Date: Tue, 01 Oct 2002 18:42:35 +0200
From: Janek Schleicher <bigj@kamelfreund.de>
Subject: Re: Speed optimization (with code)
Message-Id: <3d99de02$0$11472$afc38c87@auth.de.news.easynet.net>
Da Witch wrote at Tue, 01 Oct 2002 17:21:05 +0200:
> I originally posted the post quoted below, but many respondents said
> that they could not comment without seeing a description of the
> algorithm and/or the code. Here I post both.
> ...
> Here's the algorithm and the code. The description below is skimpy
> despite its length. That is because the algorithm is somewhat
> complicated (that's the reason I originally didn't post any code). A
> full description would have made this post even less readable than it
> is.
>
> The problematic part is the one in the subroutine main.
Perhaps a bit pedantic,
but a main routine shouldn't have any problematic parts in :-))
(it should be only a calling of 2/3/4 procedures or so).
> This algorithm analyzes a collection of "adjectives", each of which is
> associated with a set of "names" (in the sample data, both adjectives
> and names are simulated as zero-padded 4-digit positive integers).
> These associations are encoded in the hash-of-hashes %adj: the keys of
> %adj are the adjectives; each value of %adj is a hashref pointing to a
> hash whose keys are names, and whose values are all a boolean true.
>
> The analysis is based on an ordered list of "names" called @nameslist.
> All the names mentioned in %adj appear exactly once in @nameslist. An
> "initial segment" is any slice of @nameslist of the form
> $nameslist[0..$m], where 0 <= $m <= $#nameslist. For any "adjective"
> A (key of %adj), and any initial segment S, one can compute a measure
> P of how A is over- or underrepresented in S (when compared with its
> overall frequency statistics in %adj). For each adjective, the
> algorithm determines the initial segment with a smallest value of P
> (keeping track of whether this value refers to an over- or
> underrepresentation).
I didn't follow the whole basic idea description,
as it seems to be too technical.
Is there a chance to describe it with more simple words.
If I understand correctly,
you're interested in some (perhaps semantic) relationships between some data elements.
(It seems to be independent - from an algorithmic standpoint - that we are
talking about adjectives, as nouns, picture pixels, ... seems to be similar).
You valuate the relationship with mathematic formulae,
that seems to come from statistics.
The details I don't understand,
but I'm sure it's possible to explain them in some sentences.
>
> For a given A and S, P can be computed as follows. Define:
>
> a = number of names in S that are associated with A
> b = number of names in S that are not associated with A
> c = number of names not in S that are associated with A
> d = number of names not in S that are not associated with A
> ab = a+b
> cd = c+d
> ac = a+c
> bd = b+d
> tot = a+b+c+d
> top = max(ab, ac)
top = max(ab, ac) = max(a+b, a+c) = a + max(b,c) ?!
>
> If a > (ab*ac/tot), then (formally) P is the sum obtained from the
> loop (in pseudocode):
>
> sum = 0
> while(a <= top)
> sum = sum + ab!*cd!*ac!*bd!/(a!*b!*c!*d!*tot!)
> a = a+1
> d = d+1
> b = b-1
> c = c-1
> end
In the loop,
ab, cd, ac, bd, tot aren't changed,
so we don't need to sum the up in the loop:
So it's equavilent to
sum = 0;
while (a <= top) {
sum += 1/a! * b! * c! * d!
a++
b--
c--
d++
}
sum = sum * (top - a + 1) * (ab! * cd! * ac! * bd!) / tot!
So the job is only to calculate
SUM_i( 1/(a+i)! + 1/(b-i)! + 1/(c-i)! + 1/(d+i)! )
[in a LaTeX notion]
I'm not sure, but there could also exist a closed form or
a good approximation.
You should ask a mathematician for it.
> If a < (ab*ac/tot), then P is the sum obtained from the loop:
> sum = 0
> while(a >= 0)
> sum = sum + ab!*cd!*ac!*bd!/(a!*b!*c!*d!*tot!)
> a = a-1
> d = d-1
> b = b+1
> c = c+1
> end
Similar to above.
> If a == (ab*ac/tot), then we use the first loop if top - a < a, and
> the second loop otherwise.
>
> In addition to using exponentiations of sums of logs of factorials to
> compute the individual terms in the sum, the algorithm uses several
> tricks to speed up the computation of P. It relies on the fact that
> the result of the sum doesn't change for certain permutations of a, b,
> c, and d, but it is faster to compute when a is the smallest of all
> four numbers. (Permuting these arguments can toggle variable that
> keeps track of whether P corresponds to an over- or
> underrepresentation.) Also, since the terms of the sum decrease
> monotonically, we use a heuristic to stop the summation loop once we
> reached the desired accuracy (which is not very high).
Reading this,
seems to suggest for some subs.
There is at least one that does some calculation stuff and
one that controls when to stop.
>
> For a given adjective A, to find the smallest P (or actually, since P
> is always between 0 and 1, the largest -log P) for all the initial
> segments the algorithm uses one further shortcut. The array @namelist
> can be regarded as an alternating succession of blocks such that all
> the names 'N' in each block have the same value (true or false) for
> $adj{'A'}{'N'}. The initial segment with the smallest P cannot
> contain only part of such a block. Therefore, to find the smallest P
> it is necessary look only at the values of P for initial segments that
> consist of whole blocks.
>
> h
>
> ========================================================================
Allthough, I believe that the most speed up possibility is
regarding to the algorithm and not the program,
I'll try to give some hints how to write a bit more Perlish.
>
> #!/usr/bin/perl
>
> use strict;
use warnings;
It doesn't need time.
At least not when developping.
> my %adj; # Hash of hashes keyed by
> # "adjectives"; $adj{'xyz'} is a
> # hashref whose keys are "names" and
> # whose values are all a boolean true.
>
> my %tallies; # Hash whose keys are the same as the
> # keys of %adj, and whose values are
> # the number of "names" associated
> # with each "adjective" in %adj.
>
> my @nameslist; # A list of "names".
>
> my $tot; # The size of @nameslist.
The size of @nameslist is
scalar @nameslist
It's a good chance to implement a bug
when you self count.
> my @lf; # Precomputed logs of factorials.
>
> my $TRUE = (1 == 1);
Unnecessary to define true or false in Perl.
> my $PRECISION = 5e-02;
>
> sub main {
> for my $x (keys %adj) {
> my $adj = $adj{$x};
Quicker and simpler is
while (my ($x, $adj) = each %adj) {
...
BTW: $x is not a good name for a variable;
> my $a = 0;
> my $b = 0;
$a and $b are a bit global variables
(used when sorting).
It's confusing to mix them with normal _production_ code.
> my $c = $tallies{$x};
> next unless $c;
> my $d = $tot - $c;
>
> my @subtallies;
> my $s;
What does $s stand for ?
> my $state = $s = $adj->{$nameslist[0]};
> my $cume = 0;
What is $cume for ?
> my $i = 0;
> for (@nameslist[1..$#nameslist]) {
> ++$cume;
> if ($state != $adj->{$_}) {
> $subtallies[$i++] = $cume;
> $cume = 0;
> $state = !$state;
> }
> }
> $subtallies[$i] = ++$cume;
>
> my $mx = -1;
> my @argmx;
You don't use @argmx in the next 20 lines.
>
> for my $subtally (@subtallies) {
> if ($s) {
> $a += $subtally;
> $c -= $subtally;
> }
> else {
> $b += $subtally;
> $d -= $subtally;
> }
> $s = !$s;
>
> my ($aa, $bb, $cc, $dd) = ($a, $b, $c, $d);
> my $pty = $TRUE;
>
> # Normalize inputs so that $aa is smallest
> if ($dd < $cc) {
> if ($dd < $bb) {
> if ($dd < $aa) { # $dd smallest
> ($aa, $bb, $cc, $dd) = ($dd, $cc, $bb, $aa);
> }
> }
> elsif ($bb < $aa) { # $bb smallest
> ($aa, $bb) = ($bb, $aa);
> ($cc, $dd) = ($dd, $cc);
> $pty = !$pty;
> }
> }
> elsif ($cc < $bb) {
> if ($cc < $aa) { # $cc smallest
> ($aa, $cc) = ($cc, $aa);
> ($bb, $dd) = ($dd, $bb);
> $pty = !$pty;
> }
> }
> elsif ($bb < $aa) { # $bb smallest
> ($aa, $bb) = ($bb, $aa);
> ($cc, $dd) = ($dd, $cc);
> $pty = !$pty;
> }
Wow, you really implemented a sort algorithm for exactly 4 elements.
Are you sure that it is the quickest method.
The sorting in Perl is just one opcode and so very quick,
but you are using many opcodes (regarding to the Perl compiled).
Just try also
my ($aa, $bb, $cc, $dd) = sort {$a <=> $b} ($a,$b,$c,$d);
(Here we see the disadvantage of variables like $a,$b).
>
> my ($ab, $ac) = ($aa + $bb, $aa + $cc);
> my $num =
> $lf[$ab] + $lf[$cc + $dd] +
> $lf[$ac] + $lf[$bb + $dd] - $lf[$tot];
> my $p = 0;
> my $high;
> my $top;
> my $check = ($ab*$ac)/$tot;
> if ($aa == $check) {
> $top = $ab < $ac ? $ab : $ac;
> $high = ($top - $aa < $aa);
That's the same like
$high = ($top < 0);
> }
> else {
> $high = $aa > $check;
> $top = $ab < $ac ? $ab : $ac;
> }
$top = $ab < $ac ? $ab : $ac;
can be found either in the if case and in the else case.
It's also only a complicate way to say
$top = max ($ab, $ac);
>
> if ($high) {
> while ($aa <= $top) {
> my $add = exp($num - ($lf[$aa] + $lf[$bb] +
> $lf[$cc] + $lf[$dd]));
> $p += $add;
> last if $add*($top-$aa) < $PRECISION*$p;
^^^^^^^^^
> ++$aa; --$bb; --$cc; ++$dd;
> }
> }
> else {
> while ($aa >= 0) {
> my $add = exp($num - ($lf[$aa] + $lf[$bb] +
> $lf[$cc] + $lf[$dd]));
> $p += $add;
> last if $add*$aa < $PRECISION*$p;
> --$aa; ++$bb; ++$cc; --$dd;
> }
> }
That seems again something that could be calculated in a subroutine.
It would also help to understand what is calculated by.
> my $result = -log($p);
>
> if ($mx < $result) {
> $mx = $result;
> @argmx = ($a + $b, $result, $high == $pty);
> }
> }
> printf "%s %4d %f %c\n", $x,
> $argmx[0], $argmx[1], $argmx[2] ? '+' : '-';
> }
> }
>
> sub initialize {
> my ($adj, $q, $t) = &makedata;
> %adj = %{$adj};
> @nameslist = @{$q};
> %tallies = %{$t};
> $tot = @nameslist;
>
> @lf = (0);
> $lf[$_] = $lf[$_-1] + log($_) for (@lf..$tot);
> }
>
> sub makedata {
> srand(0);
>
> my $N = 6000;
> my $M = 4000;
> my %adj = map { sprintf("%04d", $_) => [] } (1..$M);
> my %nm;
> my %tallies;
> my @adj = @{rp([keys %adj])};
>
> for my $x (0..$#adj) {
> my $y = $tallies{$adj[$x]} = int(-3 + 10000/($x+3));
> my %tmp;
> while ((scalar keys %tmp) < $y) {
> my $w = sprintf("%04d", int(rand($N)+1));
> $nm{$w} = $tmp{$w} = $TRUE;
> }
> $adj{$adj[$x]} = { map { $_ => $TRUE }
> sort { $a <=> $b } keys %tmp };
> }
>
> (\%adj, rp([keys %nm]), \%tallies);
> }
>
> sub rp { # "randomly" permutes array in place
> my $p = shift;
> my $n = $#$p+1;
>
> for(my $i = $n; $i > 1; --$i) {
> my $j = int(rand($i));
> ($p->[$i-1], $p->[$j]) = ($p->[$j], $p->[$i-1]);
> }
> $p;
> }
>
> &initialize();
> &main();
Don't mix the &foo - style with the foo() - style
Greetings,
Janek
------------------------------
Date: Tue, 1 Oct 2002 11:32:33 -0600
From: "ColdCathoid" <me@me.com>
Subject: Store as BLOB vs as file
Message-Id: <ancmam$cv4pi$1@ID-158028.news.dfncis.de>
This may be slightly off topic and I do apoligise. The code to handle what I
want to do is written in perl. So .. yeah .. onto my question.
I wrote some cgi in perl that allows users of my website to upload images to
my server. What I am wondering is what would be the best method to store the
files. Currently I have it set up to have the files written to a folder and
have information relating to them stored in a db table.
The other option is to have the images written to a mysql database as a
binary file along with all other corresponding data.
When I go to access them out later for viewing which is better? Does one
perform better then another? Are there any issues with storing binaries in a
mysql db?
My setup is Apache 1.3.20, perl 5.005 w/ DBI support and MySQL
------------------------------
Date: Tue, 01 Oct 2002 17:30:34 GMT
From: tadmc@augustmail.com (Tad McClellan)
Subject: Top posting (was Re: How can I count files in a directory?)
Message-Id: <slrnapjm73.1nd.tadmc@magna.augustmail.com>
Rubber Duck <rubberducky703@hotmail.com> wrote:
> Top Post????
http://www.tuxedo.org/~esr/jargon/html/entry/top-post.html
http://www.geocities.com/nnqweb/nquote.html
http://mail.augustmail.com/~tadmc/clpmisc.shtml
--
Tad McClellan SGML consulting
tadmc@augustmail.com Perl programming
Fort Worth, Texas
------------------------------
Date: 6 Apr 2001 21:33:47 GMT (Last modified)
From: Perl-Users-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin)
Subject: Digest Administrivia (Last modified: 6 Apr 01)
Message-Id: <null>
Administrivia:
The Perl-Users Digest is a retransmission of the USENET newsgroup
comp.lang.perl.misc. For subscription or unsubscription requests, send
the single line:
subscribe perl-users
or:
unsubscribe perl-users
to almanac@ruby.oce.orst.edu.
To submit articles to comp.lang.perl.announce, send your article to
clpa@perl.com.
To request back copies (available for a week or so), send your request
to almanac@ruby.oce.orst.edu with the command "send perl-users x.y",
where x is the volume number and y is the issue number.
For other requests pertaining to the digest, send mail to
perl-users-request@ruby.oce.orst.edu. Do not waste your time or mine
sending perl questions to the -request address, I don't have time to
answer them even if I did know the answer.
------------------------------
End of Perl-Users Digest V10 Issue 3894
***************************************
