[24344] in Perl-Users-Digest
Perl-Users Digest, Issue: 6533 Volume: 10
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Thu May 6 21:05:39 2004
Date: Thu, 6 May 2004 18:05:08 -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 Thu, 6 May 2004 Volume: 10 Number: 6533
Today's topics:
Re: hashes and array's <dave.verhoeven@pandora.be>
Re: hashes and array's <tore@aursand.no>
Re: hashes and array's <dave.verhoeven@pandora.be>
hashs and symbolic refrences (TonyShirt)
Re: List questions on form (Roger)
Re: List questions on form (Roger)
Re: List questions on form <noreply@gunnar.cc>
Looking for a Expect like module <ashutosh.jog@pdf.com>
Module Tie::Handle::Intercepted <john@newchester.com>
Re: newbie; appending multiple files <krahnj@acm.org>
Re: read from comma delimited file <jtc@shell.dimensional.com>
Remove elements from one array found in another <bryan@akanta.com>
Re: Remove elements from one array found in another <chiefS@edu.edu>
Re: Remove elements from one array found in another <tore@aursand.no>
Re: Remove elements from one array found in another <bryan@akanta.com>
Re: Remove elements from one array found in another <krahnj@acm.org>
RFC: Module Physics::Measurement <john@newchester.com>
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Thu, 06 May 2004 22:14:33 GMT
From: "Dafke8" <dave.verhoeven@pandora.be>
Subject: Re: hashes and array's
Message-Id: <dNymc.1513$oE1.281872545@hestia.telenet-ops.be>
>
> <span id="..." class="...">kjsadf</span>
>
> in a few places in the document?
>
> > sub list_name2number(@){
>
> There is no point to this prototype, really.
>
> > my @tekst = @_;
> > my @namen;
> > my $naam;
> > my $aktenummer;
> > my $akte;
> > my %naamnrs;
>
> Declare your variables in the smallest scope possible.
>
> >
> > foreach $akte(@tekst){
> > if($akte =~
> > m!<span\s+class="akte"\s+id="[0-9]+-[0-9]+">(.*?)</span>!g){
> > $akte =~
> > m!<span\s+class="akte"\s+id="[0-9]+-[0-9]+">(.*?)</span>!g;
> > ($aktenummer = $1);
> > }
>
> Why are you matching twice? Why (.*?)
>
> >
> > @namen = ();
> > push @namen,$akte =~
> > m!<span\s+class="naam"\s+id="n[0-9]+">(.*?)</span>!g;
I've answerd the questions in another post in this thread.
But one question about
>
> If you insist on using a regex to do this, might I suggest something along
> the following lines. (Untested code. Also, I don't speak Flemmish, so I
> might have misinterpreted the intended uses of the variables.):
>
> #! perl
>
> use strict;
> use warnings;
>
> my $tekst = join '', <DATA>;
>
> my @list;
>
> while($tekst =~
m!<span\s+class="akte"\s+id="([0-9]+-[0-9]+)">(.+?)</span>!
> sg) {
> push @list, { 'id' => $1, 'name' => $2 };
> }
>
Gonna try it like that.
> use Data::Dumper;
> print Dumper \@list;
>
> __DATA__
>
> <span class="akte" id="1723-223">test dude</span><span class="akte"
> id="1323-23">test 2</span><span class="akte" id="23-22">test
> me</span><span class="akte" id="172-223">hi test dude</span><span
> class="akte"
> id="13-2">yo, dude!</span>
>
>
> C:\Home> t8.pl
> $VAR1 = [
> {
> 'name' => 'test dude',
> 'id' => '1723-223'
> },
> {
> 'name' => 'test 2',
> 'id' => '1323-23'
> },
> {
> 'name' => 'test
> me',
> 'id' => '23-22'
> },
> {
> 'name' => 'hi test dude',
> 'id' => '172-223'
> },
> {
> 'name' => 'yo, dude!',
> 'id' => '13-2'
> }
> ];
Thanks for all the help, it was realy useful.
greetz,
Dafke
------------------------------
Date: Fri, 07 May 2004 00:59:28 +0200
From: Tore Aursand <tore@aursand.no>
Subject: Re: hashes and array's
Message-Id: <pan.2004.05.06.22.47.56.507032@aursand.no>
On Thu, 06 May 2004 22:02:39 +0000, Dafke8 wrote:
>> You _really_ should check the outcome of this patch before you try to use
>> anything from it. What happens if the match fails?
>>
>> if ( $akte =~ m!<span\s+class="naam"\s+id="n[0-9]+">(.*?)</span>!g ) {
>> push( @namen, $1 );
>> }
> Now i did the following:
> push @namen,$akte =~ m!<span\s+class="naam"\s+id="(n[0-9]+)">(.*?)</span>!g;
> is it the same as:
> if ( $akte =~ m!<span\s+class="naam"\s+id="n[0-9]+">(.*?)</span>!g ) {
> push( @namen, $1 ,$2);
> }
No. As I said (above): You _really_ should check if there is a match
before you try to push anything to @namen. What do you think get pushed
to that list if your regular expression doesn't match?
--
Tore Aursand <tore@aursand.no>
"Scientists are complaining that the new "Dinosaur" movie shows
dinosaurs with lemurs, who didn't evolve for another million years.
They're afraid the movie will give kids a mistaken impression. What
about the fact that the dinosaurs are singing and dancing?" (Jay Leno)
------------------------------
Date: Thu, 06 May 2004 23:16:02 GMT
From: "Dafke8" <dave.verhoeven@pandora.be>
Subject: Re: hashes and array's
Message-Id: <SGzmc.1537$rt4.293675175@hestia.telenet-ops.be>
"Tore Aursand" <tore@aursand.no> schreef in bericht
news:pan.2004.05.06.22.47.56.507032@aursand.no...
> On Thu, 06 May 2004 22:02:39 +0000, Dafke8 wrote:
> >> You _really_ should check the outcome of this patch before you try to
use
> >> anything from it. What happens if the match fails?
> >>
> >> if ( $akte =~ m!<span\s+class="naam"\s+id="n[0-9]+">(.*?)</span>!g )
{
> >> push( @namen, $1 );
> >> }
>
> > Now i did the following:
> > push @namen,$akte =~
m!<span\s+class="naam"\s+id="(n[0-9]+)">(.*?)</span>!g;
> > is it the same as:
> > if ( $akte =~ m!<span\s+class="naam"\s+id="n[0-9]+">(.*?)</span>!g )
{
> > push( @namen, $1 ,$2);
> > }
But will this work?
> No. As I said (above): You _really_ should check if there is a match
> before you try to push anything to @namen. What do you think get pushed
> to that list if your regular expression doesn't match?
>
>
> --
> Tore Aursand <tore@aursand.no>
> "Scientists are complaining that the new "Dinosaur" movie shows
> dinosaurs with lemurs, who didn't evolve for another million years.
> They're afraid the movie will give kids a mistaken impression. What
> about the fact that the dinosaurs are singing and dancing?" (Jay Leno)
>
------------------------------
Date: 6 May 2004 17:39:30 -0700
From: tonyshirt@hotmail.com (TonyShirt)
Subject: hashs and symbolic refrences
Message-Id: <52d54c07.0405061639.51856993@posting.google.com>
I'm trying to parse a file with tag=value relationships. The file
looks something like this:
PRIMER_SEQUENCE_ID=1568502
SEQUENCE=GAGCCCCCAGCCTCTGCACTTTCCACCAGCTCAGTCTCTAGGGCTTTATCTTTCTCTGTTCATTGTTACCCGTTGCCAGCTTTAGCTCAGTGTTGTGTGAGCCACACTTCTTCATCATTGAGGTGTTCCTGTTGTCAGTGGGCTAGCTAAGGGCAGAAGGGCATTCGTGGGATTTTAAAGAATTTATGGGACCAACATTCTTTCCGCCTTCAGCAGATACCGATTATGTTTCCAGGAGGTGGGATGTGCCAGAAGCCGTCACCTCTTTTTGTTTCTCCCCTGCCTGCCTTCTTTCTCTTTTCCTCTTTCTCAATAAACAGATACTGTCTGTGTGTCTGCCTCACCTAATCTAACCCTCAGATTGCAGACAGTGCTTTATTTAGACCCAAAG
TTATGAGTCCTGATTGTGTTTTCCTGCTGGTCCCATCTGCTGTCTGTCTTTCAGTGGGCATCCACCGTTGTGGACCCAGGGATGGTTATGGGAAGCAAAACGTCTCCCTTAATCATAAACAGTGTCTACCAGTGGAAGCCCATCGACCGAGGGATCAGAGGCCTCTCAGTAGTATTGTTTATTGCAGTTCCTTGGCAACATTGCAGAGAGGCAGTCAGGTTCTGAAATACAACTGAGGTTATTGGCAGGCTGAGGCCCTGGCACAGGCACCTTCTAGAATATCAGCTAGTGTCTTGGCTTTCCTCTGGGGGGATCCCGTTGCTGTTGTGTTACAGAAATGGTAGTTGTTTACTCCAACAGTCTGGATGACCGCATAGAGGAACTATTTCARTAGTGACTG
CATCATTTTTTTTTTAACCTCGTAAACCTTTCACAGTTCAGGGGCCTTGGATCTTATTTTGAAGACAGGTGCAAATTGGAAATAGCATTTGAATATGACCCGGCAAAGCATGATTGCTTCTTAAGCTCAAGTATGAGATCTGTTTTGCAATCAGCTTGTCCAAGATGGTTATCTCTTCACTGTCAAATCAAAGTGCTCTGCATGGTGTTTAGAGATTGGGATGGTGAGGAGAGAGCAAGCCTGGGTATGTGCATGCATCTGTTTATTCTAGGCTTCGTGCCTCCAGGAGCTTGGAGGTCAGCTTGTAGTATAATAAAATAGAAAACTATACAGCCGGGGAGAACAGAAGCAGAATAGAAGGATAAAGTGTTGTTCATATCTCTCGGGCAAATTTTACCCA
ATTCTGACGAGCAGTTACTGCACAAGCAACAACAAAGGGACCTAGAGTGTGTTCATTGCCAATTCTGTCCATTTGGCTACATAACTACTGTGAACCAATACAAAAAGATATGTATAAAC
PRIMER_LIBERAL_BASE=1
TARGET=782,1
PRIMER_OPT_SIZE=18
PRIMER_MIN_SIZE=15
PRIMER_MAX_SIZE=45
PRIMER_OPT_TM=58.0
PRIMER_MIN_TM=52
PRIMER_MAX_TM=90
PRIMER_MAX_DIFF_TM=10.0
PRIMER_MIN_GC=25.0
PRIMER_MAX_GC=70.0
...
PRIMER_INTERNAL_OLIGO_4_SELF_END=1.00
PRIMER_LEFT_4_END_STABILITY=7.9000
PRIMER_RIGHT_4_END_STABILITY=7.3000
PRIMER_PAIR_4_COMPL_ANY=6.00
PRIMER_PAIR_4_COMPL_END=0.00
PRIMER_PRODUCT_SIZE_4=145
=
PRIMER_SEQUENCE_ID=2273703
SEQUENCE=ACAGAAAAGAGTCTATGAAAGCATGGAATTCCATAAAAATAATTTCTGAATGTTCAGTGTSACTTCCATATGTGCTCAGCAGTCCAGCAAGGTGTACCTGAGCTCACTTCCTCTGTCACCC
PRIMER_LIBERAL_BASE=1
TARGET=60,1
PRIMER_OPT_SIZE=18
PRIMER_MIN_SIZE=15
PRIMER_MAX_SIZE=45
PRIMER_OPT_TM=58.0
PRIMER_MIN_TM=52
PRIMER_MAX_TM=90
PRIMER_MAX_DIFF_TM=10.0
PRIMER_MIN_GC=25.0
PRIMER_MAX_GC=70.0
PRIMER_NUM_NS_ACCEPTED=2
PRIMER_PRODUCT_SIZE_RANGE=61-175
...
and so on. Each record starts with the SEQUENCE tag and ends with
=\n.
If your familiar with BioPerl its BoulderIO format. I'm aware of the
BioPerl Modules,
but its too much detail and too little documentation for this project.
I built a class to implement my parsersub:
package P3Wrapper;
use strict;
use Carp;
#Class constructor.
sub new{
my $self ={};
my $class = shift;
bless($self,$class);
return $self;
}#End New
sub ParseBIO{
my $self = shift;
my $BIOfile = shift;
my $tag = "";
my $value = "";
my $SeqID = "";
my %DataHash = ();
eval{
open(IN, $BIOfile) || croak "Can not open Boulder file
$BIOfile. $!";
while(<IN>){
if ($_ =~ /(.+)=(.+)/){
$tag = $1;
$value = $2;
}
if ($tag eq "PRIMER_SEQUENCE_ID"){
$SeqID = $value;
}elsif($SeqID ne ""){
$DataHash{$SeqID} = {$tag => $value}; #I think the
problem is here!
}
if ($_ =~ /=\n/){ #Reset, End of Record
$SeqID = "";
}
}#END while
close IN;
};#END EVAL
if ($@){
return (0,$@,undef);
}else{
return (1,"ok",\%DataHash);
}
}#End ParseBIO
and I built a little Driver to test it:
#use strict;
use diagnostics;
use P3Wrapper;
use Data::Dumper;
my $outputBIO = "Design_test/test3.P3OUT";
my $P3 = P3Wrapper->new("Design_test/");
my ($rc,$msg,$Hash) = $P3 ->ParseBIO($outputBIO);
print Dumper $Hash;
The idea for the parser was that it didn't matter which tags were
used,
they were recorded in the hash with their values. Notice the
commented out pragma.
I found that I was using symbolic references quite by accident, and I
had to take out
the strict pragma. The problem is that I am capturing only one tag
per key. see below.
This is probably due the way I'm adding each tag to the hash (The
problem comment). I'm guessing, but I think
I'm only getting the last tag in each sub hash because of the
implementation of the symbolic references.
Here is what I get when I run the driver:
$VAR1 = {
'235546' => {
'PRIMER_PRODUCT_SIZE_4' => '140'
},
'1799929' => {
'PRIMER_ERROR' => 'INCLUDED_REGION length <
min PRIMER_
PRODUCT_SIZE_RANGE'
},
'5499' => {
'PRIMER_PRODUCT_SIZE_4' => '85'
}
};
Is there a way to incrementally add to the hash using symbolic tag
references? All the examples
I looked at show the hash being initialized all together. Any Help
would be appreciated.
Thanks
------------------------------
Date: 6 May 2004 16:36:04 -0700
From: roger10232001@yahoo.com (Roger)
Subject: Re: List questions on form
Message-Id: <a872a169.0405061536.3c84fb9a@posting.google.com>
"Chief S." <chiefS@edu.edu> wrote in message
>
> Why 17? Are you understanding splice() correctly?
> @end = @list[16..19];
> splice (@list,16,17, "Z", "X"); # after this 18..21 are undef
on account of ...
# remove elements 1 and 2
# replace with new values
splice (@rainbow, 1, 2, "yellow", "orange");
I got the above line of code from:
http://www.devshed.com/c/a/Perl/Array-Manipulation-in-Perl/7/
just trying to learn here. From the above splice example it looks like
you could go...
splice (@myarray, 1,2,3,4,5,"valfor1","valfor2","valfor3", "valfor4",
"valfor5";
but that does not seem to work.
I have read the docs on split but the above example sort of got me on
the wrong path. Thanks for your help. I'm still working on it.
Roger
------------------------------
Date: 6 May 2004 16:45:29 -0700
From: roger10232001@yahoo.com (Roger)
Subject: Re: List questions on form
Message-Id: <a872a169.0405061545.9d39d65@posting.google.com>
Gunnar Hjalmarsson <noreply@gunnar.cc> wrote in message news:<2fvg9jF2ql5fU1@uni-berlin.de>...
> Roger wrote:
> >
>
> Something's missing here:
>
> use strict;
> use warnings;
>
> > @list = ("w","d","e","e","d","r","f","e","d",
> > "c","v","g","h","t","y","h","g","t","h","y","D","P");
>
> Better written as
>
> my @list = qw/w d e e d r f e d c v g h t y h g t h y D P/;
>
> > while( @list ) # just debugging here
> > {
>
> A while loop like that makes an endless loop. Take it away.
>
> > @end = @list[16..19];
> > splice (@list,16,17, "Z", "X"); # after this 18..21 are undef
>
> You should study the documentation for splice():
>
> perldoc -f splice
>
> One thing you'll notice is that the third argument is the number of
> elements to be removed. Your use of 17 indicates that you have
> misunderstood that.
>
> > splice(@list ,18,1, @end);
>
> The push() function would be more suitable here.
>
> perldoc -f push
>
> This is an easier way to accomplish the exchange of elements:
>
> my @end = splice @list, 16;
> push @list, 'Z', 'X', @end[0..3];
>
> > ($Fld1) = "|" . join "|", @list ;
> > ($Fld1) .= "|";
> > print $Fld1;
>
> No need to concatenate the parts into a scalar variable.
>
> print '|', (join '|', @list), "|\n";
>
> > #It might be a hash would be a better choice, but my
> > #'expertise' does not yet reach to that data type
>
> Can't see how a hash would be better.
Thanks for your reply I am studying it. I thought I understood splice,
will have to read more.
Roger
------------------------------
Date: Fri, 07 May 2004 01:50:46 +0200
From: Gunnar Hjalmarsson <noreply@gunnar.cc>
Subject: Re: List questions on form
Message-Id: <2g01kaF2qdjrU1@uni-berlin.de>
Roger wrote:
> "Chief S." <chiefS@edu.edu> wrote in message
>>Why 17? Are you understanding splice() correctly?
>
>> @end = @list[16..19];
>> splice (@list,16,17, "Z", "X"); # after this 18..21 are undef
>
> on account of ...
> # remove elements 1 and 2
> # replace with new values
> splice (@rainbow, 1, 2, "yellow", "orange");
Yes: 'Remove 2 elements, starting with element 1'.
--
Gunnar Hjalmarsson
Email: http://www.gunnar.cc/cgi-bin/contact.pl
------------------------------
Date: Thu, 06 May 2004 16:02:00 -0700
From: Ash <ashutosh.jog@pdf.com>
Subject: Looking for a Expect like module
Message-Id: <109lgtn7k7m4qcd@corp.supernews.com>
Hi,
Does anyone know of any other perl module than Expect.pm? I am writing a
script and within it need to log into another machine, perform a bunch
of commands and then get logout. Commonsense points to expect but I am
looking for a uncommonsense solution.
Help is appreciated in advance.
Thanks.
------------------------------
Date: Thu, 6 May 2004 17:45:44 -0500
From: "John" <john@newchester.com>
Subject: Module Tie::Handle::Intercepted
Message-Id: <c7ef5m$p3$1@news.f.de.plusline.net>
What do y'all think of this module? Do we need it on CPAN? Is it apty
named? Other comments? Documentation included below.
=head1 NAME
Tie::Handle::Intercepted - Intercept, Filter, Reroute, and Fork File
Handles.
=head1 SYNOPSIS
###Intercept
intercept \*STDOUT, sub {
print STDERR "Luppy!\n"; #If we print to STDOUT, we will cause an
infinite loop!
}
print "Hello, World!"; #Outputs "Luppy!" to STDERR
###Filter
filter \*STDOUT, sub {uc(shift)}; #Make all output uppercase.
print "Hello, World!\n"; #Outputs "HELLO, WORLD!"
###Reroute to a file
reroute \*STDERR, ">error.log";
warn "Arghh!"; #Prints "Arghh!" to error.log
###Fork
fork_handle \*STDERR, ">>error.log";
warn "Arghh!": #Prints the warning to STDERR *and* to error.log
###Capture to a scalar, array, or file
my $myscalar;
my $filter = reroute \*STDOUT, \$myscalar;
print "Hello, World!";
release_all_handlers \*STDOUT;
print "Scalar is: $scalar\n"; #Outputs "Scalar is: Hello, World!"
=head1 DESCRIPTION
This module provides a convenient way to intercept, filter, reroute, and
fork filehandles, without using the Perl tie interface.
C<intercept> causes all output to the given handle to be intercepted and
passed to the supplied handler subroutine.
C<filter>, C<reroute>, and C<fork_handle> are implemented via C<intercept>.
Look at the definition of these methods for a good example of how to use
C<intercept>.
This module has some cool features:
- Multiple handlers can be chained.
- Handlers can uninstall themselves.
- Handler subroutines can access the handle they intercepted.
=head2 Uninstalling a Handler
If you install a hander with C<lexically_scoped> => 1 , then an object will
be returned that will release the handler when it goes out of scope. You
can also call C<release> on this object to acheive the same result.
{
my $filter = filter \*STDERR, sub { uc($_[0]) }, lexically_scoped => 1;
print "foo"; #Prints "FOO"
} #The handler uninstalls itself now that it's going out of scope.
print "foo"; #Prints "foo"
=head2 Chaining Handlers
If you install a handler on a handle that already has a handler installed,
the new handle will be installed "in front" of the original handler. For
example:
my $scalar;
reroute \*STDOUT, \$scalar;
filter \*STDOUT, sub { uc{$_[0]} };
print "Hello, World!";
#Result:
$scalar eq "Hello, World!" or die "It didn't work!";
=head2 Accessing the Original Filehandle
The package variable C<$Tie::Handle::Intercepted::original_handle> gives you
a reference to the original handle. Examine the definition of the C<filter>
below to see how this can be useful.
sub filter {
my($handle, $sub, %args) = @_;
my $thing = intercept $handle, sub {
my $return_value = &$sub(@_);
print $original_handle $return_value;
}, %args, keep_original => 1;
}
Don't worry, $original_handle uses the magic of Perl C<local> variables to
ensure that it always contains the correct reference, even when chaining
handlers.
=cut
------------------------------
Date: Thu, 06 May 2004 23:09:34 GMT
From: "John W. Krahn" <krahnj@acm.org>
Subject: Re: newbie; appending multiple files
Message-Id: <409AC59B.9AF907AF@acm.org>
"A. Sinan Unur" wrote:
>
> sjwallacew@hotmail.com (Steve) wrote in news:eb6d00cc.0405061257.5b167226
> @posting.google.com:
> >
> > I have files 1.txt, 2.txt, 3.txt.......n.txt. Each file contains a
> > single line of text. I need each line of text from all these source
> > files to be appended into a single destination file called bulk.txt.
>
> And your Perl question is ...?
>
> cat ?.txt > bulk.txt
>
> ought to do it.
The OP said append so that should be:
cat ?.txt >> bulk.txt
John
--
use Perl;
program
fulfillment
------------------------------
Date: 6 May 2004 18:14:28 -0600
From: Jim Cochrane <jtc@shell.dimensional.com>
Subject: Re: read from comma delimited file
Message-Id: <slrnc9ll75.6eq.jtc@shell.dimensional.com>
In article <c7c5a2$2565c$1@ID-184292.news.uni-berlin.de>, Gunnar Hjalmarsson wrote:
> Jim Cochrane wrote:
>> I bet it's possible to come up with an RE for the split that would
>> work, but it will not be an easy task.
>
> It depends. Under certain circumstances you can do such things pretty
> easily with a regex. This is an example of a similar (not identical)
> problem:
>
> http://groups.google.com/groups?selm=c4eojm%242idocb%241%40ID-184292.news.uni-berlin.de
>
Yes, but it appears to be harder with split, because you can't use (...)
grouping without affecting the result of the split. I just learned about
this while playing around with another problem last night.
--
Jim Cochrane; jtc@dimensional.com
[When responding by email, include the term non-spam in the subject line to
get through my spam filter.]
------------------------------
Date: Thu, 06 May 2004 22:15:26 GMT
From: Bryan <bryan@akanta.com>
Subject: Remove elements from one array found in another
Message-Id: <2Oymc.61176$My3.52071@newssvr25.news.prodigy.com>
Hi, I need a function that will remove any elements of the second array
from the first. I found a function that does mostly what I want but its
not behaving the way I want in one case.
For example, if I have two arrays;
@a1 = (1, 2, 3, 4, 5);
@a2 = (2, 4);
@a1 = sub removeArrayElements(\@a1, \@a2);
This works just fine, and @a1 = (1, 3, 5);
But if @a1 is empty;
@a1 = ();
@a2 = (2, 4);
The function returns @a1 = (4, 2), when I would like it to return ().
I believe the basic functionality for this function is from the perl
cookbook, so maybe Im using the wrong thing (don't have the cookbook
handy). Or is this the right function and it just needs to be tweaked?
Thanks,
B
sub removeArrayElements {
my ($a, $b) = @_;
my @a = @$a;
my @b = @$b;
my (@diff,%count);
my (%HASH_A,%HASH_B);
# build hashes to remove redundant elements
@HASH_A{@a}=(); # hash slice, sets @a as keys of %HASH_A
@HASH_B{@b}=();
# set $count{$e} to 2 if the element exists in both hashes
# $count{$e} will be 1 if the element is unique
foreach my $e (keys %HASH_A,keys %HASH_B) { $count{$e}++ }
# writes the hash key (the element) to @diff if it is unique
foreach my $e (keys %count) {
push @diff, $e if ($count{$e} == 1);
}
return @diff;
}
------------------------------
Date: Thu, 06 May 2004 17:50:28 -0500
From: "Chief S." <chiefS@edu.edu>
Subject: Re: Remove elements from one array found in another
Message-Id: <c7effk$2dn$1@lenny.tc.umn.edu>
Bryan wrote:
> Hi, I need a function that will remove any elements of the second array
> from the first. I found a function that does mostly what I want but its
> not behaving the way I want in one case.
>
> For example, if I have two arrays;
>
> @a1 = (1, 2, 3, 4, 5);
> @a2 = (2, 4);
Won't this do the trick?
$seen{$_} = 1 for @a2;
@a1 = grep ! $seen{$_}, @a1;
--
Chief S.
------------------------------
Date: Fri, 07 May 2004 00:59:29 +0200
From: Tore Aursand <tore@aursand.no>
Subject: Re: Remove elements from one array found in another
Message-Id: <pan.2004.05.06.22.58.30.622112@aursand.no>
On Thu, 06 May 2004 22:15:26 +0000, Bryan wrote:
> sub removeArrayElements {
> my ($a, $b) = @_;
> my @a = @$a;
> my @b = @$b;
> my (@diff,%count);
> my (%HASH_A,%HASH_B);
>
> # build hashes to remove redundant elements
> @HASH_A{@a}=(); # hash slice, sets @a as keys of %HASH_A
> @HASH_B{@b}=();
>
> # set $count{$e} to 2 if the element exists in both hashes
> # $count{$e} will be 1 if the element is unique
> foreach my $e (keys %HASH_A,keys %HASH_B) { $count{$e}++ }
>
> # writes the hash key (the element) to @diff if it is unique
> foreach my $e (keys %count) {
> push @diff, $e if ($count{$e} == 1);
> }
>
> return @diff;
> }
Don't be so hard to yourself. As far as I can tell from your question,
this function should do (untested);
sub removeArrayElements {
my $a1 = shift;
my $a2 = shift;
my %hash;
$hash{$_}++ for ( @$a2 );
my @new = grep { not $hash{$_} } @$a1;
return \@new;
}
--
Tore Aursand <tore@aursand.no>
"War is too serious a matter to entrust to military men." (Georges
Clemenceau)
------------------------------
Date: Thu, 06 May 2004 23:03:04 GMT
From: Bryan <bryan@akanta.com>
Subject: Re: Remove elements from one array found in another
Message-Id: <Iuzmc.61188$GT3.31602@newssvr25.news.prodigy.com>
Chief S. wrote:
> Bryan wrote:
>
>> Hi, I need a function that will remove any elements of the second
>> array from the first. I found a function that does mostly what I want
>> but its not behaving the way I want in one case.
>>
>> For example, if I have two arrays;
>>
>> @a1 = (1, 2, 3, 4, 5);
>> @a2 = (2, 4);
>
>
> Won't this do the trick?
>
> $seen{$_} = 1 for @a2;
> @a1 = grep ! $seen{$_}, @a1;
>
Yes! Exactly what I was looking for, thank you.
B
------------------------------
Date: Thu, 06 May 2004 23:25:03 GMT
From: "John W. Krahn" <krahnj@acm.org>
Subject: Re: Remove elements from one array found in another
Message-Id: <409AC93D.38C9A75E@acm.org>
Bryan wrote:
>
> Hi, I need a function that will remove any elements of the second array
> from the first. I found a function that does mostly what I want but its
> not behaving the way I want in one case.
>
> For example, if I have two arrays;
>
> @a1 = (1, 2, 3, 4, 5);
> @a2 = (2, 4);
>
> @a1 = sub removeArrayElements(\@a1, \@a2);
^^^
That is a syntax error.
> This works just fine, and @a1 = (1, 3, 5);
>
> But if @a1 is empty;
> @a1 = ();
> @a2 = (2, 4);
>
> The function returns @a1 = (4, 2), when I would like it to return ().
>
> I believe the basic functionality for this function is from the perl
> cookbook, so maybe Im using the wrong thing (don't have the cookbook
> handy). Or is this the right function and it just needs to be tweaked?
>
>
> sub removeArrayElements {
>
> [snip]
This will do what you want:
sub removeArrayElements {
my ( $orig, $remove ) = @_;
my %seen = map { $_ => 1 } @$remove;
@$orig = grep !$seen{ $_ }, @$orig;
}
John
--
use Perl;
program
fulfillment
------------------------------
Date: Thu, 6 May 2004 18:48:06 -0500
From: "John" <john@newchester.com>
Subject: RFC: Module Physics::Measurement
Message-Id: <c7eiqk$2pa$1@news.f.de.plusline.net>
Physics::Measurement is a subclass of Physics::Unit::Scalar, but with
overloaded operators. Like it's superclass, the module allows the creation
of objects that represent physical quantities with encapsulated dimensions;
but Physics::Measurment objects provide some nifty features
I'm looking for input from the list: What do you think? Do we need it on
CPAN? Is it apty named? Other comments?
Features of Physics::Measurement objects
-Overloaded arithmetic and inequality operators
-Dies on operations on two measurments with incompatible quantities. So
you can't add 1 foot to 1 second, although you can divide 1 foot by 1
second.
-Automaticly stringified when interpolated into a string.
-Produces warning when used in a string comparison (cmp, gt, etc).
Otherwise things like
"2 minutes" lt new Physics::Measurement("40 seconds");
will cause hard-to-find bugs.
-Dies when used in numeric comparison with non-measurements. So you can't
compare "3 ounces" to 12.
-Automatically converts strings to measurements, when a measurement and a
string are used in a numeric operation:
(new Measurement("3 meters")) + "1 meter" == "4 meter"
-Always true in boolean expressions (in contrast to regular numbers, where
0 is false).
-(Not yet implemented) Significant figures and scientific notation.
I would like to use the Math::SigFigs module to handle this.
Examples
#Overloaded arithmetic and inequality operators
my $distance = new Physics::Measurement("3.0e8 m");
my $time = new Physics::Measurement("1 s");
my $speed = $distance / $time;
my $warp10 = $speed*10;
#Automatic stringification
print "Warp 10 is: $warp10\n";
###String comparison with strings produces warning.
if(1*meter gt "1 yard"); #Will compare the string "1 m" to "1 yard", and
produces false and a warning.
#Incomperable to other numbers
my $m = new Physics::Measurement("5 m");
$m + 10; #All these raise an exception
$m == 5; #...
$m < 10; #...
log($m) #...
#Numeric comparison with strings does automatic upgrade
my $speed = new Physics::measurement("60 mph");
$speed == "1 mile/minute"; #True.
$speed == "blah blah"; #Tries to parse blah blah and dies.
1*meter > "1 yard"; #True
###boolean always true
my $m = new Physics::Measurement('0 m');
$m and $m; #True...
------------------------------
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.
NOTE: due to the current flood of worm email banging on ruby, the smtp
server on ruby has been shut off until further notice.
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 6533
***************************************
