Day 16: first ugly working solution

Part 2 runs for 16.5 minutes on my computer :-(

diff --git a/2022/31.pl b/2022/31.pl
new file mode 100755 (executable)
index 0000000..8b88e24
--- /dev/null
+++ b/2022/31.pl
@@ -0,0 +1,62 @@
+#!/usr/bin/perl -w
+
+use v5.36;
+use strict;
+
+my %flow;
+my %tun;
+
+while (<>) {
+       chomp;
+       my ($v, $f, $n) = /Valve (..) has flow rate=(\d+);.* to valves? (.*)/;
+       $flow{$v} = $f if $f;
+       $tun{$v} = [ split /, /, $n ];
+       say $n;
+}
+
+sub bfs($start) {
+       my %seen;
+       my @q = [ $start, 0 ];
+       while (@q) {
+               my $st = shift @q;
+               my ($node, $len, @path) = @$st;
+               next if $seen{$node};
+               $seen{$node} = [ $len, @path ];
+
+               for my $neigh (@{ $tun{$node} }) {
+                       push @q, [ $neigh, $len+1, @path, $node ];
+               }
+       }
+       return \%seen;
+}
+
+my %paths;
+for my $node ('AA', keys %flow) {
+       $paths{$node} = bfs($node);
+}
+
+my @q = [ 'AA', 30, 0, { }, [ ] ];
+
+my $max = 0;
+while (@q) {
+       my $st = shift @q;
+       my ($node, $mins, $total, $opened, $path) = @$st;
+       say "At $node $total $mins ", join(',', @$path);
+       if ($total > $max) {
+               $max = $total;
+       }
+       for my $n1 (keys %{ $paths{$node} }) {
+               next if !$flow{$n1};
+               my $dist = $paths{$node}{$n1}[0];
+               next if $opened->{$n1};
+
+               my $m1 = $mins - $dist - 1;
+               next if $m1 < 0;
+               my %o1 = (%$opened, $n1 => 1);
+               say " opening $n1 at $m1 ", $flow{$n1}*($m1);
+               push @q, [ $n1, $m1, $total + $flow{$n1}*($m1),
+                       \%o1, [ @$path, $n1 ] ];
+       }
+}
+
+say $max;

diff --git a/2022/32.pl b/2022/32.pl
new file mode 100755 (executable)
index 0000000..f61dc85
--- /dev/null
+++ b/2022/32.pl
@@ -0,0 +1,88 @@
+#!/usr/bin/perl -w
+
+use v5.36;
+use strict;
+
+my %flow;
+my %tun;
+
+while (<>) {
+       chomp;
+       my ($v, $f, $n) = /Valve (..) has flow rate=(\d+);.* to valves? (.*)/;
+       $flow{$v} = $f if $f;
+       $tun{$v} = [ split /, /, $n ];
+}
+
+sub bfs($start) {
+       my %seen;
+       my @q = [ $start, 0 ];
+       while (@q) {
+               my $st = shift @q;
+               my ($node, $len, @path) = @$st;
+               next if $seen{$node};
+               $seen{$node} = [ $len, @path ];
+
+               for my $neigh (@{ $tun{$node} }) {
+                       push @q, [ $neigh, $len+1, @path, $node ];
+               }
+       }
+       return \%seen;
+}
+
+my %paths;
+for my $node ('AA', keys %flow) {
+       $paths{$node} = bfs($node);
+}
+
+sub walk(@nodes) {
+       my @q = [ 'AA', 26, 0, { map { $_ => 1 } @nodes }, [ ] ];
+
+       my $max = 0;
+       while (@q) {
+               my $st = shift @q;
+               my ($node, $mins, $total, $opened, $path) = @$st;
+               
+               if ($total > $max) {
+                       # say "At $node $mins $total ", join(',', @$path);
+                       $max = $total;
+               }
+
+               for my $n1 (keys %{ $paths{$node} }) {
+                       next if !$flow{$n1};
+                       my $dist = $paths{$node}{$n1}[0];
+                       next if $opened->{$n1};
+
+                       my $m1 = $mins - $dist - 1;
+                       next if $m1 < 0;
+                       my %o1 = (%$opened, $n1 => 1);
+                       # say " opening $n1 at $m1 ", $flow{$n1}*($m1);
+                       push @q, [ $n1, $m1, $total + $flow{$n1}*($m1),
+                               \%o1, [ @$path, $n1 ] ];
+               }
+       }
+       return $max;
+}
+
+my @nodes = sort keys %flow;
+
+my $mx;
+my $walked;
+sub walk1($n1, $n2, $rest) {
+       if (!@$rest) {
+               my $sum = walk(@$n1) + walk(@$n2);
+               $walked++;
+               if (!defined $mx || $mx < $sum) {
+                       say join(' ', @$n1), ' | ', join(' ', @$n2), " ($walked) = $sum";
+                       $mx = $sum;
+               }
+               return;
+       }
+       my @nrest = @$rest;
+       my $node = shift @nrest;
+       walk1([ @$n1, $node ], $n2, \@nrest);
+       walk1($n1, [ @$n2, $node ], \@nrest);
+}
+
+my $first = shift @nodes;
+walk1([$first], [], \@nodes);
+say $mx;