Discussion on: AoC Day 22: Mode Maze

#!/usr/bin/perl
use warnings;
use strict;
use feature qw{ say };

my ($depth)   = <> =~ /\d+/g;
my ($tx, $ty) = <> =~ /(\d+),(\d+)/;

my @cave;
sub level {
    my ($x, $y) = @_;
    ($cave[$x][$y] + $depth) % 20_183;
}

$cave[0][0] = 0;
$cave[$tx][$ty] = 0;

for my $x (0 .. $tx) {
    $cave[$x][0] //= $x * 16_807;
    for my $y (1 .. $ty) {
        $cave[$x][$y]
            //= $x == 0 ? $y * 48_271
                        : level($x - 1, $y) * level($x, $y - 1);
    }
}

my $s = 0;
for my $y (0 .. $ty) {
    for my $x (0 .. $tx) {
        my $l = level($x, $y) % 3;
        print +('.', '=', '|')[$l];
        $s += $l;
    }
    print "\n";
}

say $s;

#!/usr/bin/perl
use warnings;
use strict;
use feature qw{ say };

use enum qw( ROCKY WET NARROW );
use enum qw( GEAR TORCH NEITHER );

my ($depth)   = <> =~ /\d+/g;
my ($tx, $ty) = <> =~ /(\d+),(\d+)/;

my @cave;
my %level;
sub level {
    my ($x, $y) = @_;
    no warnings 'recursion';
    $level{$x}{$y} //= (cave($x, $y) + $depth) % 20_183;
}

$cave[0][0] = 0;
$cave[$tx][$ty] = 0;

sub cave {
    my ($x, $y) = @_;
    return $cave[$x][$y] if defined $cave[$x][$y];
    if ($x == 0) {
        $cave[$x][$y] = $y * 48_271;
    } elsif ($y == 0) {
        $cave[$x][$y] = $x * 16_807;
    } else {
        no warnings 'recursion';
        $cave[$x][$y] = level($x - 1, $y) * level($x, $y - 1);
    }
    $cave[$x][$y]
}

my %allowed = ((ROCKY)  => { (GEAR)  => undef, (TORCH)   => undef },
               (WET)    => { (GEAR)  => undef, (NEITHER) => undef },
               (NARROW) => { (TORCH) => undef, (NEITHER) => undef });

my @reach = ([{ (TORCH) => 0 }]);
$reach[0][0]{$_} = 7 for grep exists $allowed{ level(0, 0) % 3 }{$_},
                         GEAR, NEITHER;
my %queue = (0 => [[0, 0]]);
my $step = 0;
while (keys %queue) {
    my $current = delete $queue{$step};
    next unless $current;

    for my $coords (@$current) {
        my ($x, $y) = @$coords;
        for my $candidate ([$x + 1, $y], [$x - 1, $y],
                           [$x, $y - 1], [$x, $y + 1]
        ) {
            my ($i, $j) = @$candidate;
            next if $i < 0 || $j < 0;
            for my $tool_from (TORCH, GEAR, NEITHER) {
                next
                    unless exists $allowed{ level($x, $y) % 3 }{$tool_from}
                    && defined $reach[$x][$y]{$tool_from};

                for my $tool_to (TORCH, GEAR, NEITHER) {
                    next unless exists
                            $allowed{ level($x, $y) % 3 }{$tool_to}
                        && exists $allowed{ level($i, $j) % 3 }{$tool_to};

                    my $new = $reach[$x][$y]{$tool_from} + 1
                            + 7 * ($tool_from != $tool_to);
                    if (! defined $reach[$i][$j]{$tool_to}
                        || $new < $reach[$i][$j]{$tool_to}
                    ) {
                        $reach[$i][$j]{$tool_to} = $new;
                        push @{ $queue{$new} }, [$i, $j];
                    }
                }
            }
        }
    }

    if (defined $reach[$tx][$ty] && exists $reach[$tx][$ty]{+TORCH}) {
        say $step, ' ', $reach[$tx][$ty]{+TORCH};
        my $best = $reach[$tx][$ty]{+TORCH};
        last if $best < $step;
    }
} continue {
    say ++$step;
}

say $reach[$tx][$ty]{+TORCH};