Here's my solution. It's not as short as some of the others because it is object-oriented/array based instead of using strings and regexes, but it agrees that the solution needs 112 "simple moves".
#!/home/ivan/bin/perl
use strict;
use warnings;
package Piece;
use vars qw(@pieces %shapes);
%shapes = (
big => [2,2],
vert => [1,2],
horiz => [2,1],
small => [1,1],
);
@pieces = (
{ shape => 'big', orig => [1,0], },
{ shape => 'vert', orig => [0,0], },
{ shape => 'vert', orig => [3,0], },
{ shape => 'vert', orig => [0,3], },
{ shape => 'vert', orig => [3,3], },
{ shape => 'horiz', orig => [1,2], },
{ shape => 'small', orig => [1,3], },
{ shape => 'small', orig => [2,3], },
{ shape => 'small', orig => [1,4], },
{ shape => 'small', orig => [2,4], },
);
{
my $i = 0;
for (@pieces) {
$_->{id} = $i++;
bless $_;
}
}
sub shape { shift->{shape} };
sub orig { shift->{orig} };
sub id { shift->{id} };
sub size {
my ($self) = @_;
$shapes{$self->shape};
}
sub pieces {
@pieces;
}
package Board;
use overload '""' => 'draw';
use base 'Storable';
use vars qw($MAX_X $MAX_Y)
$MAX_X = 4;
$MAX_Y = 5;
sub new {
my $self = bless {
board => [[]],
pieces => [Piece->pieces],
n => 0,
}, shift;
for my $piece (@{$self->{pieces}}) {
$self->put($piece) or die;
}
$self->{holes} = [$self->find_holes];
$self;
}
sub put {
my ($self, $piece) = @_;
my ($x0,$y0) = @{$piece->orig};
my ($xsize, $ysize) = @{$piece->size};
my $board = $self->{board};
for (my $x = $x0; $x < $x0+$xsize; $x++) {
for (my $y = $y0; $y < $y0+$ysize; $y++) {
return 0 if defined $board->[$x][$y];
$board->[$x][$y] = $piece->id;
}
}
1;
}
sub draw {
my ($self) = @_;
my $board = $self->{board};
my $ret;
for (my $y = 0; $y < $MAX_Y; $y++) {
for (my $x = 0; $x < $MAX_X; $x++) {
my $p = $board->[$x][$y];
$ret .= (defined $p ? substr($self->piece($p)->shape,0,1)
+ : ' ');
}
$ret .= "\n";
}
$ret;
}
sub find_holes {
my ($self) = @_;
my $board = $self->{board};
my @ret;
for (my $y = 0; $y < $MAX_Y; $y++) {
for (my $x = 0; $x < $MAX_X; $x++) {
push @ret, [$x, $y] unless defined $board->[$x][$y];
}
}
@ret;
}
sub holes { @{shift->{holes}} }
sub n { shift->{n} }
sub piece_at {
my ($self, $x, $y) = @_;
$self->{board}[$x][$y];
}
sub piece_north {
my ($self, $pos) = @_;
my ($x, $y) = @$pos;
my $piece;
while ($y-- > 0) {
$piece = $self->piece_at($x, $y);
last if defined $piece;
}
$piece;
}
sub piece_south {
my ($self, $pos) = @_;
my ($x, $y) = @$pos;
my $piece;
while ($y++ < $MAX_Y-1) {
$piece = $self->piece_at($x, $y);
last if defined $piece;
}
$piece;
}
sub piece_east {
my ($self, $pos) = @_;
my ($x, $y) = @$pos;
my $piece;
while ($x++ < $MAX_X-1) {
$piece = $self->piece_at($x, $y);
last if defined $piece;
}
$piece;
}
sub piece_west {
my ($self, $pos) = @_;
my ($x, $y) = @$pos;
my $piece;
while ($x-- > 0) {
$piece = $self->piece_at($x, $y);
last if defined $piece;
}
$piece;
}
sub delete {
my ($self, $piece) = @_;
my ($x0,$y0) = @{$piece->{orig}};;
my ($xsize, $ysize) = @{$piece->size};
my $board = $self->{board};
for (my $x = $x0; $x < $x0+$xsize; $x++) {
for (my $y = $y0; $y < $y0+$ysize; $y++) {
$board->[$x][$y] = undef;
}
}
1;
}
sub piece {
my ($self, $n) = @_;
$self->{pieces}[$n];
}
sub move {
my ($self, $n, $dir) = @_;
my $new = $self->dclone;
my $pn = $new->piece($n);
$new->delete($pn);
if ($dir eq 'east') {
$pn->{orig}[0]++;
} elsif ($dir eq 'west') {
$pn->{orig}[0]--;
} elsif ($dir eq 'south') {
$pn->{orig}[1]++;
} else {
$pn->{orig}[1]--;
}
$new->put($pn) or return undef;
$new->{holes} = [$new->find_holes];
$new->{n}++;
$new;
}
package main;
my @dirs = qw(north south east west);
my %opp_dirs = qw(
north south
south north
east west
west east
);
my $board0 = Board->new;
my %seen = ("$board0" => 0);
my $count = 0;
my @confs = ();
my @q = ($board0);
my $solution;
my $distance;
while (1 and @q) {
$count++;
my $board = shift @q;
push @confs, "$board";
my ($x, $y) = @{$board->piece(0)->orig};
if ($x == 1 and $y == 3) {
$solution = "$board";
$distance = $board->n;
print "FOUND($x,$y) at distance $distance\n";
last;
}
for my $hole ($board->holes) {
my $p;
for my $dir (@dirs) {
my $method = "piece_$dir";
$p = $board->$method($hole);
next unless defined $p;
my $new_board = $board->move($p, $opp_dirs{$dir});
if ($new_board) {
my $s = "$new_board";
unless (exists $seen{$s}) {
$seen{$s} = $count;
my $r = join "\n", map { scalar reverse } split "\
+n", $s;
$seen{"$r\n"} = $count;
push @q, $new_board;
}
}
}
}
}
# print the solution
while ($distance >= 0) {
print "$distance\n$solution\n";
$solution = $confs[$seen{$solution}-1];
$distance--;
}