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 

Хорошая вещь об этом вы можете адаптировать его для кортежей размеров больше, чем два.

Кроме того, теперь, когда вы выбираете шаблон на основе первого символа линии, узоры сами становятся проще:

#!/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, Тэд McLellan заметил, что данные выглядят как Хох и предложил:

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

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