#!/usr/bin/perl -w

use strict;
use warnings;

use List::Util qw( first );

#        1
#       . .
#      . 8 .
#     . . . .
#    . . . . .

#        0
#       1 2
#      3 4 5
#     6 7 8 9
#    A B C D E

my @adj = (
               [ 1, 2 ],            # 0
               [ 0, 2, 3 ],         # 1
               [ 0, 1, 5 ],         # 2
               [ 1, 7, 6 ],         # 3
               [ ],                 # 4
               [ 2, 8, 9 ],         # 5
               [ 3, 7, 10, 11 ],    # 6
               [ 3, 6, 11, 12, 8 ], # 7
               [ 5, 7, 9, 12, 13 ], # 8
               [ 5, 8, 13, 14 ],    # 9
               [ 6, 11 ],           # A 10
               [ 6, 7, 10, 12 ],    # B 11
               [ 7, 8, 11, 13 ],    # C 12
               [ 8, 9, 12, 14 ],    # D 13
               [ 9, 13 ],           # E 14
           );
my @color = qw( n c c c c c c c n s s s s s s s );
my @init_rack = qw( c 0 0 0 n 0 0 0 0 0 0 0 0 0 0 );

my $rack_ref = rack_em( \@init_rack, 6, 7 );
my $rack_out = q{
        0
       1 2
      3 4 5
     6 7 8 9
    A B C D E
};
$rack_out =~ s/(\S)/$rack_ref->[hex $1]/g;

print $rack_out;

$rack_out =~ s/n/8/;
my @colors  = map  { sprintf '%x', $_ }
              grep { $color[$_] eq 'c' } 1 .. 15;
my @stripes = map  { sprintf '%x', $_ }
              grep { $color[$_] eq 's' } 1 .. 15;
$rack_out =~ s/c/shift @colors/ge;
$rack_out =~ s/s/shift @stripes/ge;

print $rack_out;

sub rack_em {
    my ( $rack_ref, $sol_left, $str_left ) = @_;
    
    if ( ! $sol_left && ! $str_left ) {
        return $rack_ref;
    }

    my $missing_ball = first { $rack_ref->[$_] eq '0' } 0 .. 14;
    if ( ! defined $missing_ball ) {
        die "oops";
    }

    if ( $sol_left > 0 && $str_left > 0 ) {
        my @rack_color = @{ $rack_ref };
        my @rack_stripe = @{ $rack_ref };
        $rack_color[$missing_ball] = 'c';
        $rack_stripe[$missing_ball] = 's';
        my $c_ref = rack_em( \@rack_color, $sol_left-1, $str_left );
        my $s_ref = rack_em( \@rack_stripe, $sol_left, $str_left-1 );
        return ( rack_assess( $c_ref ) < rack_assess( $s_ref ) )
               ? $c_ref : $s_ref;
    }
    elsif ( $sol_left > 0 ) {
        $rack_ref->[$missing_ball] = 'c';
        return rack_em( $rack_ref, --$sol_left, $str_left );
    }
    elsif ( $str_left > 0 ) {
        $rack_ref->[$missing_ball] = 's';
        return rack_em( $rack_ref, $sol_left, --$str_left );
    }

    die 'unreachable code reached';
}

sub rack_assess {
    my ( $rack_ref ) = @_;

    my $out = 0;
    foreach my $ball_index ( 0 .. 14 ) {
        my $ball_color = $rack_ref->[ $ball_index ];
        my @adjacents = @{ $rack_ref }[ @{ $adj[$ball_index] } ];
        my $matches = scalar grep { $_ eq $ball_color } @adjacents;
        $out += $matches;
    }
    
    return $out;
}
[download]