I kicked myself (very hard) into motion just yesterday, so I guess this solution still qualifies. It's same brute force, is definitely faster than choroba's and eats a little less RAM. Though tybalt89's uses impressively less memory, but with blue robot excluded from the fun, I don't know how to measure against it.
Edit2: There are strategies, obvious in hindsight, to slightly increase speed of solution below, by 2-3 seconds i.e. just ~5%, and significantly reduce RAM usage, by 20% or more. (1) Store @agenda items and %seen values not as 8 or 4 byte strings, but longlong and long integers, respectively -- i.e. add a few pack/unpack calls. (2) Even better, use $agenda scalar instead of @agenda array, then chop 8 bytes as $key from its start on each LOOP iteration, and append new 8 byte keys, when found, to its end. In latter case, RAM usage stays below 1 Gb.
Edit3: Actually, with $agenda as a single scalar, %seen values as integers, and, also, vec gone for good (i.e. substituted with substr/pack) -- solution below runs in ~32s (20% off) and eats ~805 Mb RAM.
Edit4 (25.02): Heh, if memory footprint (with speed still decent) is more important, and CPAN XS modules are OK, then ditch Perl hash (%seen) altogether, to track robots' positions explored so far. Math::GSL::SparseMatrix requires very minor changes to below source, and performance is ~57s and ~308 Mb. I'll post code if required. Concern may be, that hash keys could be any, but with 2D matrix we are limiting number of robots and/or playfield size, to be encoded into 128 bits only. Our current setup requires just 32 bits (though I'm using 64), so there's still plenty of address space. (The (1 x 256**8) sparse "matrix" was used, actually.)
Edit 26.02: Heh, further, using Judy leads to far better time/memory compromise balance. With tests now in Linux, the updated results (time(seconds)/memory(Megabytes)) with fixes according to edits 3 (Perl hash), 4 (Math::GSL) and this one (Judy) are 29/720, 48/310 and 35/162, respectively. Technology is amazing.
-----
Sorry, also, for shifts instead of multiplications and divisions, and extra parentheses because of this, but it shaves off a couple seconds. Code is (very) ugly, especially in prologue when the play-board is set up, but I haven't written anything in a few months, so that's what it leads to.
use strict;
use warnings;
use feature 'say';
use Time::HiRes 'time';
STDOUT-> autoflush( 1 );
my @lines = map { chomp; pack 'A80', $_ } <DATA>;
my @even_lines = @lines[ grep !( $_ % 2 ), 2 .. $#lines - 2 ];
my @ROBOTS = qw/ Y R G B * /; # * IS NOT A ROBOT!!!
my ( @x, @y ); # robots coordinates
my $s = join '', @even_lines;
for ( @ROBOTS ) {
my $i = index $s, $_;
push @x, $i % 80 / 4 - 1;
push @y, int $i / 80;
}
my $TARGET_X = pop @x; # target position for 0th robot
my $TARGET_Y = pop @y;
# Transform playfield to lists of 16 rows and 16 columns.
# They are 33 characters long strings. Walls (external and
# internal) are a single "1" and are at even (counting from 0)
# positions only. So first 3 rows (without robots) are
#
# 100000000010000000001000000000001
# 100010000000000000000000000010001
# 100000000000000000000010000000001
#
# etc. Robot, if placed, sits on 3 characters (marking them as 1),
# its center at odd position. Therefore, given a picture with
# a placed robot, we can't tell if it's robot only or it touches
# a wall. But it's OK because we won't "remove" robots
# from (temporary) snapshots.
my @rows = map {
my $s = '0' x 33;
my @a;
push @a, pos while /\|/g;
substr $s, ( $_ - 3 ) / 2, 1, 1 for @a;
$s
} @even_lines;
my @cols = (( '0' x 33 ) x 16 );
for my $i ( 1 .. $#lines ) {
next unless $i % 2;
$_ = $lines[ $i ];
my @a;
push @a, pos while /---/g;
substr $cols[ ( $_ - 2 ) / 4 - 1 ], $i - 1, 1, 1 for @a;
}
my ( %seen, @agenda );
# Keys for %seen and items of @agenda are packed coordinates.
# Hash values are packed move number, robot id, its previous
# coordinates.
my $key = pack 'C8', @x, @y;
$seen { $key } = pack 'C4', 0, 0, 0, 0;
push @agenda, $key;
# Variables below (and $key above) are kept "global" to call a sub
# without passing any arguments:
#
# robot id, move number, current coords, new position (either
# x or y); offset is 0 when moving along row, 4 if along column
my ( $r, $move, $x, $y, $newpos, $offset );
sub check_move {
my $newkey = $key;
vec( $newkey, $r + $offset, 8 ) = $newpos;
return if exists $seen{ $newkey };
$seen{ $newkey } = pack 'C4', $move, $r, $x, $y;
push @agenda, $newkey;
return unless $r == 0;
my ( $x, $y ) = unpack 'Cx3C', $newkey;
return 1 if $x == $TARGET_X and $y == $TARGET_Y
}
my $t = time;
my $n = 0;
LOOP: while ( @agenda ) {
$key = shift @agenda;
$move = vec( $seen{ $key }, 0, 8 ) + 1;
my @coords = unpack 'C8', $key;
print '*' unless $n++ % 10000; # keep us entertained
for ( 0 .. 3 ) {
$r = $_;
$x = $coords[ $r ];
$y = $coords[ $r + 4 ];
my $row = $rows[ $y ];
my $col = $cols[ $x ];
for my $other_r ( 0 .. 3 ) { # place other robots for
# current move, if applicable
next if $r == $other_r;
substr $row, $coords[ $other_r ] << 1, 3, '111'
if $y == $coords[ $other_r + 4 ];
substr $col, $coords[ $other_r + 4 ] << 1, 3, '111'
if $x == $coords[ $other_r ];
}
$offset = 0;
( $newpos = ( index( $row, '1', ( $x << 1 ) + 1 ) >> 1 ) - 1 )
!= $x and check_move and last LOOP;
( $newpos = rindex( $row, '1', ( $x << 1 ) + 1 ) >> 1 )
!= $x and check_move and last LOOP;
$offset = 4;
( $newpos = ( index( $col, '1', ( $y << 1 ) + 1 ) >> 1 ) - 1 )
!= $y and check_move and last LOOP;
( $newpos = rindex( $col, '1', ( $y << 1 ) + 1 ) >> 1 )
!= $y and check_move and last LOOP;
}
}
print "\n\n";
# Unwind moves, but because we are going backwards,
# reverse order for final display.
$key = $agenda[ -1 ];
my @moves;
my @NUMBERS = ( 1 .. 16 );
my @LETTERS = ( 'A' .. 'P' );
while () {
my @coords = unpack 'C8', $key;
my ( $move, $r, $old_x, $old_y ) = unpack 'C4', $seen{ $key };
last if $move == 0;
my ( $x, $y ) = @coords[ $r, $r + 4 ];
push @moves, "$ROBOTS[$r] moves from ".
"$LETTERS[$old_x]$NUMBERS[$old_y] to ".
"$LETTERS[$x]$NUMBERS[$y]";
vec( $key, $r, 8 ) = $old_x;
vec( $key, $r + 4, 8 ) = $old_y;
}
say for reverse @moves;
say "\nTime consumed: ", time - $t;
__DATA__
A B C D E F G H I J K L M N O P
--- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
1| | R | |1
. .---. . . . . . . . . . . .---. .
2| | | |2
. . . . . . . . . . . . . . . .
3| | |3
. . . . . . . . . . .---. . . . .
4| | |4
. . . . . .---. . . . . . . . .---.
5| |5
---. . . .---. . . . . . . . . . . .
6| | |6
. . . . . . . . . . . . . . . .
7| | | |7
.---. . . . . .---.---. .---. . .---. . .
8| | | | |8
. . . . . . . . . . . . . . . .
9| * | | |9
. . . . . . .---.---. . . .---. . . .
10| | B | |10
. . . .---. .---. . . . . . . . .---.
11| | |11
---. . . . . . . . . . . . . . . .
12| |12
. . . . . . .---. .---. . . . . . .
13| | | |13
.---. . . . . . . . . . . . . . .
14| (Y)| | |14
. . . . . . . . . . . . . .---. .
15| | | |15
. . .---. . . . . . . .---. . . . .
16| | G | |16
--- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
A B C D E F G H I J K L M N O P
The output (stars skipped):
Y moves from B14 to A14
Y moves from A14 to A12
Y moves from A12 to P12
R moves from J1 to J12
R moves from J12 to A12
G moves from F16 to F1
G moves from F1 to J1
G moves from J1 to J12
G moves from J12 to B12
Y moves from P12 to C12
G moves from B12 to B8
R moves from A12 to B12
G moves from B8 to G8
R moves from B12 to B8
G moves from G8 to C8
Y moves from C12 to C9
Time consumed: 40.0800559520721
Thanks for distraction, I needed it :)
