Day 19: pruning the DFS

diff --git a/2022/37.pl b/2022/37.pl
new file mode 100755 (executable)
index 0000000..78dbced
--- /dev/null
+++ b/2022/37.pl
@@ -0,0 +1,83 @@
+#!/usr/bin/perl -w
+
+use v5.36;
+use strict;
+use List::Util qw(max);
+
+my $sum = 0;
+while (<>) {
+       # my ($id, $ore, $clay, $obs_ore, $obs_clay, $geode_ore, $geod_obs)
+       my @bp = /(\d+)/g;
+
+       my @g = (
+               # ore clay obs
+               [ $bp[1], 0, 0, 0 ],
+               [ $bp[2], 0, 0, 0 ],
+               [ $bp[3], $bp[4], 0, 0 ],
+               [ $bp[5], 0, $bp[6], 0 ],
+       );
+       my $res = dfs(\@g);
+       say "$bp[0]: $res";
+       $sum += $bp[0] * $res;
+}
+
+say $sum;
+
+sub dfs($g) {
+       my @q = ([ 0, [ 1, 0, 0, 0 ], [ 0, 0, 0, 0 ], 0, 0 ]);
+       my @needed;
+       for my $rob (0 .. 3) {
+               for my $comp (0 .. 2) {
+                       $needed[$comp] = $g->[$rob][$comp]
+                               if !defined $needed[$comp]
+                                       || $g->[$rob][$comp] > $needed[$comp];
+               }
+       }
+
+       my $mx = 0;
+       while (@q) {
+               my ($t, $robs, $inv, $cantbuy, $didntbuy) = @{ shift @q };
+
+               if ($t++ == 24) {
+                       if ($inv->[3] > $mx) {
+                               $mx = $inv->[3];
+                               say "   $mx";
+                       }
+                       next;
+               }
+
+               my @ni = @$inv;
+               for (0 .. 3) {
+                       $ni[$_] += $robs->[$_];
+               }
+
+               ROBOT:
+               for my $bpn (reverse 0 .. 3) {
+                       my $bp = $g->[$bpn];
+                       my $mask = 1 << $bpn;
+                       next if $cantbuy & $mask;
+                       if ($bpn < 3 && $robs->[$bpn] >= $needed[$bpn]) {
+                               $cantbuy |= $mask;
+                               next;
+                       }
+
+                       next if $didntbuy & $mask;
+                       for (0 .. 2) {
+                               next ROBOT if $bp->[$_] > $inv->[$_];
+                       }
+                       my @ni1 = @ni;
+                       for (0 .. 2) {
+                               $ni1[$_] -= $bp->[$_];
+                       }
+                       my @nr = @$robs;
+                       $nr[$bpn]++;
+                       $didntbuy |= $mask;
+                       unshift @q, [ $t, \@nr, \@ni1, $cantbuy, 0 ];
+               }
+
+               unshift @q, [ $t, $robs, \@ni, $cantbuy, $didntbuy ]
+                       if $didntbuy != 0xf;
+       }
+       $mx;
+}
+

diff --git a/2022/38.pl b/2022/38.pl
new file mode 100755 (executable)
index 0000000..f72f5c4
--- /dev/null
+++ b/2022/38.pl
@@ -0,0 +1,84 @@
+#!/usr/bin/perl -w
+
+use v5.36;
+use strict;
+use List::Util qw(max);
+
+my $prod = 1;
+while (<>) {
+       # my ($id, $ore, $clay, $obs_ore, $obs_clay, $geode_ore, $geod_obs)
+       my @bp = /(\d+)/g;
+
+       my @g = (
+               # ore clay obs
+               [ $bp[1], 0, 0, 0 ],
+               [ $bp[2], 0, 0, 0 ],
+               [ $bp[3], $bp[4], 0, 0 ],
+               [ $bp[5], 0, $bp[6], 0 ],
+       );
+       my $res = dfs(\@g);
+       say "$bp[0]: $res";
+       $prod *= $res;
+       last if $bp[0] == 3;
+}
+
+say $prod;
+
+sub dfs($g) {
+       my @q = ([ 0, [ 1, 0, 0, 0 ], [ 0, 0, 0, 0 ], 0, 0 ]);
+       my @needed;
+       for my $rob (0 .. 3) {
+               for my $comp (0 .. 2) {
+                       $needed[$comp] = $g->[$rob][$comp]
+                               if !defined $needed[$comp]
+                                       || $g->[$rob][$comp] > $needed[$comp];
+               }
+       }
+
+       my $mx = 0;
+       while (@q) {
+               my ($t, $robs, $inv, $cantbuy, $didntbuy) = @{ shift @q };
+
+               if ($t++ == 32) {
+                       if ($inv->[3] > $mx) {
+                               $mx = $inv->[3];
+                               say "   $mx";
+                       }
+                       next;
+               }
+
+               my @ni = @$inv;
+               for (0 .. 3) {
+                       $ni[$_] += $robs->[$_];
+               }
+
+               ROBOT:
+               for my $bpn (reverse 0 .. 3) {
+                       my $bp = $g->[$bpn];
+                       my $mask = 1 << $bpn;
+                       next if $cantbuy & $mask;
+                       if ($bpn < 3 && $robs->[$bpn] >= $needed[$bpn]) {
+                               $cantbuy |= $mask;
+                               next;
+                       }
+
+                       next if $didntbuy & $mask;
+                       for (0 .. 2) {
+                               next ROBOT if $bp->[$_] > $inv->[$_];
+                       }
+                       my @ni1 = @ni;
+                       for (0 .. 2) {
+                               $ni1[$_] -= $bp->[$_];
+                       }
+                       my @nr = @$robs;
+                       $nr[$bpn]++;
+                       $didntbuy |= $mask;
+                       unshift @q, [ $t, \@nr, \@ni1, $cantbuy, 0 ];
+               }
+
+               unshift @q, [ $t, $robs, \@ni, $cantbuy, $didntbuy ]
+                       if $didntbuy != 0xf;
+       }
+       $mx;
+}
+