From: Jan "Yenya" Kasprzak <kas@fi.muni.cz>
Date: Mon, 19 Dec 2022 12:35:14 +0000 (+0100)
Subject: Day 19: pruning the DFS
X-Git-Url: https://www.fi.muni.cz/~kas/git//home/kas/public_html/git/?p=aoc.git;a=commitdiff_plain;h=76727637971e2e993a12b9859a911c7fef030bd5

Day 19: pruning the DFS
---

diff --git a/2022/37.pl b/2022/37.pl
new file mode 100755
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
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;
+}
+