#!/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}-- } }