2019/40.pl

   1 #!/usr/bin/perl -w
   2
   3 use v5.16;
   4
   5 my @map = map { chomp; [ split // ] } <>;
   6 my $maxx = @{ $map[0] };
   7 my $maxy = @map;
   8
   9 $; = ',';
  10
  11 my %portals;
  12
  13 sub add_portal {
  14         my ($name, $x, $y) = @_;
  15         say "add_portal: $name, $x, $y";
  16         if (defined $portals{$name}) {
  17                 my ($x1, $y1) = @{ $portals{$name} };
  18                 $map[$y][$x] = [$x1, $y1];
  19                 $map[$y1][$x1] = [$x, $y];
  20                 say "portal $name: $x,$y <==> $x1,$y1";
  21         } else {
  22                 $portals{$name} = [$x, $y];
  23         }
  24 }
  25
  26 sub find_portals {
  27         my @d = @_;
  28         for my $x (2 .. $maxx-3) {
  29                 for my $y (2 .. $maxy-3) {
  30                         next if $map[$y][$x] ne '.';
  31                         my $l1 = $map[$y+$d[1]][$x+$d[0]];
  32                         my $l2 = $map[$y+$d[3]][$x+$d[2]];
  33                         next if "$l1$l2" !~ /^[A-Z][A-Z]$/;
  34                         add_portal("$l1$l2", $x, $y);
  35                 }
  36         }
  37 }
  38
  39 find_portals(0, -2, 0, -1);
  40 find_portals(0, 1, 0, 2);
  41 find_portals(-2, 0, -1, 0);
  42 find_portals(1, 0, 2, 0);
  43
  44
  45 my %seen;
  46 my @q = [ @{ $portals{'AA'} }, 0, 0 ];
  47 my ($ex, $ey) = @{ $portals{'ZZ'} };
  48 say "walking towards $ex, $ey, 0";
  49
  50 while (@q) {
  51         my ($x, $y, $z, $steps) = @{ shift @q };
  52         next if $seen{$x,$y,$z}++;
  53         say "at $x,$y,$z $steps";
  54
  55         if ($x == $ex && $y == $ey && $z == 0) {
  56                 say "Found after $steps steps";
  57                 last;
  58         }
  59
  60         $steps++;
  61         if (ref $map[$y][$x]) {
  62                 my ($nx, $ny) = @{ $map[$y][$x] };
  63                 if ($x == 2 || $y == 2 || $x == $maxx - 3 || $y == $maxy - 3) {
  64                         if ($z > 0) {
  65                                 push @q, [ $nx, $ny, $z-1, $steps ];
  66                         }
  67                 } else {
  68                         push @q, [ $nx, $ny, $z+1, $steps ];
  69                 }
  70         }
  71         for my ($dx, $dy) (0, 1, 1, 0, -1, 0, 0, -1) {
  72                 my $nx = $x + $dx;
  73                 my $ny = $y + $dy;
  74                 next if $map[$ny][$nx] ne '.' && !ref $map[$ny][$nx];
  75                 push @q, [$nx, $ny, $z, $steps];
  76         }
  77 }
  78