#!/usr/bin/perl
use warnings;
use strict;
use feature qw{ say };

use constant WIDTH => 16;

sub char { chr $_[0] + ord '@' }
sub num  { ord($_[0]) - ord '@' }

my @BELOW = qw( A5 A11 B7 B13 C1 D15 E5 E10 G4 G10 H7 H9
                H12 I7 I9 J12 K7 L3 L15 M9 N7 O1 O14 P4 P10 );
my @RIGHT = qw( B2 B7 B14 D10 D15 E1 E6 E16 F4 F11 G8 G9
                H13 I8 I9 I13 J1 K3 K8 L15 M10 N2 N7 N14 N16 );
my %BLOCKED;
@{ $BLOCKED{BELOW} }{@BELOW} = ();
@{ $BLOCKED{RIGHT} }{@RIGHT} = ();

my @DIRECTIONS = ([0, 1], [1, 0], [0, -1], [-1, 0]);  # down, right, u
+p, left.

my %access;
for my $column (1 .. WIDTH) {
    for my $row (1 .. WIDTH) {
        for my $direction (@DIRECTIONS) {
            my ($target_row, $target_column) = ($row, $column);
            while (1) {
                my $column_correction = $direction->[0] > -1 ? 0 : -1;
                my $row_correction = $direction->[1] > -1 ? 0 : -1;
                my $check = (char($target_column + $column_correction)
+)
                          . ($target_row + $row_correction);
                last if exists $BLOCKED{
                    $direction->[0] ? 'RIGHT' : 'BELOW'}{$check};

                my $next_row = $target_row + $direction->[1];
                my $next_column = $target_column + $direction->[0];
                my $moving = $direction->[0] ? $next_column : $next_ro
+w;
                last if $moving < 1 || $moving > WIDTH;

                $target_row = $next_row;
                $target_column = $next_column;

            }
            undef $access{$column}{$row}{$target_column}{$target_row}
                unless $column == $target_column && $row == $target_ro
+w;
        }
    }
}

my %robot = (R => [num('J'), 1],
             G => [num('F'), 16],
             B => [num('M'), 10],
             Y => [num('B'), 14]);

sub config { pack 'C8', map @$_, @robot{qw{ R G B Y }} }

sub setup {
    @robot{qw{ R G B Y }} = map [ unpack 'C2', pack S => $_ ], unpack 
+'S4', $_[0];
}

my $config = config();
my %previous = ($config => 1);
my %seen = ($config => 0);

my @goal = (num('C'), 9);
my $step = 1;
SOLVE:
while (1) {
    for my $config (keys %seen) {
        next unless $seen{$config} == $step - 1;
        setup($config);
        for my $robot (keys %robot) {
            for my $target_column (keys %{ $access{ $robot{$robot}[0] 
+}
                                                  { $robot{$robot}[1] 
+} }
            ) {
                for my $target_row (keys %{ $access{ $robot{$robot}[0]
+ }
                                                   { $robot{$robot}[1]
+ }
                                                   {$target_column} }
                ) {
                    my ($robot_column, $robot_row) = @{ $robot{$robot}
+ };
                    for my $other (grep $_ ne $robot, keys %robot) {
                        my ($other_column, $other_row) = @{ $robot{$ot
+her} };
                        if ($robot_column == $target_column
                            && $robot_column == $other_column
                        ) {
                            if ($robot_row < $other_row && $other_row 
+<= $target_row) {
                                $target_row = $other_row - 1;
                            } elsif ($robot_row > $other_row && $other
+_row >= $target_row) {
                                $target_row = $other_row + 1;
                            }
                        } elsif ($robot_row == $target_row
                                 && $robot_row == $other_row
                        ) {
                            if ($robot_column < $other_column && $othe
+r_column <= $target_column) {
                                $target_column = $other_column - 1;
                            } elsif ($robot_column > $other_column && 
+$other_column >= $target_column) {
                                $target_column = $other_column + 1;
                            }
                        }
                    }
                    {   local $robot{$robot} = [$target_column, $targe
+t_row];
                        if ('Y' eq $robot && $robot{Y}[0] == $goal[0]
                                          && $robot{Y}[1] == $goal[1]
                        ) {
                            say "DONE $step";
                            my $c = $config;
                            my %robot_previous = %robot;
                            while ($c) {
                                for my $r (keys %robot) {
                                    say "$r: ", char($robot_previous{$
+r}[0]), $robot_previous{$r}[1]
                                        unless "@{ $robot_previous{$r}
+ }" eq "@{ $robot{$r} }";
                                }
                                %robot_previous = %robot;
                                setup($c);
                                $c = $previous{$c};
                            }
                            last SOLVE
                        }
                        my $next = config();
                        next if exists $seen{$next};
                        $seen{$next} = $step;
                        $previous{$next} = $config;
                    }
                }
            }
        }
    }
    ++$step;
}
[download]