From: Jan "Yenya" Kasprzak Date: Tue, 19 Dec 2023 06:14:07 +0000 (+0100) Subject: Day 19: not bad, but too slow to write X-Git-Url: https://www.fi.muni.cz/~kas/git//home/kas/public_html/git/?a=commitdiff_plain;h=adcd96d077364f379ec77e0c05dc1faaeaa5ffed;p=aoc.git Day 19: not bad, but too slow to write --- diff --git a/2023/37.pl b/2023/37.pl new file mode 100755 index 0000000..af75ae7 --- /dev/null +++ b/2023/37.pl @@ -0,0 +1,63 @@ +#!/usr/bin/perl -w + +use v5.38; +use experimental 'for_list'; +use List::Util qw(sum); + +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 @parts; +while (<>) { + my %p; + for my ($id, $val) (/(\w)=(\d+)/g) { + $p{$id} = $val; + } + push @parts, \%p; +} + +sub evaluate { + my ($part, $name) = @_; + my %seen; +NEWWFL: + return 0 if $seen{$name}++; + if ($name eq 'R') { + return 0; + } elsif ($name eq 'A') { + return sum values %$part; + } + my $w = $wfl{$name}; + for my $rule (@$w) { + my ($id, $op, $val, $nxt) = @$rule; + + if (!defined $op) { + $name = $id; + goto NEWWFL; + } else { + if ($op eq '<') { + if ($part->{$id} < $val) { + $name = $nxt; + goto NEWWFL; + } + } + if ($op eq '>') { + if ($part->{$id} > $val) { + $name = $nxt; + goto NEWWFL; + } + } + } + } +} + +say sum map { evaluate($_, 'in') } @parts; diff --git a/2023/38.pl b/2023/38.pl new file mode 100755 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;