Re: Challenge: Ricochet Robots

Hmmm...

#!/usr/bin/perl

use strict; # https://perlmonks.org/?node_id=11128527
use warnings;

local $_ = <<END;
 --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---.
|                   |                 R |                       |
    .   .---.   .   .   .   .   .   .   .   .   .   .   .---.   .
|       |                                               |       |
    .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   .
|                                           |                   |
    .   .   .   .   .   .   .   .   .   .   .---.   .   .   .   .
|                       |                                       |
    .   .   .   .   .   .---.   .   .   .   .   .   .   .   .---.
|                                                               |
 ---.   .   .   .---.   .   .   .   .   .   .   .   .   .   .   .
|                   |                                           |
    .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   .
|       |                                               |       |
    .---.   .   .   .   .   .---.---.   .---.   .   .---.   .   .
|         *                 |       |       |                   |
    .   .   .   .   .   .   .   .   .   .   .   .   .   .   .   .
|                           |       |                           |
    .   .   .   .   .   .   .---.---.   .   .   .---.   .   .   .
|               |                                 B |           |
    .   .   .   .---.   .---.   .   .   .   .   .   .   .   .---.
|                       |                                       |
 ---.   .   .   .   .   .   .   .   .   .   .   .   .   .   .   .
|                                                               |
    .   .   .   .   .   .   .---.   .---.   .   .   .   .   .   .
|                               |   |                           |
    .---.   .   .   .   .   .   .   .   .   .   .   .   .   .   .
|     Y |                                               |       |
    .   .   .   .   .   .   .   .   .   .   .   .   .   .---.   .
|               |                               |               |
    .   .   .---.   .   .   .   .   .   .   .---.   .   .   .   .
|                   | G                                 |       |
 --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---.
END

my $starpos = /\*/ && $-[0];
my $w = /\n/ && $-[0];
my $gap = qr/.{$w}/s;
my @queue = "$_= ";
my %seen;

while( @queue )
  {
  (local $_, my $moves) = split /=/, shift @queue;
  $seen{$_}++ and next;
  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 ) )
    {
    /(?:\| |\w   )\K[ *]([ *]+)$robot/ and push @queue,
      (s/(?:\| |\w   )\K[ *]([ *]+)$robot/$robot$1 /r)
      . "=$moves ${robot}l";
    /$robot([ *]+)([ *])(?=   \w| \|)/ and push @queue,
      (s/$robot([ *]+)[ *](?=   \w| \|)/ $1$robot/r)
      . "=$moves ${robot}r";
    /$robot((?:$gap[ *])*$gap)([ *])(?=${gap}-|$gap $gap\w)/ and push 
+@queue,
      (s/$robot((?:$gap[ *])+$gap)[ *](?=${gap}-|$gap $gap\w)/ $1$robo
+t/r)
      . "=$moves ${robot}d";
    /(?:-$gap|\w$gap $gap)\K[ *]((?:$gap[ *])*$gap)$robot/ and push @q
+ueue,
      (s/(?:-$gap|\w$gap $gap)\K[ *]((?:$gap[ *])*$gap)$robot/$robot$1
+ /r)
      . "=$moves ${robot}u";
    }
  }
[download]

Comment on Re: Challenge: Ricochet Robots Download Code

Replies are listed 'Best First'.
Re^2: Challenge: Ricochet Robots by LanX (Saint) on Feb 19, 2021 at 17:03 UTC
Hmmm... False input. Cheers Rolf _{(addicted to the Perl Programming Language :) Wikisyntax for the Monastery} EDIT: nice try,though :-) UPDATE `for my $robot ( qw( Y G ) )` Cough ... yeah sure...	[reply] [d/l]
Re^3: Challenge: Ricochet Robots by tybalt89 (Monsignor) on Feb 19, 2021 at 19:06 UTC
Just a litle tweaking :) <Reveal this spoiler or all in this thread> #!/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"; } } [download]	[reply] [d/l]
Re^4: Challenge: Ricochet Robots by LanX (Saint) on Feb 19, 2021 at 20:54 UTC
> `for my $robot ( qw( Y G R ) )` What about "B"? ;) Cheers Rolf _{(addicted to the Perl Programming Language :) Wikisyntax for the Monastery}	[reply] [d/l]
Re^3: Challenge: Ricochet Robots by tybalt89 (Monsignor) on Feb 19, 2021 at 17:22 UTC
Ah, mucking about with the* and must have put it back wrong :(	[reply]
Re^4: Challenge: Ricochet Robots by LanX (Saint) on Feb 19, 2021 at 19:19 UTC
But did you have fun? :) Cheers Rolf _{(addicted to the Perl Programming Language :) Wikisyntax for the Monastery}	[reply]
Re^5: Challenge: Ricochet Robots by tybalt89 (Monsignor) on Feb 19, 2021 at 19:28 UTC
Re^6: Challenge: Ricochet Robots by LanX (Saint) on Feb 19, 2021 at 20:47 UTC

UPDATE