#!/usr/bin/perl

$|=1;

# A block should have eight letters
# The letters come in pairs:
# One of ac   or   bb
# Two of dg   or   ef
# One of hj   or   ii

my %pairs = ('a' => 'c',
             'b' => 'b',
             'd' => 'g',
             'e' => 'f',
             'h' => 'j',
             'i' => 'i',
            );
for my $l (keys %pairs) { $pairs{$pairs{$l}} = $l } # LOD

my %group = qw(addh I  addi II adeh III adei IV
               aeeh V  aeei VI bddh VII bddi VIII
               bdeh IX bdei X  beeh XI  beei XII);

sub decrement_count (\%$);

while (<>) {
  chomp;
  my ($block, $shapes) = split /: /;
  print "$block: ";
  my @shapes = split m{/}, $shapes;
  my %triangle_count;
  my $triangle_count = 0;
  for my $char (split //, $shapes) {
    next if $char eq '/';
    $triangle_count{$char}++;
    $triangle_count++;
  }
  my @pairs;
  while (%triangle_count) {
    my ($key_1) = keys %triangle_count;
    my $val_1 = $pairs{$key_1};
    $key_1 = $val_1 if $key_1 gt $val_1;
    decrement_count(%triangle_count, $key_1);
    decrement_count(%triangle_count, $pairs{$key_1});
    push @pairs, $key_1;
  }
  my $pairs = join "", sort @pairs;
  print $group{$pairs};
  print "\n";
}

sub decrement_count (\%$) {
  my ($hash, $k) = @_;
  die "Tried to decrement nonexistent \$hash{$k}"
    unless $hash->{$k};
  if ($hash->{$k} == 1) { delete $hash->{$k} }
  else { $hash->{$k}-- }
}
