Perl: извлечение пар значений из массива - PullRequest
1 голос
/ 17 декабря 2010

Рассмотрим

#!/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') «шумный». Также некрасиво распространяться на тройки, квады ...

Ответы [ 5 ]

9 голосов
/ 17 декабря 2010

Когда хеш + 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";
}
4 голосов
/ 17 декабря 2010

Если вы не можете гарантировать, что первая координата всегда будет уникальной, идея пары лучше представить в виде отдельного массива из двух элементов. Вы также можете гораздо проще распространить ту же идею на кортежи более высоких измерений.

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

Но, используя ваш метод и метод выше, вы выполняете больше операций сопоставления, чем необходимо (три на строку, а не одна). Это делает @ ответ Евгения более эффективным.

Более общим решением является использование:

#!/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
4 голосов
/ 17 декабря 2010

Используйте хеш.

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

while (<DATA>) {
    my $re = substr($_, 0, 1) . ".*" . $map{ substr($_, 0, 1) } . "=(.)";
    /$re/;
    print "$1\n";
}
3 голосов
/ 17 декабря 2010

Чтобы расширить мой комментарий.

#!/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";
    }
}
1 голос
/ 17 декабря 2010

В другом месте Тэд Маклеллан заметил, что данные выглядят как HoH, и предложил:

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

while (<DATA>) {
    my($type, %values) = split /[\s=]/;
    print "$values{$pairs{$type}}\n";
}
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...