Question

给出perl哈希结构

{
'A' => {
        'B' => 'C',
        'D' => 'E'
                    },
'F' => {
        'B' => 'G',
        'D' => 'H'
                    },
'I' => {
        'B' => 'G',
        'D' => 'H'
                    },
'J' => {
        'B' => 'C',
        'D' => 'F'
                    },

    }
}

我需要检查重复的F，我基于它的G和H的内部配对（G和H在F和I中分别对于B和D是常见的，（它们是一个共同的副本对）

最终输出计数结构如下：

{ 
   'B' => { 'C' => 2 ,'G' => 1}             # see G's and H's count is 1  Taking G and H's pair only once.  C is 2 because C, E and C,F do not make a pair, C comes twice and E and F once
   'D' => { 'E' => 1, 'H' => 1, 'F'=>1, }   # see H's count is 1
}

perl有没有快速的方法来做到这一点？

Answer 1

假设你想从$ hoh修剪重复项并且两级结构不是偶然的，你可以使用类似的东西：

  my %pruned;                       # resulting pruned/uniq HoH
  my %vs;                           # store/count uniq values
  my @k0 = keys %$hoh;              # top level keys 
  my @k1 = keys %{$hoh->{$k0[0]}};  # common items keys
  for my $k0 (@k0) {
    # add item to pruned if item values seen for the first time
    $pruned{$k0} = $hoh->{$k0} if (1 == ++$vs{join "\t", map {$hoh->{$k0}{$_}} @k1} );
  }
  print Dumper( \%pruned ), "\n";

输出：

$VAR1 = {
          'A' => {
                   'D' => 'E',
                   'B' => 'C'
                 },
          'F' => {
                   'D' => 'H',
                   'B' => 'G'
                 },
          'J' => {
                   'D' => 'F',
                   'B' => 'C'
                 }
        };

Answer 2

首先创建一个方法来告诉你哈希是否相同。而不是自己写这个，我只是把它从另一个模块中拉出来 - 我只使用eq_hash中的Test::More，然后我们只需要一点Perl代码。

## Set Hash of Hashes
my $hoh = {
'A' => {
        'B' => 'C',
        'D' => 'E'
                    },
'F' => {
        'B' => 'G',
        'D' => 'H'
                    },
'I' => {
        'B' => 'G',
        'D' => 'H'
                    },
'J' => {
        'B' => 'C',
        'D' => 'F'
                    },

    }
}

use Test::More;
use Data::Dumper;
my @del;
foreach my $h1 ( keys %$hoh ) {
  INNER: foreach my $h2 ( keys %$hoh ) {
    if ( $h1 ne $h2 && Test::More::eq_hash( $hoh->{$h1}, $hoh->{$h2} ) ) {

      my @sort = sort ($h1, $h2);
      foreach my $r ( @del ) {
        next INNER if $r->[0] eq $sort[0] && $r->[1] eq $sort[1];
      }
      push @del, [sort $h1, $h2];

    }
  }
}

delete $hoh->{$_->[0]} for @del;

my $o;
foreach my $h1 ( values %$hoh ) {
  while ( my ($k, $v) = each %$h1 ) {
    $o->{$k}{$v}++
  }
}

use Data::Dumper; die Dumper $o;

而且就是这样！

Answer 3

非常简单明了的解决方案：

sub Count {
  my $input = shift;
  my (%output,%seen);
  for my $bunch (values %$input) {
    next if $seen{join'|',%$bunch}++;
    $output{$_}{$bunch->{$_}}++ for keys %$bunch;
  }
  return \%output;
}

我如何完成Perl作业？

3 个答案: