2023/38.pl

   1 #!/usr/bin/perl -w
   2
   3 use v5.38;
   4 use List::Util qw(sum);
   5 # t;
   6
   7 my %wfl;
   8 while (<>) {
   9         chomp;
  10         last if !length;
  11         my ($name, $rest) = /(\w+)\{(\S+)\}/;
  12         my @rules;
  13         for my $r (split /,/, $rest) {
  14                 my ($id, $op, $val, $rule) = $r =~ /(\w+)(?:(\W)(\d+):(\w+))?/;
  15                 push @rules, [ $id, $op, $val, $rule ];
  16         }
  17         $wfl{$name} = \@rules;
  18 }
  19
  20 my @q = [ 'in', { } ];
  21 my @acc;
  22
  23 WFL:
  24 while (@q) {
  25         my $s = shift @q;
  26
  27         my ($name, $sn, @path) = @$s;
  28         my %seen = %$sn;
  29
  30         next if $seen{$name}++;
  31         next if $name eq 'R';
  32         if ($name eq 'A') {
  33                 push @acc, \@path;
  34                 next;
  35         }
  36
  37         my $w = $wfl{$name};
  38         for my $rule (@$w) {
  39                 my ($id, $op, $val, $nxt) = @$rule;
  40
  41                 if (!defined $op) {
  42                         my %s1 = %seen;
  43                         my @p1 = @path;
  44                         push @q, [ $id, \%s1, @p1 ];
  45                         next WFL;
  46                 } else {
  47                         if ($op eq '<') {
  48                                 my %s1 = %seen;
  49                                 my @p1 = (@path, [ $id, $op, $val ]);
  50                                 push @q, [ $nxt, \%s1, @p1 ];
  51
  52                                 push @path, [ $id, '>', $val-1 ];
  53                         } elsif ($op eq '>') {
  54                                 my %s1 = %seen;
  55                                 my @p1 = (@path, [ $id, $op, $val ]);
  56                                 push @q, [ $nxt, \%s1, @p1 ];
  57                                 push @path, [ $id, '<', $val+1 ];
  58                         }
  59                 }
  60         }
  61 }
  62
  63 my $sum;
  64 for my $path (@acc) {
  65         my $prod = 1;
  66         for my $id (qw(a m s x)) {
  67                 my ($min, $max) = (1, 4000);
  68                 for my $cond (@$path) {
  69                         my ($id1, $op, $val) = @$cond;
  70                         next if $id1 ne $id;
  71                         if ($op eq '<' && $max > $val-1) {
  72                                 $max = $val-1;
  73                         }
  74                         if ($op eq '>' && $min < $val+1) {
  75                                 $min = $val + 1;
  76                         }
  77                 }
  78                 if ($min <= $max) {
  79                         $prod *= $max-$min+1;
  80                 } else {
  81                         $prod = 0;
  82                 }
  83         }
  84         $sum += $prod;
  85 }
  86
  87 say $sum;