Day 16: searching the maze

diff --git a/2024/31.pl b/2024/31.pl
new file mode 100755 (executable)
index 0000000..94e8218
--- /dev/null
+++ b/2024/31.pl
@@ -0,0 +1,40 @@
+#!/usr/bin/perl -w
+
+use v5.40;
+use Array::Heap;
+
+my ($x, $y);
+my @map;
+while (<>) {
+       chomp;
+       if (/S/g) {
+               $x = pos()-1;
+               $y = $.-1;
+       }
+       push @map, [ split // ];
+}
+
+my @dirs = (
+       [1, 0],
+       [0, 1],
+       [-1, 0],
+       [0, -1],
+);
+
+my @q = ([0, $x, $y, 0 ]);
+my %seen;
+while (@q) {
+       my $qq = pop_heap @q;
+       my ($score, $x, $y, $dir) = @$qq;
+       next if $seen{"$x,$y,$dir"}++;
+       if ($map[$y][$x] eq 'E') {
+               say $score;
+               last;
+       }
+       push_heap @q, [1000+$score, $x, $y, ($dir-1)%4];
+       push_heap @q, [1000+$score, $x, $y, ($dir+1)%4];
+       my ($nx, $ny) = ($x + $dirs[$dir]->[0], $y + $dirs[$dir]->[1]);
+       if ($map[$ny][$nx] ne '#') {
+               push_heap @q, [1+$score, $nx, $ny, $dir];
+       }
+}

diff --git a/2024/32.pl b/2024/32.pl
new file mode 100755 (executable)
index 0000000..459caed
--- /dev/null
+++ b/2024/32.pl
@@ -0,0 +1,55 @@
+#!/usr/bin/perl -w
+
+use v5.40;
+use Array::Heap;
+
+my ($x, $y);
+my @map;
+while (<>) {
+       chomp;
+       if (/S/g) {
+               $x = pos()-1;
+               $y = $.-1;
+       }
+       push @map, [ split // ];
+};
+
+my @dirs = (
+       [1, 0],
+       [0, 1],
+       [-1, 0],
+       [0, -1],
+);
+
+my @q = ([0, $x, $y, 0, [$x, $y] ]);
+my %seen;
+my $best_score;
+my %best_path;
+while (@q) {
+       my $qq = pop_heap @q;
+       my ($score, $x, $y, $dir, @path ) = @$qq;
+
+       my $k = "$x,$y,$dir";
+       if (defined $seen{$k} && $seen{$k} < $score) {
+               next;
+       } else {
+               $seen{$k} = $score;
+       }
+       next if defined $best_score && $score > $best_score;
+       if ($map[$y][$x] eq 'E') {
+               $best_score = $score;
+               say $score, ' steps: ', scalar(@path);
+               for my $p (@path) {
+                       $best_path{"$p->[0],$p->[1]"}++;
+               }
+               next;
+       }
+       push_heap @q, [1000+$score, $x, $y, ($dir-1)%4, @path];
+       push_heap @q, [1000+$score, $x, $y, ($dir+1)%4, @path];
+       my ($nx, $ny) = ($x + $dirs[$dir]->[0], $y + $dirs[$dir]->[1]);
+       if ($map[$ny][$nx] ne '#') {
+               push_heap @q, [1+$score, $nx, $ny, $dir, [ $nx, $ny ], @path];
+       }
+}
+
+say scalar keys %best_path;