AoC 2022, day 19 (Perl)

#!/usr/bin/perl

use strict;
use warnings;

use List::AllUtils      qw(onlyidx pairwise all indexes max sum product reduce);

$| = 1;

sub vec_sum ($$)   { my ($v, $w) = @_; return ([pairwise {$a + $b} @$v, @$w]); }
sub vec_minus ($$) { my ($v, $w) = @_; return ([pairwise {$a - $b} @$v, @$w]); }
sub great_eq ($$)  { my ($v, $w) = @_; return (all {$_} pairwise {$a >= $b} @$v, @$w); }

my @Materials = ('ore', 'clay', 'obsidian', 'geode');

# Read in Blueprints
my %Blueprint;
foreach my $line (map { chomp; [split /[:.]/] } <>) {
    my ($num) = (shift @$line) =~ m#Blueprint (\d+)#;
    foreach (@$line) {
        my ($type, $ore, $other) = m#(\w+) robot costs (\d+) ore(?: and (\d+))?#;
        my $idx = onlyidx {$_ eq $type} @Materials;

        $Blueprint{$num}[$idx][0]  = int($ore);
        $Blueprint{$num}[$idx][$_] = 0  foreach (1 .. 3);
        $Blueprint{$num}[$idx][$idx - 1] = int($other) if ($idx > 1);
    }
}

sub run_blueprint {
    my ($num, $time_limit) = @_;

    my $best = -1;
    my $top_crackers = 0;
    my $bp = $Blueprint{$num};
    my $max_need = reduce {[map {max($a->[$_], $b->[$_])} (0 .. 3)]} ([0,0,0,~0], @$bp);

    my $old = 0;
    my %visit;
    my @queue = ([0, [1,0,0,0], [0,0,0,0]]);

    STATE:
    while (my $state = shift @queue) {
        my ($time, $robots, $mats, %passed) = @$state;

        if ($time > $old) {
            print ::stderr "[$num] Time $time (queue: ", scalar @queue, ")   \r";
            $old = $time;
        }

        if ($time == $time_limit) {
            $best = max( $best, $mats->[3] );
            next STATE;
        }

        # ASSUME: catching up/getting ahead from 2 geode crackers behind isn't going to happen
        next STATE if ($visit{"@$robots:@$mats"}++ or $robots->[3] < $top_crackers - 1);

        # Possible builds: have resources, less than max number needed, not passed last turn
        my @builds = indexes {great_eq( $mats, $_ )} @$bp;
        @builds = grep { $robots->[$_] < $max_need->[$_] and !exists $passed{$_} } @builds;

        $mats = vec_sum( $mats, $robots );

        foreach my $rob (reverse @builds) {
            my $new_mats = vec_minus( $mats, $bp->[$rob] );
            my @new_robots = @$robots;
            $new_robots[$rob]++;

            push( @queue, [$time + 1, \@new_robots, $new_mats] );

            $top_crackers = max( $top_crackers, $new_robots[3] ) if ($rob == 3);
        }

        # Wait for something new, keep track of what we're passing on
        push( @queue, [$time + 1, $robots, $mats, map {$_ => 1} @builds] );
    }

    print ::stderr "[$num] Best: $best                                     \n";
    return ($best);
}

my $part1 = sum map { $_ * &run_blueprint($_, 24) } sort {$a <=> $b} keys %Blueprint;
print "\nPart 1: $part1\n";

my $part2 = product map { &run_blueprint($_, 32) } (1 .. 3);
print "Part 2: $part2\n";