AoC 2024, day 15, part 2 (Perl)

#!/usr/bin/perl

use strict;
use warnings;

use feature         qw(say);
use List::Util      qw(any all);

use Math::Vector::Real;

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

$/ = '';
my ($in_map, $in_moves) = map {[split /\n/]} <>;

my @moves = map {  split //  } @$in_moves;
my @Grid  = map { [map {($_ eq 'O') ? ('[',']') : ($_,$_)} split //] } @$in_map;
my $robot;

sub grid_at ($) { my $p = shift; return ($Grid[$p->[0]][$p->[1]]) }

SEARCH:
foreach my $y (0 .. $#Grid) {
    foreach my $x (0 .. $Grid[0]->$#*) {
        if ($Grid[$y][$x] eq '@') {
            $robot = V($y, $x);
            $Grid[$y][$x]   = '.';
            $Grid[$y][$x+1] = '.';
            last SEARCH;
        }
    }
}

# Recursive sub to test if boxes can be vertically pushed (and collect them in boxes)
# And leaf hitting a wall stops everything... everything needs to be clear at the ends.
sub test_vert_push {
    my ($pos, $dir, $boxes) = @_;

    push( @$boxes, $pos );

    # Get both squares ahead of box push
    my @ahead = map {grid_at($pos + $_)} ($dir, $dir + $vx);
    if (all {$_ eq '.'} @ahead) {
        return (1);
    } elsif (any {$_ eq '#'} @ahead) {
        return (0);
    }

    # Got more multipushing to do
    my $ret = 1;
    if (join('', @ahead) eq '[]') {
        $ret *= &test_vert_push( $pos + $dir, $dir, $boxes );   # one box straight ahead
    } else {
        # A box to the left or right ahead, maybe both:
        $ret *= &test_vert_push( $pos + $dir - $vx, $dir, $boxes ) if ($ahead[0] eq ']');
        $ret *= &test_vert_push( $pos + $dir + $vx, $dir, $boxes ) if ($ahead[1] eq '[');
    }

    return ($ret);
}

MOVE:
foreach my $d (@moves) {
    my $move = $robot + $Dirs{$d};
    my $targ = grid_at($move);

    if ($targ eq '.' or $targ eq '#') {
        $robot = $move  if ($targ eq '.');      # move
        next MOVE;
    }

    # Pushing a box
    if ($d eq '<' or $d eq '>') {   # horizontal push
        my $end = $move;

        # Check for space at end of multipush
        $end += $Dirs{$d}  while (grid_at($end) eq '[' or grid_at($end) eq ']');

        next MOVE if (grid_at($end) eq '#');    # bump

        # Box halves toggle left<->right in horizontal push
        for (my $p = $move; $p != $end; $p += $Dirs{$d}) {
            $Grid[ $p->[0] ][ $p->[1] ] = (grid_at($p) eq '[' ? ']' : '[');
        }

        # Set the ends, move the robot
        $Grid[  $end->[0] ][  $end->[1] ] = grid_at($move);
        $Grid[ $move->[0] ][ $move->[1] ] = '.';
        $robot = $move;

    } else {                        # vertical push
        my @boxes;
        my $test = &test_vert_push( $move - $vx * (grid_at($move) eq ']'), $Dirs{$d}, \@boxes );

        if ($test) {
            # clear old box locations
            foreach my $box (@boxes) {
                $Grid[ $box->[0] ][ $box->[1]   ] = '.';
                $Grid[ $box->[0] ][ $box->[1]+1 ] = '.';
            }

            # set new box locations
            foreach my $box (@boxes) {
                my $p = $box + $Dirs{$d};
                $Grid[ $p->[0] ][ $p->[1]   ] = '[';
                $Grid[ $p->[0] ][ $p->[1]+1 ] = ']';
            }

            $robot = $move;
        }
    }
}

my $part2 = 0;
foreach my $y (0 .. $#Grid) {
    foreach my $x (0 .. $Grid[0]->$#*) {
        $part2 += (100 * $y + $x)  if ($Grid[$y][$x] eq '[');
    }
}

say "Part 2: $part2";