Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine
 
PerlMonks  

Re: Challenge: Ricochet Robots (more edits)

by vr (Curate)
on Feb 22, 2021 at 18:31 UTC ( #11128660=note: print w/replies, xml ) Need Help??


in reply to Challenge: Ricochet Robots

Sorry to be late,

it took me two days to write it

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.

Edit: added readmore tag. Removed trailing space in one code line for better display in the node ("perfectionism"? never heard of that). Noticed, that lexical $x and $y in subroutine "shadow" variables with same names, used in same scope. Ugly, but won't fix it. Let it stay...

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 :)

Replies are listed 'Best First'.
Re^2: Challenge: Ricochet Robots (updated)
by LanX (Sage) on Feb 22, 2021 at 19:13 UTC
    No problem being late, I didn't call it yet. :)

    Tybalt89's solution doesn't qualify, knowing beforehand that you don't need one of the robots wasn't part of my game. With such a reduced branch factor brute forcing is easy.

    Though it made me think about

    • the best way to design challenges
    • types of challenges and avoiding misunderstandings

    My goal was a general algorithm to solve random robot positions in acceptable time.

    And to have a problem hard enough to demonstrate some basic and advanced techniques like branch and bound. The recent triangle challenge was far too lightweight in complexity.

    FWIW: The origin of this problem was a game we played at our students union in 2005.

    But many people attempted to solve the whole problem class in the meantime and published solutions.

    Cheers Rolf
    (addicted to the Perl Programming Language :)
    Wikisyntax for the Monastery

    UPDATE
    • Your solution is correct, it's analogous to the other shown yet. (please add spoiler tags though)
    • Runtime on my laptop averaged at 75 seconds after 3 runs
    • Memory was ~1.3-1.5GB
    Disclaimer: I maybe should write a proper test suite for benchmarking under reproducible conditions.
      > types of challenges and avoiding misunderstandings

      I was once at a regional open source conference - "MRMCD" (kind of the local branch of CCC) which was fun.

      And they had a golfing competition, with online submission. You were allowed to choose the language, and at the end of the conference the winners were declared by language.

      And I was very confident to win in Perl, since practically nobody there knew Perl.

      To my great astonishment I was beaten by large distance, and I was very curious to learn these new advanced techniques.

      Now what happened was: the test cases were given in advance, i.e. input on STDIN and expected output on STDOUT and automatically tested for all contributions.

      While I tried to process the input did the winner just do something like print "EXPECTED OUTPUT"

      Well ...

      Cheers Rolf
      (addicted to the Perl Programming Language :)
      Wikisyntax for the Monastery

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://11128660]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others pondering the Monastery: (5)
As of 2022-08-18 05:02 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?