我该如何做我的 Perl 家庭作业？

Question

给定一个perl哈希结构

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

    }
}

，我需要检查重复的 F ，I 基于其 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

首先创建一个方法来告诉您哈希值是否相同。我不会自己编写这个，而是将其从另一个模块中拉出来 - 我将只使用 Test::More 中的 eq_hash，然后我们需要的只是一点一些 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;
}