How do I do my Perl homework assignment?

Given a perl hash structure

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

    }
}

I need to check for duplicate F ,I based on its inner pairing of G and H (G and H is common for B and D respectively in F and I, (They make a common duplicate pair)

The final output count structure is like this:

{ 
   '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
}

Is there any fast way in perl to do this?

Assuming you want to prune duplicates from $hoh and the two level structure isn't accidential, you could use something like:

  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";

output:

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

First create a method to tell you whether or not your hashes are the same. Rather than writing this myself I'll just yank it out of another module -- I'll just use eq_hash from Test::More, then all we need is a little bit of Perl code.

## 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;

And, that's it!

Very simple and straightforward solution:

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;
}