Pulling pairs of values from an array

R

RedGrittyBrick

Consider

#!/usr/bin/perl
use strict;
use warnings;

while(<DATA>) {
my($t1,$t2,$value);
($t1,$t2)=qw(A P); $value = $1 if /^$t1.*$t2=(.)/;
($t1,$t2)=qw(B Q); $value = $1 if /^$t1.*$t2=(.)/;
($t1,$t2)=qw(C R); $value = $1 if /^$t1.*$t2=(.)/;
print "$value\n";
}

__DATA__
A P=1 Q=2 R=3
B P=8 Q=2 R=7
C Q=2 P=1 R=3

I'd like to replace the repetition with an elegant loop over pairs of
$t1,$t2 values stored in an array (or other structure) like one of

my @pairs = qw (A,P B,Q C,R);
my @pairs = qw (A P B Q C R);

I've not had much success with a brief attempt at combining `while`,
`split` and `unshift`.

What concise, elegant solution am I missing?


(Also posted to stackoverflow.com, let me know if you object. I'll post
a combined summary of answers to both fora as penance)
 
R

RedGrittyBrick

Consider

#!/usr/bin/perl
use strict;
use warnings;

while(<DATA>) {
my($t1,$t2,$value);
($t1,$t2)=qw(A P); $value = $1 if /^$t1.*$t2=(.)/;
($t1,$t2)=qw(B Q); $value = $1 if /^$t1.*$t2=(.)/;
($t1,$t2)=qw(C R); $value = $1 if /^$t1.*$t2=(.)/;
print "$value\n";
}

__DATA__
A P=1 Q=2 R=3
B P=8 Q=2 R=7
C Q=2 P=1 R=3

I'd like to replace the repetition with an elegant loop over pairs of
$t1,$t2 values stored in an array (or other structure) like one of

my @pairs = qw (A,P B,Q C,R);
my @pairs = qw (A P B Q C R);

I've not had much success with a brief attempt at combining `while`,
`split` and `unshift`.

What concise, elegant solution am I missing?


(Also posted to stackoverflow.com, let me know if you object. I'll post
a combined summary of answers to both fora as penance)

In
<http://stackoverflow.com/questions/...pairs-of-values-from-an-array/4470453#4470453>
Sorpigal suggested

#!/usr/bin/perl
use strict;
use warnings;

my %pairs = qw/A P B Q C R/;

foreach my $data (<DATA>) {
while(my($t1, $t2) = each(%pairs)){
$data =~ /^$t1.*$t2=(.)/ && print "$1\n";
}
}

Which I like. (YMMV)
 
R

RedGrittyBrick

RedGrittyBrick said:
Consider

#!/usr/bin/perl
use strict;
use warnings;

while(<DATA>) {
my($t1,$t2,$value);
($t1,$t2)=qw(A P); $value = $1 if /^$t1.*$t2=(.)/;
($t1,$t2)=qw(B Q); $value = $1 if /^$t1.*$t2=(.)/;
($t1,$t2)=qw(C R); $value = $1 if /^$t1.*$t2=(.)/;
print "$value\n";
}

__DATA__
A P=1 Q=2 R=3
B P=8 Q=2 R=7
C Q=2 P=1 R=3


That data looks like an HoH to me...

I'd like to replace the repetition with an elegant loop over pairs of
$t1,$t2 values stored in an array (or other structure) like one of

my @pairs = qw (A,P B,Q C,R);
my @pairs = qw (A P B Q C R);


my %pairs = qw/A P B Q C R/;

while (<DATA>) {
my($type, %values) = split /[\s=]/;
print "$values{$pairs{$type}}\n";
}

Thanks. The inventiveness of clpm contributors is a great source of
inspiration.

A Sinan Ünür posted four solutions with some commentary in
<http://stackoverflow.com/questions/...pairs-of-values-from-an-array/4470720#4470720>.
I'm not sure I can summarise it adequately so I'll just post the URL
here rather than paste it all in verbatim.
 
S

sln

Consider

#!/usr/bin/perl
use strict;
use warnings;

while(<DATA>) {
my($t1,$t2,$value);
($t1,$t2)=qw(A P); $value = $1 if /^$t1.*$t2=(.)/;
($t1,$t2)=qw(B Q); $value = $1 if /^$t1.*$t2=(.)/;
($t1,$t2)=qw(C R); $value = $1 if /^$t1.*$t2=(.)/;
print "$value\n";
}

__DATA__
A P=1 Q=2 R=3
B P=8 Q=2 R=7
C Q=2 P=1 R=3

I'd like to replace the repetition with an elegant loop over pairs of
$t1,$t2 values stored in an array (or other structure) like one of

my @pairs = qw (A,P B,Q C,R);
my @pairs = qw (A P B Q C R);

I've not had much success with a brief attempt at combining `while`,
`split` and `unshift`.

What concise, elegant solution am I missing?


(Also posted to stackoverflow.com, let me know if you object. I'll post
a combined summary of answers to both fora as penance)

You don't have to check all the pairs.
You can just get the value with a single if statement
per line of data. Its must faster this way.

Either of these will work (and there is validation so warnings
are not emitted) :

/^(\S+)/g && exists $pairs{$1} && /\G.*$pairs{$1}=(\S+)/
/^(\S+)(??{exists $pairs{$1} ? ".*$pairs{$1}=" : "(*FAIL)"})(\S+)/

-sln

-----------------------------
use strict;
use warnings;

my %pairs = qw/A P B Q C R/;

while ( <DATA> )
{
if (/^(\S+)/g && exists $pairs{$1} && /\G.*$pairs{$1}=(\S+)/) {
print $1,"\n";
}
}
__DATA__

A P=1 Q=2 R=3
B P=8 Q=2 R=7
C Q=2 P=1 R=3


Optional, uses extended regex (??{..}):
while ( <DATA> )
{
if (/^(\S+)(??{exists $pairs{$1} ? ".*$pairs{$1}=" : "(*FAIL)"})(\S+)/) {
print $2,"\n";
}
}
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Members online

Forum statistics

Threads
473,744
Messages
2,569,482
Members
44,901
Latest member
Noble71S45

Latest Threads

Top