AoC 2024, day 21, part 2 (Perl)

#!/usr/bin/perl

use strict;
use warnings;

use feature         qw(say state);
use List::Util      qw(reduce min sum);

use Math::Vector::Real;

my ($vy,$vx) = Math::Vector::Real->canonical_base(2);
my %Dirs = ('v' => $vy, '>' => $vx, '^' => -$vy, '<' => -$vx);

# Chain iterator:
sub chain (&@) {
    my $block = shift;
    return (map { &$block( $_[$_-1], $_[$_] ) } (1 .. $#_));
}

#
# Get locations of keys on the pads
#
my @keypad = map {[split //]} ('789X', '456X', '123X', 'X0AX', 'XXXX');
my @dirpad = map {[split //]} ('X^AX', '<v>X', 'XXXX');

sub process_pad {
    my %ret;
    foreach my $y (0 .. $#_) {
        foreach my $x (0 .. $_[0]->$#*) {
            next if ($_[$y][$x] eq 'X');
            $ret{$_[$y][$x]} = V($y,$x);
        }
    }
    return (%ret);
}

my %key_loc = &process_pad( @keypad );
my %dir_loc = &process_pad( @dirpad );

#
# Build routes between keys
#
sub route_pad {
    my ($loc, $pad) = @_;
    my %table;

    foreach my $start (keys %$loc) {
        KEY:
        foreach my $end (keys %$loc) {
            if ($start eq $end) {
                $table{$start,$end} = ['A'];
                next KEY;
            }

            my $delta = $loc->{$end} - $loc->{$start};
            my @steps = (($delta->[0] < 0) ? '^' : 'v', ($delta->[1] < 0) ? '<' : '>');
            my @queue = ([$loc->{$start}, '']);

            QUEUE:
            while (my $state = shift @queue) {
                my ($pos, $path) = @$state;
                if ($pos == $loc->{$end}) {
                    push( $table{$start, $end}->@*, $path . "A" );
                    next QUEUE;
                }

                foreach my $d (@steps) {
                    my $move = $pos + $Dirs{$d};
                    push(@queue, [$move, $path.$d]) if ($pad->[$move->[0]][$move->[1]] ne 'X');
                }
            }
        }
    }

    return (%table);
}

my %dir_route = &route_pad( \%dir_loc, \@dirpad );
my %key_route = &route_pad( \%key_loc, \@keypad );

#
# Mainline
#

# Set to 2 for part 1
my $Max_Depth = 25;

sub recurse_keypad {
    my ($seq, $depth) = @_;
    state %memo;

    my $routes = ($depth == 0) ? \%key_route : \%dir_route;
    my @seq = ('A', split( //, $seq ));

    $memo{$seq,$depth} //= ($depth == $Max_Depth)
                            ? sum chain { length( $routes->{$_[0],$_[1]}->[0] ) } @seq
                            : sum chain {
                                  reduce {
                                      min($a, &recurse_keypad($b, $depth+1))
                                  } (~0, $routes->{$_[0],$_[1]}->@*)
                              } @seq;
}

my @input = map {chomp; $_} <>;
say "Part 2: ", sum map { int(substr($_,0,-1)) * &recurse_keypad($_, 0) } @input;