#!/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 *
* * *********** * *
* * ******* * *
* * *
**************************