#!/usr/bin/perl
use strict; # https://perlmonks.org/?node_id=11128527
use warnings;
local $_ = <<END;
--- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---.
| | R | |
. .---. . . . . . . . . . . .---. .
| | | |
. . . . . . . . . . . . . . . .
| | |
. . . . . . . . . . .---. . . . .
| | |
. . . . . .---. . . . . . . . .---.
| |
---. . . .---. . . . . . . . . . . .
| | |
. . . . . . . . . . . . . . . .
| | | |
.---. . . . . .---.---. .---. . .---. . .
| | | | |
. . . . . . . . . . . . . . . .
| * | | |
. . . . . . .---.---. . . .---. . . .
| | B | |
. . . .---. .---. . . . . . . . .---.
| | |
---. . . . . . . . . . . . . . . .
| |
. . . . . . .---. .---. . . . . . .
| | | |
.---. . . . . . . . . . . . . . .
| Y | | |
. . . . . . . . . . . . . .---. .
| | | |
. . .---. . . . . . . .---. . . . .
| | G | |
--- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---.
END
my $starpos = /\*/ && $-[0];
my $base = tr/RGBY*/ /r;
my $w = /\n/ && $-[0];
my $gap = qr/.{$w}/s;
my @queue = code($_) . "= ";
my %seen;
my %before;
my $max = 1025;
sub code { lc(shift) =~ tr/rgby/\0/cr =~ s/\0+/length $&/ger }
while( @queue )
{
my ($grid, $moves) = split /=/, shift @queue;
$seen{$grid}++ and next;
local $_ = $grid =~ s/\d+/"\0" x $&/ger ^ $base;
if( 'Y' eq substr $_, $starpos, 1 )
{
my $numoves = $moves =~ tr/lrud//;
print "\n$_\ncompleted in $numoves moves $moves\n";
exit;
}
print "$_=$moves\n";
for my $robot ( qw( Y G R ) )
{
/(?:\| |\w )\K[ *]([ *]+)$robot/
&& $before{$-[0]}++ < $max
and push @queue,
code(s/(?:\| |\w )\K[ *]([ *]+)$robot/$robot$1 /r)
. "=$moves ${robot}l";
/$robot([ *]+)([ *])(?= \w| \|)/
&& $before{$-[2]}++ < $max
and push @queue,
code(s/$robot([ *]+)[ *](?= \w| \|)/ $1$robot/r)
. "=$moves ${robot}r";
/$robot((?:$gap[ *])*$gap)([ *])(?=${gap}-|$gap $gap\w)/
&& $before{$-[2]}++ < $max
and push @queue,
code(s/$robot((?:$gap[ *])+$gap)[ *](?=${gap}-|$gap $gap\w)/ $1$
+robot/r)
. "=$moves ${robot}d";
/(?:-$gap|\w$gap $gap)\K[ *]((?:$gap[ *])*$gap)$robot/
&& $before{$-[0]}++ < $max
and push @queue,
code(s/(?:-$gap|\w$gap $gap)\K[ *]((?:$gap[ *])*$gap)$robot/$rob
+ot$1 /r)
. "=$moves ${robot}u";
}
}
|