Как мне выполнить домашнее задание по Perl?

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 являются общими для B и D соответственно в F и I, (они образуют общую дублирующую пару)

Структура итогового количества выводов выглядит следующим образом:

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