Here is a solution to the Rush Hour quiz using the Games::LMSolve module. It
isn't golfized or anything, and was not too optimized - I just wanted to see
if I can solve it using it.
Regards,
Shlomi Fish
<<<
#!/usr/bin/perl -w
package RushHour;
use strict;
use base 'Games::LMSolve::Base';
sub input_board
{
my $self = shift;
my $packed = join("",<STDIN>);
chomp($packed);
return $self->unpack_state($packed);
}
sub pack_state
{
my $self = shift;
my $unpacked = shift;
return join("\n", map { join("", @$_) } @$unpacked);
}
sub unpack_state
{
my $self = shift;
my $packed = shift;
my @lines = split(/\n/,$packed);
chomp(@lines);
return [map { [ split(//, $_) ] } @lines];
}
sub display_state
{
my $self = shift;
my $packed = shift;
return $packed;
}
sub check_if_final_state
{
my $self = shift;
my $state = shift;
foreach my $l (@$state)
{
if ($l->[-1] =~ /^[a-zA-Z]$/)
{
return 1;
}
}
return 0;
}
sub enumerate_moves
{
my $self = shift;
my $state = shift;
my @moves;
my %encountered_cars = ();
my ($x,$y);
for($y=0;$y<@$state;$y++)
{
my $line = $state->[$y];
for($x=0;$x<@$line;$x++)
{
my $char = $line->[$x];
if (exists($encountered_cars{$char}))
{
next;
}
$encountered_cars{$char} = 1;
if ($char =~ /^[a-z]$/)
{
my $x_delta = 1;
while (($x-$x_delta >= 0) && $line->[$x-$x_delta] eq " ")
{
push @moves, +{ 'c' => $char, 'i' => (-$x_delta)};
$x_delta++;
}
$x_delta = 1;
my $x_end = 1;
while ($line->[$x+$x_end] eq $char)
{
$x_end++;
}
$x_end--;
$x_delta = 1;
while (($x+$x_end+$x_delta < @$line) &&
($line->[$x+$x_end+$x_delta] eq " "))
{
push @moves, +{ 'c' => $char, 'i' => $x_delta};
$x_delta++;
}
}
elsif ($char =~ /^[A-Z]$/)
{
my $y_delta = 1;
while (($y-$y_delta >= 0) && $state->[$y-$y_delta]->[$x] eq "
")
{
push @moves, +{ 'c' => $char, 'i' => (-$y_delta)};
$y_delta++;
}
$y_delta = 1;
my $y_end = 1;
while ($state->[$y+$y_end]->[$x] eq $char)
{
$y_end++;
}
$y_end--;
$y_delta = 1;
while (($y+$y_end+$y_delta < @$state) &&
($state->[$y+$y_end+$y_delta]->[$x] eq " "))
{
push @moves, +{ 'c' => $char, 'i' => $y_delta};
$y_delta++;
}
}
}
}
return (@moves);
}
sub perform_move
{
my $self = shift;
my $state = shift;
my $move = shift;
my $state_copy = $self->unpack_state($self->pack_state($state));
my $c = $move->{c};
my $increment = $move->{i};
my ($len);
my ($x, $y);
my $horiz = (($c =~ /^[a-z]$/) ? 1 : 0);
Y_LOOP: for($y=0;$y<@$state_copy;$y++)
{
my $line = $state_copy->[$y];
for($x=0;$x<@$line;$x++)
{
if ($line->[$x] eq $c)
{
if ($horiz)
{
for($len=0;;$len++)
{
if ($line->[$x+$len] ne $c)
{
last;
}
}
my $x_iter;
for($x_iter = 0;$x_iter<$len;$x_iter++)
{
$line->[$x+$x_iter] = " ";
}
for($x_iter = 0;$x_iter<$len;$x_iter++)
{
$line->[$x+$x_iter+$increment] = $c;
}
}
else
{
for($len=0;;$len++)
{
if ($state_copy->[$y+$len]->[$x] ne $c)
{
last;
}
}
my $y_iter;
for($y_iter = 0;$y_iter<$len;$y_iter++)
{
$state_copy->[$y+$y_iter]->[$x] = " ";
}
for($y_iter = 0;$y_iter<$len;$y_iter++)
{
$state_copy->[$y+$y_iter+$increment]->[$x] = $c;
}
}
last Y_LOOP;
}
}
}
return $state_copy;
}
package main;
use strict;
my $self = RushHour->new();
my ($verdict, $final_state) = $self->solve_board("-");
if ($verdict eq "unsolved")
{
exit;
}
my $key = $final_state;
my $state_collection = $self->{'state_collection'};
my $s = $state_collection->{$key};
my @moves = ();
my @states = ($key);
while ($s->{'p'})
{
push @moves, $s->{'m'}->{c} . " " . $s->{m}->{i};
$key = $s->{'p'};
$s = $state_collection->{$key};
push @states, $key;
}
@moves = reverse(@moves);
print map { "$_\n" } @moves;
>>>
--
---------------------------------------------------------------------
Shlomi Fish [EMAIL PROTECTED]
Homepage: http://shlomif.il.eu.org/
Knuth is not God! It took him two days to build the Roman Empire.
