Rest of 2019

[aoc.git] / 2019 / 40.pl

diff --git a/2019/40.pl b/2019/40.pl
new file mode 100755 (executable)
index 0000000..27ea338
--- /dev/null
+++ b/2019/40.pl
@@ -0,0 +1,78 @@
+#!/usr/bin/perl -w
+
+use v5.16;
+
+my @map = map { chomp; [ split // ] } <>;
+my $maxx = @{ $map[0] };
+my $maxy = @map;
+
+$; = ',';
+
+my %portals;
+
+sub add_portal {
+       my ($name, $x, $y) = @_;
+       say "add_portal: $name, $x, $y";
+       if (defined $portals{$name}) {
+               my ($x1, $y1) = @{ $portals{$name} };
+               $map[$y][$x] = [$x1, $y1];
+               $map[$y1][$x1] = [$x, $y];
+               say "portal $name: $x,$y <==> $x1,$y1";
+       } else {
+               $portals{$name} = [$x, $y];
+       }
+}
+
+sub find_portals {
+       my @d = @_;
+       for my $x (2 .. $maxx-3) {
+               for my $y (2 .. $maxy-3) {
+                       next if $map[$y][$x] ne '.';
+                       my $l1 = $map[$y+$d[1]][$x+$d[0]];
+                       my $l2 = $map[$y+$d[3]][$x+$d[2]];
+                       next if "$l1$l2" !~ /^[A-Z][A-Z]$/;
+                       add_portal("$l1$l2", $x, $y);
+               }
+       }
+}
+
+find_portals(0, -2, 0, -1);
+find_portals(0, 1, 0, 2);
+find_portals(-2, 0, -1, 0);
+find_portals(1, 0, 2, 0);
+
+
+my %seen;
+my @q = [ @{ $portals{'AA'} }, 0, 0 ];
+my ($ex, $ey) = @{ $portals{'ZZ'} };
+say "walking towards $ex, $ey, 0";
+
+while (@q) {
+       my ($x, $y, $z, $steps) = @{ shift @q };
+       next if $seen{$x,$y,$z}++;
+       say "at $x,$y,$z $steps";
+
+       if ($x == $ex && $y == $ey && $z == 0) {
+               say "Found after $steps steps";
+               last;
+       }
+
+       $steps++;
+       if (ref $map[$y][$x]) {
+               my ($nx, $ny) = @{ $map[$y][$x] };
+               if ($x == 2 || $y == 2 || $x == $maxx - 3 || $y == $maxy - 3) {
+                       if ($z > 0) {
+                               push @q, [ $nx, $ny, $z-1, $steps ];
+                       }
+               } else {
+                       push @q, [ $nx, $ny, $z+1, $steps ];
+               }
+       }
+       for my ($dx, $dy) (0, 1, 1, 0, -1, 0, 0, -1) {
+               my $nx = $x + $dx;
+               my $ny = $y + $dy;
+               next if $map[$ny][$nx] ne '.' && !ref $map[$ny][$nx];
+               push @q, [$nx, $ny, $z, $steps];
+       }
+}
+