[10525] in Perl-Users-Digest
Perl-Users Digest, Issue: 4117 Volume: 8
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Sat Oct 31 07:07:11 1998
Date: Sat, 31 Oct 98 04:00:16 -0800
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Perl-Users Digest Sat, 31 Oct 1998 Volume: 8 Number: 4117
Today's topics:
Re: 0 - 1 toggling question (Bart Lateur)
CPAN module <shulman@caltech.edu>
Re: CPAN module (Alastair)
help a poor student <mghalgh@goulburn.net.au>
Re: help a poor student (Sam Holden)
Re: Not to start a language war but.. (David Adler)
Re: Parsing large text file (TIA) <ebohlman@netcom.com>
Re: programing fun: trees: Level <xah@best.com>
Running CGI-scripts on NT? <megens@cistron.nl>
Re: Running CGI-scripts on NT? <minich@globalnet.co.uk>
Re: Very Large DBM file: Finding Number of keys (Mark-Jason Dominus)
Re: Very Large DBM file: Finding Number of keys (Mark-Jason Dominus)
Re: Very Large DBM file: Finding Number of keys <rra@stanford.edu>
Special: Digest Administrivia (Last modified: 12 Mar 98 (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Sat, 31 Oct 1998 10:11:05 GMT
From: bart.mediamind@ping.be (Bart Lateur)
Subject: Re: 0 - 1 toggling question
Message-Id: <3640ddfd.4281129@news.ping.be>
Matthew Bafford wrote:
>=> I recently found out that negating a variable that has "1" does change its
>=> value to null, not "0". How can I easily change its value to "0". the
>=> operators "!", "not" and "~" all seem to change the value to null.
>
>One option that comes to mind is (anything not 0 is changed to 0):
>
> $var = !$var+0;
>
>Not exactly pretty, but it works...
I think I prefer
$var = !$var || 0 ;
I don't understand why your version doesn't give any warnings when run
under -w. It looks like !(expr) acts like a warning disabler.
$var = undef() + 0;
Use of uninitialized value at test.pl line 7.
$var = '' + 0;
Argument "" isn't numeric in add at test.pl line 8.
$var = undef() || 0;
$var = '' || 0;
print $var;
0
No warnings in this case.
Bart.
------------------------------
Date: Sat, 31 Oct 1998 01:23:02 -0800
From: Michael Shulman <shulman@caltech.edu>
Subject: CPAN module
Message-Id: <363AD6F6.CB0C7482@caltech.edu>
I'm trying to run the CPAN CPAN module and it's not working. The setup
worked, and I got to the shell once, but I was forced to shut down the
command window externally and now whenever I run it I get a message
saying:
There seems to be running another CPAN process (92). Contacting...
kill process failed!
This persists even though I restarted my computer. I have be unable to
find a PID 92 running, either from task manager or from the prompt. Do
you have any idea what I can do? I have ActivePerl 5.00502 and Cygwin32
Beta 19 on WinNT 4.0. Thanks.
_________________________________________________________________________
| \/|R|TR|LB|/\ | QOTD: "The most dangerous strategy is to jump a
|
| Michael Shulman | chasm in two leaps." |
| shulman@caltech.edu | - Benjamin Disraeli |
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
------------------------------
Date: Sat, 31 Oct 1998 09:45:45 GMT
From: alastair@calliope.demon.co.uk (Alastair)
Subject: Re: CPAN module
Message-Id: <slrn73lqr9.5a.alastair@calliope.demon.co.uk>
Michael Shulman <shulman@caltech.edu> wrote:
>I'm trying to run the CPAN CPAN module and it's not working. The setup
>worked, and I got to the shell once, but I was forced to shut down the
>command window externally and now whenever I run it I get a message
>saying:
>
>There seems to be running another CPAN process (92). Contacting...
>kill process failed!
>
>This persists even though I restarted my computer. I have be unable to
>find a PID 92 running, either from task manager or from the prompt. Do
>you have any idea what I can do? I have ActivePerl 5.00502 and Cygwin32
>Beta 19 on WinNT 4.0. Thanks.
I'm not sure about NT but this has the hallmarks of being a lockfile issue. I
have a '.cpan' directory (unix) in my home directory that has a file called
'lock' in it when the CPAN module's active. Try removing it.
HTH.
--
Alastair
work : alastair@psoft.co.uk
home : alastair@calliope.demon.co.uk
------------------------------
Date: Sat, 31 Oct 1998 21:23:53 +1100
From: "James Greenhalgh" <mghalgh@goulburn.net.au>
Subject: help a poor student
Message-Id: <71eo9l$jrn$1@merki.connect.com.au>
We have to design a stupid text adventure in a language of our choice for
school. I know bugger all about perl but I want to learn. It probably seems
simple to anyone except a retard like me but what gives with this script?
msg me at mghalgh@goulburn.net.au . And could the smart arse programmers who
do it for a living please give the insults a miss.
#!usr/bin/perl
print " WELCOME TO THE DUNGEON OF LUNCHEONS \n";
print "You awaken in a stereotypical cell in your stereotpical medieval
clothes. A stereotypical goblin guard is guarding your stereotypical warrior
possesions. \n";
print "what now Gov? \n";
$a =<stdin>;
if ($a eq "look")
{
print "You look and find a dead chicken hanging off a piece of rope.
It appears to have been there for several days and the pungent aroma
repulses you even further. \n";
}
elsif ($a eq "eat")
{
print "you sick piece of shit!!";
}
else
{
print "what??";
}
Thank you
-0pium
------------------------------
Date: 31 Oct 1998 10:26:55 GMT
From: sholden@pgrad.cs.usyd.edu.au (Sam Holden)
Subject: Re: help a poor student
Message-Id: <slrn73lpff.p6c.sholden@pgrad.cs.usyd.edu.au>
On Sat, 31 Oct 1998 21:23:53 +1100, James Greenhalgh <mghalgh@goulburn.net.au>
wrote:
> $a =<stdin>;
>
> if ($a eq "look")
Seeing $a will in all likelyhood have a \n on the end the comparison will
never be true...
Try reading the documentation that comes with perl...
Especialy the chomp function.
You can find it in perlodc perlfunc funnnily enough.
--
Sam
compiling kernels is what I do most, so they do tend to stick to the
cache ;) --Linus Torvalds
------------------------------
Date: 31 Oct 1998 08:17:32 GMT
From: dha@panix.com (David Adler)
Subject: Re: Not to start a language war but..
Message-Id: <71eh2s$2cc@news1.panix.com>
On Mon, 26 Oct 1998 14:06:27 GMT, Andrew M. Kuchling
<akuchlin@cnri.reston.va.us> wrote:
>Jonathan Feinberg writes:
>>Tom Christiansen <tchrist@mox.perl.com> writes:
>>> Moore context and less ambiguity would seem to me to be a feature.
>> ^^^^^
>>Evidence that Perlers are Utopians at heart.
>
> Actually _Utopia_ was written by Sir Thomas More, not 'Moore'.
Hmm. I guess he meant that we are anti-naturalists, then. Or
possibly horses... :-)
dha, using that hard won philosophy degree at last
--
David H. Adler - <dha@panix.com> - http://www.panix.com/~dha/
perl is a language, and as such, is about as Y2K compliant as
Serbo-Croat. - David Cantrell in comp.lang.perl.misc
------------------------------
Date: Sat, 31 Oct 1998 09:41:32 GMT
From: Eric Bohlman <ebohlman@netcom.com>
Subject: Re: Parsing large text file (TIA)
Message-Id: <ebohlmanF1oqx8.22D@netcom.com>
John Porter <jdporter@min.net> wrote:
: Jamie Hoglund wrote:
: > Be careful, messing around with the new line variable will break nearly
: > everything else if it isn't restored.
: Right. That's why god invented local().
"But all I said was, 'this piece of code is good enough for Larry Wall'!"
"Blasphemy! He said it again!"
------------------------------
Date: Sat, 31 Oct 1998 03:32:13 -0700
From: "Xah" <xah@best.com>
Subject: Re: programing fun: trees: Level
Message-Id: <363af3e5$0$29744@nntp1.ba.best.com>
I wrote:
>Here's another fun programing problem on tree structures. ...
>I'll be posting my solution this Saturday or Sunday.
Attached below is my solution as promised. You can cut and paste and it'll run, where at the very end there's little test case provided. I decided to attach full documentation as well. I figured it is better that way because beginners here can read and learn about it, while gurus, masters, or other experts can better comment or correct.
Xah, xah@best.com
http://www.best.com/~xah/PageTwo_dir/more.html
perl5 -e'print"%^*(\@#! just another very ^}@&(!% obfuscated hacker\n"'
PS if you need a hard-wrapped version of this post, please email me.
#!/usr/local/bin/perl5 -w
use strict;
use Data::Dumper qw(Dumper); $Data::Dumper::Indent=0;$Data::Dumper::Deepcopy=1;
#-------
#_____ TreeToIndexSet _____ _____ _____ _____
=pod
B<TreeToIndexSet>
TreeToIndexSet(tree) returns a list of all atoms (leaves) and their positions that represents the tree completely. The return value consists of pairs of position indexes and corresponding atoms.
The input tree must have the form [[...],...] where an atomic element is anything that is not a reference to an array. The return value is a reference to an array, of the form [[positionIndex1, atom1],[positionIndex2,atom2],...], where each positionIndex has the form [n1,n2,...].
Unimplemented extension: TreeToIndexSet(tree,levelspec) returns the indexes and corresponding subexpression at levspec. xxxxx
Related: xxxxx IndexSetToExpression.
Example:
TreeToIndexSet( [0,1,2,3] );
#returns [[[0],0],[[1],1],[[2],2],[[3],3]]
TreeToIndexSet( [[3,4],'b',[[7,8],'love']] );
#returns [[[0,0],3],[[0,1],4],[[1],'b'],[[2,0,0],7],[[2,0,1],8],[[2,1],'love']]
TreeToIndexSet( [[[1,1],[1,2]],[[2,1],[2,2]],[[3,1],[3,2]]] );
#returns: [[[0,0,0],1],[[0,0,1],1],[[0,1,0],1],[[0,1,1],2],[[1,0,0],2],[[1,0,1],1],[[1,1,0],2],[[1,1,1],2],[[2,0,0],3],[[2,0,1],1],[[2,1,0],3],[[2,1,1],2]]
# hash references can also serve as atoms, but not recommended.
TreeToIndexSet ( [[3,4],[{'key1' => 1,'key2' => 2}, 5]] )
#returns: [[[0,0],3],[[0,1],4],[[1,0],{'key1' => 1,'key2' => 2}],[[1,1],5]]
=cut
# implementation note:
# Dependent functions: (none)
# misc notes: this function needs heavy testing. xxxxx
#push (@EXPORT, q(TreeToIndexSet));
#push (@EXPORT_OK, q(TreeToIndexSet));
# A interface gate for the possibility of adding input error checking.
sub TreeToIndexSet ($) {
return _treeToIndexSet($_[0]);
};
sub _treeToIndexSet ($) {
my $ref_tree = $_[0];
my @result;
# &$_recursor(currentPositionIndex, ASubexpression) ... works like this:
# loop through ASubexperssion.
# if an element is an atom, then add the index (currentPositionIndex,$i) to the result.
# else, do &$_recursor( (currentPositionIndex,$i), $currentElement)
my $rf_recursor;
$rf_recursor = sub {
my $ref_currentPosition = $_[0];
my $ref_input = $_[1];
for my $i (0 .. $#{$ref_input}) {
if (ref $ref_input->[$i] ne 'ARRAY')
{push( @result, [[(@{$ref_currentPosition},$i)], $ref_input->[$i] ]);}
else
{&$rf_recursor( [(@{$ref_currentPosition},$i)], $ref_input->[$i] ); };
};
};
&$rf_recursor([],$ref_tree);
return \@result;
};
#_____ CompleteIndexSet _____ _____ _____ _____
=pod
B<CompleteIndexSet>
CompleteIndexSet([index1,index2,...]) returns a modified version of argument in which indexes that are implied by givens are inserted. The elements in the result list is arbitrary ordered, and without duplicates.
Related: MinimumIndexSet, FullArrayIndexSet, IndexSetSort.
Example:
The empty array [] in the result represents the index for the root node.
IndexSetSort( CompleteIndexSet( [[2, 1]] ) );
#returns [[],[0],[1],[2],[2,0],[2,1]].
IndexSetSort( CompleteIndexSet( [[2, 1], [3]] ) );
#returns [[],[0],[1],[2],[3],[2,0],[2,1]].
IndexSetSort( CompleteIndexSet( [[2, 1], [3], [3]] ) );
#returns [[],[0],[1],[2],[3],[2,0],[2,1]].
IndexSetSort( CompleteIndexSet( [[3, 3], [4]] ) );
#returns [[],[0],[1],[2],[3],[4],[3,0],[3,1],[3,2],[3,3]].
IndexSetSort( CompleteIndexSet( [[3, 3], [1, 1], [4]] ) );
#returns [[],[0],[1],[2],[3],[4],[1,0],[1,1],[3,0],[3,1],[3,2],[3,3]].
=cut
# implementation note:
# some description:
# Suppose one of the given index is {a,b,c,d}. If the last digit is not 0, then generate {a,b,c,d-1}. If the last digit is 0, then generate {a,b,c}. Add the new element into a result list. Now take new element as input and repeat the process until it becomes {}. Now do the above with every given index. Now eliminate duplicates and {} in the result list. The result is as desired.
# Dependent functions: (none)
# misc notes: this function needs heavy testing.
#push (@EXPORT, q(CompleteIndexSet));
#push (@EXPORT_OK, q(CompleteIndexSet));
sub CompleteIndexSet ($) {
# arg checks here...
return _completeIndexSet(@_);
};
sub _completeIndexSet ($) {
my @indexList = @{$_[0]};
my %indexListHash;
foreach my $elem (@indexList) {$indexListHash{"@{$elem}"} = $elem;};
foreach my $ref_index (@indexList) {
my @index = @{$ref_index};
LOOP1: while (@index) {
if ($index[-1]-- == 0) {pop(@index);};
if (exists $indexListHash{"@index"}) {last LOOP1;};
$indexListHash{"@index"} = [@index];
};
};
return [values %indexListHash];
};
# _nodeDepth(completeIndexSet, index) returns the depth of the index.
# problem: given an index I and a complete index set S, how to find the depth of the index?
# solution:
# 1. find all the indexes that starts with the same components as I. (i.e. all offsprings of I, including itself.)
# 2. count the number of the trailing components. The answer is max+1.
sub _nodeDepth ($$) {
my @indexSet = @{$_[0]};
my @index = @{$_[1]};
my $length = scalar @index;
@indexSet = grep {
my $temp =1;
HH: for (my $i=0; $i <= $#index; $i++) {
if ($index[$i] != $_->[$i]) {$temp =0; last HH;};
};
$temp;
} (grep {scalar @{$_} >= $length} @indexSet);
my $result = $length;
foreach $_ (@indexSet) {
if (scalar @{$_} > $result) {$result = scalar @{$_};};
};
return $result -$length + 1;
};
#_____ IndexSetSort _____ _____ _____ _____
=pod
B<IndexSetSort>
IndexSetSort([index1,index2,...]) returns the indexes sorted. This is equivalent to IndexSetSort([index1,index2,...],0,1,1). The indexes have the form [[a1,a2,...],[b1,b2,...],...].
IndexSetSort([index1,index2,...], $sortByIndexFirstQ, $indexAscendingQ, $lengthAscendingQ) returns the indexes sorted. The rest of the parameters are booleans specifying the sorting criterions application order and directions.
The indexes are sorted using two criterions: (1) index number sequence from left to right. (2) the length of the indexes.
sortByIndexFirstQ controls which criterion will be used first. The other two arguments indexAscendingQ, lengthAscendingQ controls the ascending or decending direction for each criterion. The three booleans forms a total of 8 possible ways of ordering. Any number of the booleans can be omitted. User specified booleans will replace the defaults (0, 1, 1) from the left.
Example:
IndexSetSort([[0], [1, 0], [1, 1, 0], [1, 1, 1], [1, 1, 2], [1, 1], [1, 2, 0], [1, 2, 1], [1, 2, 2], [1, 2], [1], [2, 0], [2, 1, 0], [2, 1, 1], [2, 1, 2], [2, 1], [2, 2, 0], [2, 2, 1], [2, 2, 2], [2, 2], [2]], 0, 1, 1);
Depending on the last three arguments, it returns one of the following:
#(0,0,0)
#sort by (depth decending, then index decending).
#[[2,2,2],[2,2,1],[2,2,0],[2,1,2],[2,1,1],[2,1,0],[1,2,2],[1,2,1],[1,2,0],[1,1,2],[1,1,1],[1,1,0],[2,2],[2,1],[2,0],[1,2],[1,1],[1,0],[2],[1],[0]];
#(0,0,1)
#sort by (depth ascending, then index decending).
#[[2],[1],[0],[2,2],[2,1],[2,0],[1,2],[1,1],[1,0],[2,2,2],[2,2,1],[2,2,0],[2,1,2],[2,1,1],[2,1,0],[1,2,2],[1,2,1],[1,2,0],[1,1,2],[1,1,1],[1,1,0]];
#(0,1,0)
#sort by (depth decending, then index ascending).
#[[1,1,0],[1,1,1],[1,1,2],[1,2,0],[1,2,1],[1,2,2],[2,1,0],[2,1,1],[2,1,2],[2,2,0],[2,2,1],[2,2,2],[1,0],[1,1],[1,2],[2,0],[2,1],[2,2],[0],[1],[2]];
#(0,1,1)
#sort by (depth ascending, then index ascending). (Common)
#[[0],[1],[2],[1,0],[1,1],[1,2],[2,0],[2,1],[2,2],[1,1,0],[1,1,1],[1,1,2],[1,2,0],[1,2,1],[1,2,2],[2,1,0],[2,1,1],[2,1,2],[2,2,0],[2,2,1],[2,2,2]];
#(1,0,0)
#sort by (index decending, then depth decending).
#[[2,2,2],[2,2,1],[2,2,0],[2,2],[2,1,2],[2,1,1],[2,1,0],[2,1],[2,0],[2],[1,2,2],[1,2,1],[1,2,0],[1,2],[1,1,2],[1,1,1],[1,1,0],[1,1],[1,0],[1],[0]];
#(1,0,1)
#sort by (index decending, then depth ascending).
#[[2],[2,2],[2,2,2],[2,2,1],[2,2,0],[2,1],[2,1,2],[2,1,1],[2,1,0],[2,0],[1],[1,2],[1,2,2],[1,2,1],[1,2,0],[1,1],[1,1,2],[1,1,1],[1,1,0],[1,0],[0]];
#(1,1,0)
#Sort by (index ascending, then depth decending): (Common)
#[[0],[1,0],[1,1,0],[1,1,1],[1,1,2],[1,1],[1,2,0],[1,2,1],[1,2,2],[1,2],[1],[2,0],[2,1,0],[2,1,1],[2,1,2],[2,1],[2,2,0],[2,2,1],[2,2,2],[2,2],[2]];
#(1,1,1)
#Sort by (index ascending, then depth ascending): (Common)
#[[0],[1],[1,0],[1,1],[1,1,0],[1,1,1],[1,1,2],[1,2],[1,2,0],[1,2,1],[1,2,2],[2],[2,0],[2,1],[2,1,0],[2,1,1],[2,1,2],[2,2],[2,2,0],[2,2,1],[2,2,2]];
=cut
# implementation note:
# Dependent functions: _indexOrdering
# misc notes: this function needs heavy testing. The speed can also be improved greatly by eleminating the inner loop in the sort, using Swatze transform technique instead. Basically: convert all indexes to same length strings, and sort this string. xxxxx'
#push (@EXPORT, q(IndexSetSort));
#push (@EXPORT_OK, q(IndexSetSort));
# _indexOrdering([a1,a2,...],[b1,b2,...]) returns -1, 0, or 1 by comparing the number sequence in each array reference from left to right. If both begins with the same sequence, then it returns 0. The length of the arrays has no effect. Example: print "@{[_indexOrdering([2,2],[2,3,3])]}";
sub _indexOrdering ($$) {
my @array1 = @{$_[0]};
my @array2 = @{$_[1]};
my $minLength;
if (scalar @array1 < scalar @array2) {$minLength = scalar @array1}
else {$minLength = scalar @array2};
for my $i (0..$minLength -1) {
if ($array1[$i] <=> $array2[$i]) {return $array1[$i] <=> $array2[$i];}
};
return 0;
};
sub IndexSetSort ($;$$$) {
if (scalar @_ == 1) {return _indexSetSortFullArguments($_[0],0,1,1);};
if (scalar @_ == 2) {return _indexSetSortFullArguments($_[0],$_[1],1,1);};
if (scalar @_ == 3) {return _indexSetSortFullArguments($_[0],$_[1],$_[2],1);};
return _indexSetSortFullArguments(@_);
};
#_indexSetSortFullArguments([index1, index2,...], sortByIndexFirstQ, indexAscendingQ, lengthAscendingQ)
sub _indexSetSortFullArguments ($$$$) {
my @indexList = @{$_[0]};
my $sortByIndexFirstQ = $_[1];
my ($indexAscendingQ, $lengthAscendingQ) = ($_[2],$_[3]);
if ($sortByIndexFirstQ) {
if ($indexAscendingQ) {
if ($lengthAscendingQ) {@indexList = sort {_indexOrdering($a,$b) || scalar @{$a} <=> scalar @{$b} } @indexList;}
else {@indexList = sort {_indexOrdering($a,$b) || scalar @{$b} <=> scalar @{$a} } @indexList;}
}
else {
if ($lengthAscendingQ) {@indexList = sort {_indexOrdering($b,$a) || scalar @{$a} <=> scalar @{$b} } @indexList;}
else {@indexList = sort {_indexOrdering($b,$a) || scalar @{$b} <=> scalar @{$a} } @indexList;}
};
}
else {
if ($indexAscendingQ) {
if ($lengthAscendingQ) {@indexList = sort {scalar @{$a} <=> scalar @{$b} || "@{$a}" cmp "@{$b}"} @indexList;}
else {@indexList = sort {scalar @{$b} <=> scalar @{$a} || "@{$a}" cmp "@{$b}"} @indexList;}
}
else {
if ($lengthAscendingQ) {@indexList = sort {scalar @{$a} <=> scalar @{$b} || "@{$b}" cmp "@{$a}" } @indexList;}
else {@indexList = sort { scalar @{$b} <=> scalar @{$a} || "@{$b}" cmp "@{$a}" } @indexList;}
};
};
return \@indexList;
};
#_____ Level _____ _____ _____ _____
=pod
B<Level>
Level(tree, [n]) returns a list of all nodes that are on the nth level of the tree. Level 0 is the root, consisting of the whole tree. Level 1 is the immediate elements in the list, i.e. those accessible by $tree->[m1]. Level 2 are those accessible by $tree->[m1][m2], and so on.
If n is negative, levels are counted from leaves to root. That is, Level(tree, [-n]) for a positive n returns all nodes in the tree that have depth n. The depth of a tree, Depth(tree), is the maximum number of indices needed to specify any node, plus one. (i.e. a node at level n for a positive n has depth n+1.) (see Depth.)
Level( tree, [n, m]) returns a list of all nodes of the tree that's on levels n to m inclusive. Either one of n or m can be negative. For example, Level( tree, [2,-2]) returns all nodes on level 2 or more, and has depth 2 or greater.
Level( tree, n) is equivalent to Level( tree, [1, n]).
In general, the form is Level( tree, levelspec), where levelspec has one of the forms: n, [n], [n, m], where the first two forms are shortcuts. That is, n is equivalent to [1,n], and [n] is equivalent to [n, n].
If the levelspec is beyond the depth of the tree, or if it doesn't make sense (e.g. [5,3] or [-3,-5]), an empty list is returned. (i.e. []). Note: levelspec such as [3,-2] is not necessarily illegal.
Nodes in the result list is ordered by their position indexes' components ascending (i.e. [2,1] comes before [3].). When there is a tie (e.g. [2] vs. [2,1]), index length descending is used (i.e. [2,1] comes before [2]). For example, here's a complete index set sorted the way Level would: [[0],[1,0],[1,1,0],[1,1,1],[1,1,2],[1,1],[1,2,0],[1,2,1],[1,2,2],[1,2],[1],[2,0],[2,1,0],[2,1,1],[2,1,2],[2,1],[2,2,0],[2,2,1],[2,2,2],[2,2],[2]]. See IndexSetSort for details about sorting nodes.
Related: Part, Extract.
Example:
Level( $tree, [0]); # returns [ $tree ].
Level( $tree, [1]); # returns $tree unchanged.
Level( [[1,2],[3,[44]],'a'], [2]); # returns [ 1,2,3,[44] ].
Level( [[1,2],[3,[44]],'a'], [3]); # returns [ 44 ].
Level( [[1,2],[3,[44]],'a'], [-1]);
# returns all the leaves [ 1,2,3,44,'a' ]. In other words, atoms or leaves are those having depth 1.
Level( [[1,2],[3,[44]]], [-2]);
# returns [ [1,2], [44] ] because both element has depth 2.
Level( [[1,2],[3,[44]]], [-3]); # returns [ [3,[44]] ]
Level( [[1,2],[3,[44]]], [-4]);
#returns [ [[1,2],[3,[44]]] ] because the whole tree has depth 4.;
Level( [[1,2],[3,[44]]], [-5]);
# returns [ ] because the tree has depth 4. i.e. It's root node has depth 4. No other node can have depth greater than the root.;
Level( [[1,2],[3,[44]]], [1,2]);
# returns [ 1, 2, [1,2], 3, [44], [3,[44]] ]
# the result consists of all nodes that requires 1 or 2 indexes to access.
# their position indexes in the tree are:
# [0,0], [0,1], [0], [1,0], [1,1], [1]
# note the order returned.
Level( [[1,2],[3,[44]]], [1,3]);
# returns [ 1, 2, [1,2], 3, 44, [44], [3,[44]] ]
# these are nodes on levels 1 to 3.
# their position indexes are
# [0,0], [0,1], [0], [1,0], [1,1,0], [1,1], [1]
Level( [[1,2],[3,[44]]], [2,3]);
# returns [ 1, 2, 3, 44, [44] ]
# their position indexes are
# [0,0], [0,1], [1,0], [1,1,0], [1,1]
Level( [[1,2],[3,[44]]], [2,-1]);
# returns [ 1, 2, 3, 44, [44] ]
Level( [[1,2],[3,[44]]], [2,-2]);
# returns [ [44] ] because [44] is the only node on level 2 or greater and have a depth of 2 or more.
Level( [[1,2],[3,[44]]], [1,-2]);
# returns [ [1,2], [44], [3,[44]] ]
# these are nodes on level 1 or greater and have a depth of 2 or more.
Level( [[1,2],[3,[44]]], [-10,-2]);
# returns [ [1,2], [44], [3,[44]], [[1,2],[3,[44]]] ]
# i.e. all nodes having depth <= 10 and >= 2. Their depths are 2, 2, 3, 4.
Level( [[1,2],[3,[44]]], [-2,1]);
# returns [ [1,2] ];
# i.e. all nodes having depth <= 2 and on level <= 1.
Level( [[1,2],[3,[44]]], [-2,2]);
# returns [ 1,2,[1,2],3,[44] ];
# i.e. all nodes having depth <= 2 and on level <= 2.
Level( [[1,2],[3,[44]]], [-2,3]);
# returns [1,2,[1,2],3,44,[44]];
# i.e. all nodes having depth <= 2 and on level <= 3.
=cut
# implementation note:
# plan:
# 0. Given a tree and a levelSpec.
# 1. Create a complete index set of the tree.
# 2. Select those indexes specified by the levelSpec.
# 3. Sort this by standard tree-traversing order. (i.e. index ascending; depth descending.)
# 4. Extract these elements from given tree. The result is as desired.
# similar algorithm can be used for implementing Map. On the 4th step, apply the given function to nodes of the tree specified by the indexes. Use forms like $ref_tree->[n1][n2] = f($ref_tree->[n1][n2]). Note that the order of applying a function to nodes is very important. Step 3 must be followed.
# step 3 may need some explanation:
# problem: given a complete index set and a levelSpec, how to determine which node's in it?
# answer:
# Since all levelSpec can be rewritten in the form [A,B], suppose we are given levelSpec [A,B]. Let a and b be the absolute value of A and B.
# Suppose A is positive and B is negative, then:
# If the length of a node is greater or equal to a, and its depth is greater or equal to b, then it is in the levelSpec.
# The following are other possible combination of signs, and their corresponding methods:
# l means the node's length and d means its depth.
# signs , predicates (both must be satisfied)
# + + , l >= a, l <= b
# + - , l >= a, d >= b
# - + , d <= a, l <= b
# - - , d <= a, d >= b
# if a or b is 0, treat them as positive here.
# Dependent functions: _treeToIndexSet, _completeIndexSet, _indexSetSortFullArguments.
#push (@EXPORT, q(Level));
#push (@EXPORT_OK, q(Level));
sub Level ($$) {
# input checks here...
return _level(@_);
};
sub _level ($$) {
# this function converts levelSpec to a full form, then pass it to _levelWithFullArgs.
if ( ref $_[1] eq 'ARRAY') {
if (scalar @{$_[1]}==1) {return _levelWithFullArgs($_[0], [$_[1]->[0], $_[1]->[0] ]); }
else {return _levelWithFullArgs( @_ ); };
} else {return _levelWithFullArgs($_[0], [1, $_[1]]); };
};
sub _levelWithFullArgs ($$) {
my $ref_tree = $_[0];
my ($A, $B) = @{$_[1]};
my ($a, $b) =(abs $A, abs $B);
my $ref_completeIndexSet = _indexSetSortFullArguments( _completeIndexSet([map {$_ = $_->[0];} @{ _treeToIndexSet($ref_tree)}]),1,1,0);
my $predicateString =
($A >= 0 ?
($B >= 0 ?
'((scalar @{$_} >= $a) and ( scalar @{$_} <= $b))':
'((scalar @{$_} >= $a) and ( _nodeDepth($ref_completeIndexSet, $_) >= $b))'
):
( $B >= 0 ?
'((_nodeDepth($ref_completeIndexSet, $_) <= $a) and (scalar @{$_} <= $b))':
'(( _nodeDepth($ref_completeIndexSet, $_) <= $a) and ( _nodeDepth($ref_completeIndexSet, $_) >= $b))'
)
);
my @result;
foreach my $ref_index (grep {eval $predicateString} @{$ref_completeIndexSet}) {
push @result, eval( '$ref_tree' . join('', @{[ map {"->[$_]"} @$ref_index]}) );
};
return \@result;
};
#end Level
#---------------------------------------
#testing
print Dumper Level( [[1,2],[3,[44]]], [-2,3]);
__END__
------------------------------
Date: Sat, 31 Oct 1998 12:35:21 +0100
From: PM <megens@cistron.nl>
Subject: Running CGI-scripts on NT?
Message-Id: <363AF5F9.E0FD2450@cistron.nl>
Dear reader,
Would it be possible to run CGI-scripts on a NT-server? If yes, how to
handle this?
Thanks in advance,
P. Megens
The Netherlands
------------------------------
Date: Sat, 31 Oct 1998 11:56:36 -0000
From: "Martin" <minich@globalnet.co.uk>
Subject: Re: Running CGI-scripts on NT?
Message-Id: <71etu3$86a$1@newnews.global.net.uk>
>Would it be possible to run CGI-scripts on a NT-server? If yes, how to
>handle this?
I'd recommend ActiveState Perl for use with Windows -
http://www.activestate.com/
Martin
------------------------------
Date: 31 Oct 1998 03:59:26 -0500
From: mjd@op.net (Mark-Jason Dominus)
Subject: Re: Very Large DBM file: Finding Number of keys
Message-Id: <71ejhe$fvh$1@monet.op.net>
In article <1dhqif4.1relptu1sigbqxN@bos-ip-1-96.ziplink.net>,
Ronald J Kimball <rjk@coos.dartmouth.edu> wrote:
>Mark-Jason Dominus <mjd@op.net> wrote:
>
>> > In a scalar context, keys returns the number of elements of the hash
>> > (and resets the each iterator). However, to get this information for
>> > tied hashes, including DBM files, Perl must still walk the entire
>> > hash, so it's not very efficient in that case.
>>
>> Just because it's not efficient doesn't mean you can do any better.
>> If you want to count something, you have to count it.
>
>You've already pointed out (in another post) that for regular hashes and
>keys() in a scalar context, Perl neither has to build a list nor count
>the keys. That sounds a lot more efficient to me than walking the
>entire hash to get the number of keys, as Perl must do with tied hashes.
Someone still has to do the counting; in the case of a builtin hash,
Perl does the counting for you. That doesn't mean there's no counting
going on. Every time you add or remove a key, Perl has to adjust the
count. Add a million keys, perl increments the count a million times.
That's counting. It doesn't matter if you count a million keys all at
once or one at a time; it takes the same time to do it either way.
The cost of counting the keys is similar to walking all the keys,
maybe more, maybe less. The reason you don't notice it is that unlike
walking the key list, which is charged all at once, maintaining the
count is amortized over the life of the hash so that you don't notice
it as much. But it's still there, like the cost of the `free buffet'.
>> In the case of internal hashes, Perl can count it as it goes along,
>> but it still takes time. The only reason it's a win is because Perl
>> has to keep track of the count whether you want it or not. It's like
>> a nightclub with a free buffet. The buffet is included in the cost of
>> the admission, and you might as well eat it because you've already
>> paid for it whether you wanted to or not.
>
>It's also a win if you need the count more than once.
>Walking the entire hash each time you need the count is obviously
>less efficient than incrementing and decrementing the count as the
>hash is modified, and just fetching a value each time you need the
>count.
Sometimes it's faster, sometimes it isn't. Here's a counterexample:
I'm going to add lots and lots of records to a hash, let's say a
million, and then I'm going to remove almost all of them, and I want
to know how many records are left at the end.
If the hash maintains the count, it has to adjust the count about two
million times, and my program will be that much slower. But if it
didn't maintain the count, and just counted the keys when I wanted
them counted, I would get off almost for free.
So it's not at all obvious that maintaining the count is more
efficient; sometimes it's wrong. It depends on what you are doing.
Now as it happens, Perl needs the count for other purposes, so you
have to pay for it even if you don't use it. And since you've paid
for it, you might as well use it. But that doesn't mean that you paid
the cheapest possible price. Like the buffet, it only *seems* free.
>Russ suggested using one entry in the hash to store the number of keys.
I thought I was doing Russ a favor when I replaced the hash entry with
a separate scalar value. But sure, if you want it to take even longer
to maintain the count, you go ahead and use that hash element.
>I would bet a dime that, for tied arrays, that is faster than letting
>Perl count them using 'keys' each time you need the count.
OK, you're on!
Here's code. First, a dummy tied hash class.
package Hash;
sub TIEHASH {
my $pack = shift;
bless {} => $pack;
}
sub FETCH {
$_[0]{$_[1]};
}
sub STORE {
$_[0]{$_[1]} = $_[2];
}
sub FIRSTKEY {
scalar each %{$_[0]}
}
sub NEXTKEY {
scalar each %{$_[0]}
}
Now here's the driver:
$N = 100_000;
tie %h => Hash;
my ($u1, $s1) = times;
for ($i = 0; $i < $N; $i++) {
#2# # Maintain the count
#2# if (! $h{$i}) {
#2# $h{TOTAL}++
#2# }
$h{$i} = $i;
}
#2# my $c = $h{TOTAL};
#1# # Just count the keys all at once
#1# my $c = scalar keys %h;
print "$c $N\n";
my ($u2, $s2) = times;
my ($u, $s) = ($u2-$u1, $s2-$s1);
print "u: $u; s: $s\n";
exit 0;
To benchmark this, run it once with the commesnts intact for a baseline.
Then try it twice more, once with #1# comments uncommented, once with
#2# comments uncommented. Results on my system:
Baseline: u: 29.52; s: 0.25 total 29.77
#1# scalar keys: u: 40.14; s: 0.31 total 40.45
#2# Maintain count: u: 85.49; s: 0.20 total 85.69
Gosh! You're, like, utterly wrong.
You're also out $.15.
More tests:
If you replace that silly $h{TOTAL} with a regular scalar variable
$TOTAL, the #2# time goes down to
#2.b# u: 59.17; s: 0.24 total 59.41
See, I told you I was doing you a favor.
But actually that (! $h{$i}) is wrong, because it should be (! exists
$h{$i}) instead. So let's fix it; now even with the favor, it takes
#2.c# u: 60.26; s: 0.31 total 60.57
I'll be looking for your check in the mail. Let me know if you don't
have my address.
>Of course, since it's a tied hash, you could have the STORE and DELETE
>methods maintain the value of $hash{TOTAL} for you.
1. Only if you control the source code for the tied class,
which you usually don't. (Rationale: Most uses of tied hashes are
for DBM files.)
2. Of course. But maintaining the count in the STORE and DELETE
methods takes just as long as maintaining it anywhere else. ``In
this country everyone must pay for everything he gets.'' (L. Frank Baum.)
Moral: There is no such thing as a free lunch.
------------------------------
Date: 31 Oct 1998 04:09:21 -0500
From: mjd@op.net (Mark-Jason Dominus)
Subject: Re: Very Large DBM file: Finding Number of keys
Message-Id: <71ek41$g08$1@monet.op.net>
In article <ylaf2d35eo.fsf@windlord.stanford.edu>,
Russ Allbery <rra@stanford.edu> wrote:
>Um, that wasn't my solution....
What I said: What Russ said:
> if (! $seen{$key}++) { if (++$UNIQUE_IPS{$ip} == 1) {
> $total++; $UNIQUE_IPS{TOTAL}++;
> } }
One of us is missing the point here. I'll suppose it's me. What am I
missing? They look the same to me.
>My solution is to store a total *in the hash*, using a distinguished key,
>and update it each time you add something to the hash. In other words,
>you slow down (slightly) each entry into the hash, but retrieval of the
>total number of keys in the hash then becomes an O(1) operation.
But maintaining the count is at least O(n) also! If the hash ends up
with n keys, you had to do at least n increments to keep the count current.
>My understanding of keys on tied hashes, even in a scalar context, is
>that it's still an O(n) operation
Yes. But it happens in C, whereas your code happens in Perl.
C is a lot faster than Perl.
>(as opposed to using keys on Perl native hashes, which is probably O(1)).
Just like that buffet. Free, once you get into the club.
The O() analysis is not particularly germane here anyway. The
multiplicative constant is important. See my other article for
benchmarks.
------------------------------
Date: 31 Oct 1998 01:09:39 -0800
From: Russ Allbery <rra@stanford.edu>
Subject: Re: Very Large DBM file: Finding Number of keys
Message-Id: <yl7lxhyu5o.fsf@windlord.stanford.edu>
Mark-Jason Dominus <mjd@op.net> writes:
> I thought I was doing Russ a favor when I replaced the hash entry with a
> separate scalar value. But sure, if you want it to take even longer to
> maintain the count, you go ahead and use that hash element.
It depends a *lot* on what you're doing. Suppose that you want to count
how many unique hostnames there are in the Received headers of incoming
mail. One way to do this would be to pipe all of your incoming mail
through a Perl script that reads the Received headers and adds those hosts
to a hash. In this case, using a scalar value to store the count is
obviously not going to work because it's not persistant.
The cost of incrementing a cumulative count in the hash is going to be
fairly negligible compared to the other things you're going to have to
(like lock your hash file).
On the other hand, for this particular application, it's hard to see why
you'd want the cumulative count *quickly*, so programming simplicitly
would probably win.
--
#!/usr/bin/perl -- Russ Allbery, Just Another Perl Hacker
$^=q;@!>~|{>krw>yn{u<$$<[~||<Juukn{=,<S~|}<Jwx}qn{<Yn{u<Qjltn{ > 0gFzD gD,
00Fz, 0,,( 0hF 0g)F/=, 0> "L$/GEIFewe{,$/ 0C$~> "@=,m,|,(e 0.), 01,pnn,y{
rw} >;,$0=q,$,,($_=$^)=~y,$/ C-~><@=\n\r,-~$:-u/ #y,d,s,(\$.),$1,gee,print
------------------------------
Date: 12 Jul 98 21:33:47 GMT (Last modified)
From: Perl-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin)
Subject: Special: Digest Administrivia (Last modified: 12 Mar 98)
Message-Id: <null>
Administrivia:
Special notice: in a few days, the new group comp.lang.perl.moderated
should be formed. I would rather not support two different groups, and I
know of no other plans to create a digested moderated group. This leaves
me with two options: 1) keep on with this group 2) change to the
moderated one.
If you have opinions on this, send them to
perl-users-request@ruby.oce.orst.edu.
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.misc (and this Digest), send your
article to perl-users@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.
The Meta-FAQ, an article containing information about the FAQ, is
available by requesting "send perl-users meta-faq". The real FAQ, as it
appeared last in the newsgroup, can be retrieved with the request "send
perl-users FAQ". Due to their sizes, neither the Meta-FAQ nor the FAQ
are included in the digest.
The "mini-FAQ", which is an updated version of the Meta-FAQ, is
available by requesting "send perl-users mini-faq". It appears twice
weekly in the group, but is not distributed in the digest.
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 V8 Issue 4117
**************************************
