iamcal.com Since May 2000

#!/usr/bin/perl -w

use strict;

$|++;

my $map = new Solver::Map({map_x => 8, map_y => 8});

$map->set_map("
        ########
        ###--p##
        #--0.-##
        #--.0.-#
        ###-X0-#
        ###---##
        ########
        ########
");

$map->show();
#$map->test();
$map->solve();

print "done!\n";

#####################################################################
#
# # = wall
# - = open space
# . = open space w/ target
# 0 = crate
# X = crate w/ target
# p = player
# P = player w/ target

package Solver::Map;

sub new {
        my $class = shift;
        my $self = bless {}, $class;

        my $options = shift;
        $self->{map} = '';
        $self->{dim_x} = 0;
        $self->{dim_y} = 0;

        my $x = $options->{map_x} || 10;
        my $y = $options->{map_y} || 10;
        $self->init($x, $y);

        return $self;
}

sub init {
        my ($self, $x, $y) = @_;

        $self->{dim_x} = $x;
        $self->{dim_y} = $y;
        $self->{map} = '#' x ($x*$y);
}

sub show {
        my ($self, $map) = @_;

        #print ((defined($map))?"custom map\n":"own map\n");

        for my $y(1..$self->{dim_y}){
                for my $x(1..$self->{dim_x}){
                        my $cell = $self->get_cell($x, $y, $map);
                        print "$cell";
                }
                print "\n";
        }
        print "\n";
}

sub get_cell {
        my ($self, $x, $y, $map) = @_;
        my $index = $self->_get_index($x, $y);
        return '#' if $index {map}, $index, 1;
}

sub _set_cell {
        my ($self, $x, $y, $map, $set) = @_;
        my $index = $self->_get_index($x, $y);
        return if $index $self->{dim_x};
        return -1 if $y > $self->{dim_y};
        return ($x-1) + (($y-1) * $self->{dim_x});
}

sub _index_to_xy {
        my ($self, $index) = @_;
        $index++;
        my $x = ($index % $self->{dim_x});
        $x = $self->{dim_x} if $x == 0;
        $index -= $x;
        my $y = $index / $self->{dim_x};
        $y++;
        return ($x, $y);
}

sub set_map {
        my ($self, $map) = @_;
        $map =~ s/\s+//g;
        $self->{map} = $map;
}

sub solve {
        my ($self) = @_;

        my %states;

        # to get into our starting state, do nothing
        $states{$self->{map}} = '!';

        my $max_turns = 32;

        # try up to 100 moves
        for my $turn(1..$max_turns){
                my @old_states = keys %states;
                for my $move(qw(u d l r)){
                        for $map(@old_states){
                                # for each known state, execute this move and put the
                                # result back into the state table if it's the best route
                                # to it so far
                                my $route = $states{$map} . $move;
                                my $new_map = $self->_execute_move($map, $move);

                                if ($states{$new_map}){

                                        # we've seen this map/state before - was this a quicker route?
                                        if (length($states{$new_map}) > length($route)){
                                                # we have a quicker route - replace it
                                                $states{$new_map} = $route;
                                        }
                                }else{
                                        # first time we've seen this map - is it a solution?
                                        if ($self->_is_solved($new_map)){
                                                print "SOLUTION: $route!";
                                                return;
                                        }
                                        $states{$new_map} = $route;
                                }
                        }
                        print '.';
                }
                print "($turn:".scalar(keys %states).")\n";
        }

        print "\n";

        # for each state, show the map
#        for my $map(keys %states){
#                if (length($states{$map})-1 == $max_turns){
#                        $self->show($map);
#                        print "VIA ROUTE: $states{$map}\n\n";
#                }
#        }

}

sub _is_solved {
        my ($self, $map) = @_;

        for my $i(1..length($map)){
                if (substr($map,$i-1,1) eq '0'){
                        return 0;
                }
        }
        return 1;
}

sub _execute_move {
        my ($self, $map, $move) = @_;

        my ($px, $py) = $self->_index_to_xy($self->_get_player_pos($map));

        # find out what will replace the player (are we standing on a target?)
        my $replace_me = ($self->get_cell($px, $py, $map) eq 'p')?'-':'.';

        # find next position
        my $px2 = $px;
        my $py2 = $py;
        $py2-- if $move eq 'u';
        $py2++ if $move eq 'd';
        $px2-- if $move eq 'l';
        $px2++ if $move eq 'r';

        # and next crate position - we might need this!
        my $px3 = $px2;
        my $py3 = $py2;
        $py3-- if $move eq 'u';
        $py3++ if $move eq 'd';
        $px3-- if $move eq 'l';
        $px3++ if $move eq 'r';

        # ok - what's in the position we're trying to move to?
        my $cell2 = $self->get_cell($px2, $py2, $map);
        my $cell3 = $self->get_cell($px3, $py3, $map);

        if ($cell2 eq '#'){
                # we can't walk through walls - don't do anything
        }

        if (($cell2 eq '-') || ($cell2 eq '.')){
                # we're moving into open space
                if ($cell2 eq '-'){
                        $map = $self->_set_cell($px2, $py2, $map, 'p');
                }else{
                        $map = $self->_set_cell($px2, $py2, $map, 'P');
                }
                $map = $self->_set_cell($px, $py, $map, $replace_me);
        }        

        if (($cell2 eq '0') || ($cell2 eq 'X')){
                # we're trying to push a crate - is the space to push it into empty?
                if (($cell3 eq '-') || ($cell3 eq '.')){
                        # move crate into cell3
                        if ($cell3 eq '-'){
                                $map = $self->_set_cell($px3, $py3, $map, '0');
                        }else{
                                $map = $self->_set_cell($px3, $py3, $map, 'X');
                        }
                        # move player into cell2
                        if ($cell2 eq '0'){
                                $map = $self->_set_cell($px2, $py2, $map, 'p');
                        }else{
                                $map = $self->_set_cell($px2, $py2, $map, 'P');
                        }
                        # replace cell1
                        $map = $self->_set_cell($px, $py, $map, $replace_me);
                }
        }

        return $map;
}

sub _get_player_pos {
        my ($self, $map) = @_;

        for my $i(1..length($map)){
                if (substr($map,$i-1,1) =~ /p/i){
                        return $i-1;
                }
        }
        die"CAN'T FIND PLAYER!";
}

sub test {
        my ($self) = @_;

        for my $y(1..$self->{dim_y}){
                for my $x(1..$self->{dim_x}){
                        my $i = $self->_get_index($x, $y);
                        my ($x2, $y2) = $self->_index_to_xy($i);
                        print "$x,$y -> $i -> $x2,$y2\n";
                }
        }
}