I don't solve the problem, but I have a framework for letting someone play the game. (It's simplistic, but it's something. I don't feel like coding up the search algorithm at work.)
use strict;
use warnings;
my $board = [
'A', 'B', 'B', 'C',
'A', 'B', 'B', 'C',
'', 'D', 'D', '',
'E', 'G', 'I', 'F',
'E', 'H', 'J', 'F',
];
display_board( $board );
while (1)
{
my ($piece, $move) = get_move();
make_move( $board, $piece, $move );
display_board( $board );
}
######################################################################
+##########
sub get_move
{
my ($piece, $move);
GET_MOVE: {
print "Move: ";
chomp( my $temp = <> );
$temp = uc $temp;
exit if $temp =~ /Q/;
($piece, $move) = $temp =~ /^([A-J])(\d+)$/;
redo GET_MOVE unless defined $piece && defined $move;
}
return( $piece, $move );
}
use constant NORTH => -4;
use constant EAST => +1;
use constant SOUTH => +4;
use constant WEST => -1;
sub make_move
{
my ($board, $piece, $move) = @_;
# Is the spot we're moving to empty?
return if $board->[$move];
# Find the spots occupied by the piece
my @piece = grep { $piece eq $board->[$_] } 0 .. $#$board;
# Is the spot we're moving to next to the piece?
my $next_to;
my $check;
foreach my $x (@piece)
{
$next_to = EAST if $move == $x + EAST;
$next_to = WEST if $move == $x + WEST;
$next_to = NORTH if $move == $x + NORTH;
$next_to = SOUTH if $move == $x + SOUTH;
$check = $x;
last if $next_to;
}
return unless $next_to;
if ( $next_to == NORTH || $next_to == SOUTH )
{
if ($board->[$check+1] eq $board->[$check])
{
return if $board->[$check+1+$next_to];
}
elsif ($board->[$check-1] eq $board->[$check])
{
return if $board->[$check-1+$next_to];
}
}
else
{
if ($board->[$check + 4] eq $board->[$check])
{
return if $board->[$check+4+$next_to];
}
elsif ($board->[$check - 4] eq $board->[$check])
{
return if $board->[$check-4+$next_to];
}
}
# Make the move!
if ( $next_to == SOUTH || $next_to == EAST )
{
foreach my $i (sort { $b <=> $a } @piece)
{
@{$board}[$i, $i+$next_to] = @{$board}[$i+$next_to, $i];
}
}
else
{
foreach my $i (sort { $a <=> $b } @piece)
{
@{$board}[$i, $i+$next_to] = @{$board}[$i+$next_to, $i];
}
}
return 1;
}
sub display_board
{
my ($board) = @_;
print " 0 1 2 3\n";
my $x = '0';
my @x = @$board;
while (@x)
{
my @row = splice @x, 0, 4;
$_ ||= ' ' for @row;
$x = sprintf("%02d", $x);
print "$x| @row |$x\n";
$x+=4;
}
print " 0 1 2 3\n";
}