Day 19: not bad, but too slow to write

[aoc.git] / 2023 / 38.pl

diff --git a/2023/38.pl b/2023/38.pl
new file mode 100755 (executable)
index 0000000..48ca335
--- /dev/null
+++ b/2023/38.pl
@@ -0,0 +1,87 @@
+#!/usr/bin/perl -w
+
+use v5.38;
+use List::Util qw(sum);
+# t;
+
+my %wfl;
+while (<>) {
+       chomp;
+       last if !length;
+       my ($name, $rest) = /(\w+)\{(\S+)\}/;
+       my @rules;
+       for my $r (split /,/, $rest) {
+               my ($id, $op, $val, $rule) = $r =~ /(\w+)(?:(\W)(\d+):(\w+))?/;
+               push @rules, [ $id, $op, $val, $rule ];
+       }
+       $wfl{$name} = \@rules;
+}
+
+my @q = [ 'in', { } ];
+my @acc;
+
+WFL:
+while (@q) {
+       my $s = shift @q;
+
+       my ($name, $sn, @path) = @$s;
+       my %seen = %$sn;
+
+       next if $seen{$name}++;
+       next if $name eq 'R';
+       if ($name eq 'A') {
+               push @acc, \@path;
+               next;
+       }
+
+       my $w = $wfl{$name};
+       for my $rule (@$w) {
+               my ($id, $op, $val, $nxt) = @$rule;
+
+               if (!defined $op) {
+                       my %s1 = %seen;
+                       my @p1 = @path;
+                       push @q, [ $id, \%s1, @p1 ];
+                       next WFL;
+               } else {
+                       if ($op eq '<') {
+                               my %s1 = %seen;
+                               my @p1 = (@path, [ $id, $op, $val ]);
+                               push @q, [ $nxt, \%s1, @p1 ];
+                               
+                               push @path, [ $id, '>', $val-1 ];
+                       } elsif ($op eq '>') {
+                               my %s1 = %seen;
+                               my @p1 = (@path, [ $id, $op, $val ]);
+                               push @q, [ $nxt, \%s1, @p1 ];
+                               push @path, [ $id, '<', $val+1 ];
+                       }
+               }
+       }
+}
+
+my $sum;
+for my $path (@acc) {
+       my $prod = 1;
+       for my $id (qw(a m s x)) {
+               my ($min, $max) = (1, 4000);
+               for my $cond (@$path) {
+                       my ($id1, $op, $val) = @$cond;
+                       next if $id1 ne $id;
+                       if ($op eq '<' && $max > $val-1) {
+                               $max = $val-1;
+                       }
+                       if ($op eq '>' && $min < $val+1) {
+                               $min = $val + 1;
+                       }
+               }
+               if ($min <= $max) {
+                       $prod *= $max-$min+1;
+               } else {
+                       $prod = 0;
+               }
+       }
+       $sum += $prod;
+}
+
+say $sum;