比较两个数组perl

时间:2013-01-08 16:15:09

标签: arrays perl

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

我使用List::MoreUtilseach_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-&gt; ats,atr-&gt; att,ats-&gt; att。但是根据我目前的代码,我会重复比较,比如ats-&gt; atr att-&gt; atr,att-&gt; ats。

2)我怎样才能避免这些?

3 个答案:

答案 0 :(得分: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循环比使用凌乱的C风格语法要好得多。

中还有一些错误
for (my $i = 0 ; $i <= @lists ; $i++) { ... }

因为@lists的最大索引比@lists的标量值小1 - 通常编码为$#lists。您的$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";
  }
}

答案 1 :(得分: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

答案 2 :(得分:-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风格的循环,但这有点难以阅读。)