use strict;
use warnings;

my $ballfinder = My::Oddball->new(
  [5,6,8,10], [7,9,11,12], # L/R set 1
  [2,3,4,7], [5,6,11,12],  # L/R set 2
  [1,4,10,11], [2,5,7,8],  # L/R set 3
) or die "Bogus ball arrangement";

# Now we have a valid table, let's use it to find some random oddballs

for (1..5){
 my $weight = (0.9, 1.1)[ int(rand(2)) ];
 my $oddball = (1..12)[ int(rand(12)) ];
 my $balls = [ qw/ 0 1 1 1 1 1 1 1 1 1 1 1 1 / ];
 $balls->[$oddball] = $weight;
 
 print "Randomly chosen ball: $oddball, ".($weight < 1 ? 'light' : 'he
+avy')."\n";
 print $ballfinder->detect($balls)."\n\n";
}

package My::Oddball;

sub new {
 my ( $class, $L1, $R1, $L2, $R2, $L3, $R3 ) = @_;
 my $table = { };
# Iterate through all possible combinations: balls 1-12, light & heavy
 foreach my $weight qw/ 0.9 1.1 / {
  for my $oddball (1..12){
    my $balls = [ qw/ 0 1 1 1 1 1 1 1 1 1 1 1 1 / ];
    $balls->[$oddball] = $weight;
    my $key = canon_key(
      balance( [ @$balls[@$L1] ], [ @$balls[@$R1] ] ),
      balance( [ @$balls[@$L2] ], [ @$balls[@$R2] ] ),
      balance( [ @$balls[@$L3] ], [ @$balls[@$R3] ] ),
    );
    # If the table is valid, we should get a unique key
    # for each ball/weight combination
    return if exists $table->{$key};
    $table->{$key} = "Ball $oddball is ".($weight < 1  ? "light" : "he
+avy");
  }
 }
 return bless { table => $table, sets => [ $L1, $R1, $L2, $R2, $L3, $R
+3 ] }, $class;
}

sub detect {
  my ($self, $balls) = @_;
  my ( $L1, $R1, $L2, $R2, $L3, $R3 ) = @{$self->{sets}};
  my $key = canon_key (
    balance( [ @$balls[@$L1] ], [ @$balls[@$R1] ] ),
    balance( [ @$balls[@$L2] ], [ @$balls[@$R2] ] ),
    balance( [ @$balls[@$L3] ], [ @$balls[@$R3] ] ),
  );
  return $self->{table}{$key};
}

sub canon_key { join( '_' => @_ ) }

sub balance {
  my ( $setA, $setB ) = @_;
  return weigh($setA) cmp weigh($setB);
}

sub weigh {
  my ($set) = @_;
  my $sum = 0;
  $sum += $_ for @$set;
  return $sum;
}
[download]