Perl: Pulling pairs of values from an array

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?

P.S. I've used hashes in the past but find the %h = (A=>'P', B=>'Q', C=>'R') syntax "noisy". It's also ugly to extend to triplet开发者_如何学Gos, quads ...

When a hash + each isn't good enough (because

• the first elements in the list of pairs are not unique, or
• you need to iterate through the pairs in a particular order, or
• because you need to grab three or more elements instead of two, or
• ...),

there is the List::MoreUtils::natatime method:

use List::MoreUtils q/natatime/;

while(<DATA>) {
  my($t1,$t2,$value);
  my @pairs = qw(A P B Q C R);
  my $it = natatime 2, @pairs;
  while (($t1,$t2) = $it->()) {
      $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

Usually, though, I'll just splice out the first few elements of the list for a task like this:

while(<DATA>) {
  my($t1,$t2,$value);
  my @pairs = qw(A P B Q C R);
  # could also say  @pairs = (A => P, B => Q, C => R);
  while (@pairs) {
      ($t1,$t2) = splice @pairs, 0, 2;
      $value = $1 if /^$t1.*$t2=(.)/;
  }
  print "$value\n";
}

Use a hash.

my %map = ( A => 'P', B => 'Q', C => 'R' );

while (<DATA>) {
    my $re = substr($_, 0, 1) . ".*" . $map{ substr($_, 0, 1) } . "=(.)";
    /$re/;
    print "$1\n";
}

Unless you can guarantee that the first coordinate will always be unique, the idea of a pair is better represented as an individual array of two elements. You can also extend the same idea to tuples of higher dimensions much more easily.

#!/usr/bin/perl
use strict; use warnings;
use Data::Dumper;

my @tuples = ([qw(A P)],  [qw(B Q)], [qw(C R)]);
my $re_tmpl = '^%s.*%s=(.)';
my @re = map qr/$_/, map sprintf($re_tmpl, @$_), @tuples;

while (my $line = <DATA>) {
    last unless $line =~ /\S/;

    my ($value) = map { $line =~ $_ } @re;

    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

But, with your method and the method above, you are executing more match operations than necessary (three per line rather than one). That makes @eugene's answer more efficient.

A more general solution is to use:

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

my @tuples = ([qw(A P)],  [qw(B Q)], [qw(C R)]);
my $re_tmpl = '^%s.*%s=(.)';

my %re;
@re{ map $_->[0], @tuples } = map qr/$_/,
                              map sprintf($re_tmpl, @$_),
                              @tuples;

while (my $line = <DATA>) {
    last unless $line =~ /\S/;

    my ($value) = $line =~ $re{substr $line, 0, 1};

    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

The nice thing about this is you can adapt it for tuples of dimensions greater than two.

Also, now that you are selecting the pattern based on the first character of the line, the patterns themselves become simpler:

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

my @tuples = ([qw(A P)],  [qw(B Q)], [qw(C R)]);
my $re_tmpl = '%s=(.)';

my %re;
@re{ map $_->[0], @tuples } = map qr/$_/,
                              map sprintf($re_tmpl, $_->[1]),
                              @tuples;

while (my $line = <DATA>) {
    last unless $line =~ /\S/;

    my ($value) = $line =~ $re{substr $line, 0, 1};

    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

A simpler alternative (which entails capturing all the x=y) is:

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

my %pairs = qw(A P B Q C R);
my $re = qr/([A-Z])=([0-9])/;

while (my $line = <DATA>) {
    last unless $line =~ /\S/;

    my $type = substr $line, 0, 1;

    my $value = { $line =~ /$re/g }->{ $pairs{$type} };

    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 last one also makes it easy to pull multiple values from a line:

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

my %tuples = (A => [qw(P Q)], B => [qw(Q R)], C => [qw(P R)]);
my $re = qr/([A-Z])=([0-9])/;

while (my $line = <DATA>) {
    last unless $line =~ /\S/;

    my $type = substr $line, 0, 1;

    my @values = @{ { $line =~ /$re/g } }{ @{ $tuples{$type} } };

    print "@values\n";
}

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

To expand on my comment.

#!/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";
    }
}

Elsewhere, Tad McLellan observed that the data looks like an HoH and suggested:

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

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