的Perl：从阵列拉双值

Question

考虑

#!/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 

我想在对$ T1与优雅环来代替重复，存储在数组中$ T2值（或其它结构）像

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

一个我没有在合并while，split和unshift有一个简短的尝试很成​​功。

我错过了什么简洁，优雅的解决方案？

---

P.S.我在过去使用过散列，但发现%h = (A=>'P', B=>'Q', C=>'R')语法“嘈杂”。它也很难延伸到三元组，四元组...

Answer 1

当散列+ each不够好（因为

• 在对列表中的第一元素不是唯一的，或者
• 您需要按特定顺序遍历这些对，或者因为您需要抓取三个或更多个元素而不是两个或者
• ...），

存在List::MoreUtils::natatime方法：

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 

通常，虽然，我就splice淘汰之列了这样一个任务中的第几个要素：

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"; 
} 

Answer 2

使用散列。

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

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

Answer 3

展开我的评论。

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

Answer 4

除非您可以保证第一个坐标始终是唯一的，否则一对的想法可以更好地表示为包含两个元素的单独数组。您也可以更容易地将相同的想法扩展到更高维的元组。

#!/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 

但是，用你的方法和上面的方法，你正在执行比必要的更多的匹配操作（每行三个而不是一个）。这使得@eugene's answer更有效率。

一个更普遍的解决方案是使用：

#!/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 

约这样做的好处是，你能适应它的尺寸的元组大于2。

此外，现在你是基于该行的第一个字符，图案选择所述模式本身变得更简单：

#!/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 

甲简单的替代方法（这需要捕获所有x=y）为：

#!/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 

这最后一个还可以很容易地从线拉出多个值：

#!/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 

Answer 5

Elsewhere

，泰德麦克莱伦观察到的数据看起来像一个环比，并建议：

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

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