2

我是 Perl 世界的新手，我有一个比较两个数组的脚本。

我使用List::MoreUtils( each_arrayref) 进行比较。

我有两个问题：

1）有没有办法比较两个数组块（如natatime，但对于两个arrayrefs），而不是像在each_arrayref中那样一次比较单个元素？

元素应该来自每个数组的相同索引。

数据结构是这样的：

{
  atr => [qw/ a b c d /],
  ats => [qw/ a b c d /],
  att => [qw/ a b c d /],
}

这就是我到目前为止所得到的。

my @lists = keys %{$hash};

for (my $i = 0; $i <= @lists; $i++) {

  my $list_one = $lists[$i];
  my $one = $hash->{$list_one};

  for (my $j = 0 ; $j <= @lists ; $j++) {

    my $list_two = $lists[$j];
    my $two = $hash->{$list_two};

    my ($overlapping, $mismatch, $identity);
    my $match          = 0;
    my $non_match      = 0;
    my $count_ac_calls = 0;
    my $each_array     = each_arrayref($one, $two);

    while (my ($call_one, $call_two) = $each_array->()) {

      if ((defined $call_one) && (defined $call_two)) {
        if ($call_one eq $call_two) {
          $match++;
        }
        if ($call_one ne $call_two) {
          $non_match++;
        }
      }
    }    #end of while loop $each_array->()

    print "$list_one,$list_two,$match,$non_match";

  }    #end of for j loop
}    #end of for i loop

我想比较 atr->ats、atr->att、ats->att。但是使用我当前的代码，我会重复进行比较，例如 ats->atr att->atr,att->ats。

2）我怎样才能避免这些？

4

3 回答 3

4

我不清楚你的第一个问题是什么意思。你想要一个迭代器，比如说，返回(('a','b','c'),('a','b','c')) 而不是 ('a','a')？如果是这样，那么库中没有可用的库，但编写自己的库并不难。

至于第二个，避免项目与自身进行比较的通常方法是更改​​内部循环，使其在第一个的当前值之后开始。像这样

for my $i (0..$#lists) {

  for my $j ($i+1..$#lists) {

  }

}

这是有效的，因为A eq B通常与 相同B eq A，因此将条目与列表中较早的条目进行比较是没有意义的，因为已经进行了反向比较。

for请注意，Perl 以这种方式编写循环比杂乱的 C 样式语法要好得多。你也有几个错误

for (my $i = 0 ; $i <= @lists ; $i++) { ... }

因为 的最大索引@lists比 的标量值小一，@lists通常编码为$#lists。您的 for 循环中也存在同样的问题$j。

更新

这是对您的程序的重构，它包含我所描述的想法并且更加Perlish。我希望它对你有用。

use strict;
use warnings;

use List::MoreUtils 'each_arrayref';

my $hash = {
  atr => [qw/ a b c d /],
  ats => [qw/ a b c d /],
  att => [qw/ a b c d /],
};

my @keys = keys %{$hash};

for my $i (0 .. $#keys) {

  my $key1 = $keys[$i];
  my $list1 = $hash->{$key1};

  for my $j ($i+1 .. $#keys) {

    my $key2 = $keys[$j];
    my $list2 = $hash->{$key2};

    my ($match, $non_match) = (0, 0);
    my $iter = each_arrayref($list1, $list2);

    while (my ($call1, $call2) = $iter->()) {
      if (defined $call1 and defined $call2) {
        ($call1 eq $call2 ? $match : $non_match)++;
      }
    }

    print "$key1, $key2, $match, $non_match\n";
  }
}
于 2013-01-08T16:44:20.520 回答
1

一种选择是使用Array::Compare返回不同数组元素的数量。此外，Math::Combinatorics仅用于获得唯一的比较。

use strict;
use warnings;
use Array::Compare;
use Math::Combinatorics;

my %hash = (
    'atr' => [ 'a', 'b', 'c', 'd' ],
    'ats' => [ 'a', 'b', 'c', 'd' ],
    'att' => [ 'a', 'c', 'c', 'd' ],
);

my $comp = Array::Compare->new( DefFull => 1 );
my $combinat = Math::Combinatorics->new(
    count => 2,
    data  => [ keys %hash ],
);

while ( my ($key1, $key2) = $combinat->next_combination ) {
    my $diff = $comp->compare( \@{ $hash{$key1} }, \@{ $hash{$key2} } );
    print "$key1,$key2," . ( @{ $hash{$key1} } - $diff ) . ",$diff\n";
}

输出：

ats,att,3,1
ats,atr,4,0
att,atr,3,1
于 2013-01-08T18:41:31.207 回答
-1

您并没有真正利用 Perl 提供的功能。与其使用容易出错的 C 样式循环，不如使用for my $var (LIST). 您也可以通过跳过自检来跳过冗余列表检查。我拿走了你的剧本，做了一些改动，我相信你会发现它更容易阅读。

use v5.16;
use warnings;
use List::MoreUtils qw{each_arrayref};

my $hash = {
  'atr' => [
    'a',
    'b',
    'c',
    'd'
   ],
  'ats'=>[
    'a',
    'b',
    'c',
    'd'
   ],
  'att' => [
    'a',
    'c',
    'c',
    'd'
   ],
};

for my $list_one (keys $hash) {
    my $one = $hash->{$list_one};

    for my $list_two (keys $hash) {
        next if $list_one ~~ $list_two;

        my $two = $hash->{$list_two};

        my ($match, $non_match);
        $match = $non_match = 0;

        my $each_array = each_arrayref($one, $two);
        while (my ($call_one, $call_two) = $each_array->()) {
            if($call_one && $call_two) {
                if($call_one eq $call_two) {
                    $match++;
                }
                else {
                    $non_match++;
                }
            }
        }

        print "$list_one,$list_two,$match,$non_match\n";
    }
}

无论如何，您都希望一次评估一个，以便您可以添加一些额外的位，例如索引位置。（是的，你可以使用 C 风格的循环，但这会更难阅读。）

于 2013-01-08T18:37:16.637 回答