http://okajima.air-nifty.com/b/2010/01/post-abc6.html bfs+枝刈り

nenryo.pl

#!/usr/bin/perl
use strict;
use warnings;

my @text = map {+[grep {!/\n/} split //, $_]} grep /\*/, <DATA>;
my %index;
my %points;

for my $y (0..$#text) {
    for my $x (0..$#{$text[$y]}) {
	my $char = $text[$y][$x];
	$index{ss($x, $y)} = $char;
	if ($char ne ' ' && $char ne '*') {
	    $points{$char} = {x => $x, y => $y};
	}
    }
}

my $log = traversal($points{'S'}, \%index);
for my $c (@$log[1..$#{$log}-1]) {
    $text[$c->{y}][$c->{x}] = '$';
}

print join "\n", map {join "", @$_} @text;
print "\n";

sub traversal {
    my ($start, $index) = @_;
    my @queue = ([$start]);
    my %shortest = map {($_, 100000)} keys %$index;
    while (my $now = shift @queue) {
	my @availd;
	my $cursor = $now->[$#{$now}];
	for my $d ([0, 1],[1, 0],[-1, 0],[0, -1]) {
	    my $nextc = {x => $cursor->{x} + $d->[0], y => $cursor->{y} + $d->[1]};
	    if ((0 == scalar @$now) or (!grep {i2s($_) eq i2s($nextc)} @$now)) {
		if (defined $index->{i2s($nextc)}) {
		    if ($index{i2s($nextc)} eq ' ') {
			push @availd, $nextc;
		    }
		    elsif ($index{i2s($nextc)} eq 'G') {
			return [@$now, $nextc];
		    }
		}
	    }
	}
	for my $nextc (@availd) {
	    if ($shortest{i2s($nextc)} >= scalar @$now) {
		$shortest{i2s($nextc)} = scalar @$now;
		push @queue, [@$now, $nextc];
	    }
	}
    }
}

sub i2s {
    my $i = shift;
    return ss($i->{x}, $i->{y});
}

sub ss {
    return (shift @_).','.(shift @_);
}


__END__
**************************
*S* *                    *
* * *  *  *************  *
* *   *    ************  *
*    *                   *
************** ***********
*                        *
** ***********************
*      *              G  *
*  *      *********** *  *
*    *        ******* *  *
*       *                *
**************************