gistfile1.PL

#!/usr/bin/perl

use strict;
use warnings;

my $maze = &load_maze;
&analyze_maze($maze);
&print_maze($maze);

sub analyze_maze {
	my ($ci, $cj, $gi, $gj, $li, $lj);

 	foreach my $k (keys(%$maze)) {
		my $l = $maze->{$k};
		foreach my $kk (keys(%$l)) {
			if ($l->{$kk}{'char'} eq 'S') {
				$ci = $k;
				$cj = $kk;
			}

			if ($l->{$kk}{'char'} eq 'G') {
				$gi = $k;
				$gj = $kk;
			}
		}
	}

	my @cr = ({'i' => $ci, 'j' => $cj});
	my $loss = 0;
	for (my $step = 1;;$step++) {
		my @current = ();
		foreach my $c (@cr) {
			my ($ci, $cj) = ($c->{'i'}, $c->{'j'});
			my $st = $step;
			$st = $c->{'step'}+1 if ($c->{'step'});

			my ($ti, $tj);

			if ($ci != $gi) {
				$ti = ($ci < $gi) ? $ci+1 : $ci-1;
				if ($maze->{$ti}{$cj}{'char'} eq ' ') {
					$maze->{$ti}{$cj} = {
						'type' => 'step',
						'step' => $st,
						'char' => 's',
						'loss' => $loss,
						'i' => $ti,
						'j' => $cj,
					};
					push(@current, $maze->{$ti}{$cj});
				}
				elsif ($maze->{$ti}{$cj}{'char'} eq 'G') {
					$li = $ci;
					$lj = $cj;
					last;
				}
			}

			if ($cj != $gj) {
				$tj = ($cj < $gj) ? $cj+1 : $cj-1;
				if ($maze->{$ci}{$tj}{'char'} eq ' ') {
					$maze->{$ci}{$tj} = {
						'type' => 'step',
						'step' => $st,
						'char' => 's',
						'loss' => $loss,
						'i' => $ci,
						'j' => $tj,
					};
					push(@current, $maze->{$ci}{$tj});
				}
				elsif ($maze->{$ci}{$tj}{'char'} eq 'G') {
					$li = $ci;
					$lj = $cj;
					last;
				}
			}

			if (! @current) {
				foreach my $k (keys(%$maze)) {
					my $l = $maze->{$k};
					foreach my $kk (keys(%$l)) {
						next if $l->{$kk}{'type'} ne 'step';
						if ($l->{$kk}{'loss'} == $loss) {
							my ($ci, $cj) = ($l->{$kk}{'i'}, $l->{$kk}{'j'});

							my ($ti, $tj);
							if ($ci >= $gi) {
								$ti = $ci+1;
								if ($maze->{$ti}{$cj}{'char'} eq ' ') {
									$maze->{$ti}{$cj} = {
										'type' => 'step',
										'step' => $l->{$kk}{'step'}+1,
										'char' => 's',
										'loss' => $loss+1,
										'i' => $ti,
										'j' => $cj,
									};
									push(@current, $maze->{$ti}{$cj});
								}
							}

							if ($ci <= $gi) {
								$ti = $ci-1;
								if ($maze->{$ti}{$cj}{'char'} eq ' ') {
									$maze->{$ti}{$cj} = {
										'type' => 'step',
										'step' => $l->{$kk}{'step'}+1,
										'char' => 's',
										'loss' => $loss+1,
										'i' => $ti,
										'j' => $cj,
									};
									push(@current, $maze->{$ti}{$cj});
								}
							}

							if ($cj >= $gj) {
								$tj = $cj+1;
								if ($maze->{$ci}{$tj}{'char'} eq ' ') {
									$maze->{$ci}{$tj} = {
										'type' => 'step',
										'step' => $l->{$kk}{'step'}+1,
										'char' => 's',
										'loss' => $loss+1,
										'i' => $ci,
										'j' => $tj,
									};
									push(@current, $maze->{$ci}{$tj});
								}
							}

							if ($cj <= $gj) {
								$tj = $cj-1;
								if ($maze->{$ci}{$tj}{'char'} eq ' ') {
									$maze->{$ci}{$tj} = {
										'type' => 'step',
										'step' => $l->{$kk}{'step'}+1,
										'char' => 's',
										'loss' => $loss+1,
										'i' => $ci,
										'j' => $tj,
									};
									push(@current, $maze->{$ci}{$tj});
								}
							}
						}
					}
				}

				$loss++;
			}
		}
		@cr = @current;

		last if $li;
	}

	for (;;) {
		$maze->{$li}{$lj}{'char'} = '#';
		my $s = $maze->{$li}{$lj}{'step'}-1;
		if ($maze->{$li-1}{$lj}{'type'} eq 'step' && $maze->{$li-1}{$lj}{'step'} == $s) {
			$li--;
		}
		elsif ($maze->{$li+1}{$lj}{'type'} eq 'step' && $maze->{$li+1}{$lj}{'step'} == $s) {
			$li++;
		}
		elsif ($maze->{$li}{$lj-1}{'type'} eq 'step' && $maze->{$li}{$lj-1}{'step'} == $s) {
			$lj--;
		}
		elsif ($maze->{$li}{$lj+1}{'type'} eq 'step' && $maze->{$li}{$lj+1}{'step'} == $s) {
			$lj++;
		}

		last unless $s;
	}
}

sub load_maze {
	my $maze = {};
	my $i = 0;
	foreach my $l (<DATA>) {
		$l =~ s/[\r\n]*$//;
		my $j = 0;
		$maze->{$i} = {};
		foreach my $c (split(//, $l)) {
			$maze->{$i}{$j} = {
				'type' => 'maze',
				'char' => $c,
			};
			$j++;
		}
		$i++;
	}
	$maze;
}

sub print_maze {
	my $maze = shift;
 	foreach my $k (sort({$a <=> $b} keys(%$maze))) {
		my $l = $maze->{$k};
		foreach my $kk (sort({$a <=> $b} keys(%$l))) {
			my $ch = $l->{$kk}{'char'};
			$ch = ' ' if $ch eq 's';
			printf('%s', $ch);
		}
		print("\n");
	}
}

1;
__DATA__
**************************
*S* *                    *
* * *  *  *************  *
* *   *    ************  *
*    *                   *
************** ***********
*                        *
** ***********************
*      *              G  *
*  *      *********** *  *
*    *        ******* *  *
*       *                *
**************************