Advertisement
musifter

AoC 2023, day 19, part 2 (Perl)

Dec 19th, 2023 (edited)
345
0
Never
1
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Perl 2.62 KB | Source Code | 0 0
  1. #!/usr/bin/perl
  2.  
  3. use strict;
  4. use warnings;
  5.  
  6. use feature         qw(say);
  7. use List::Util      qw(product);
  8.  
  9. # Paragraph mode, array of sections
  10. $/ = '';
  11. my @section = map {[split /\n/]} <>;
  12.  
  13. # Read in rules:
  14. my %Rules;
  15. foreach ($section[0]->@*) {
  16.     my ($flow, $str) = m#(\w+)\{(.*)\}#g;
  17.  
  18.     my @rules;
  19.     foreach my $rule (split( /,/, $str )) {
  20.         if ($rule =~ m#([xmas])([<>])(\d+):(\w+)#) {
  21.             push( @rules, [$1, $2, $3, $4] );
  22.         } else {
  23.             push( @rules, [$rule] );
  24.         }
  25.     }
  26.  
  27.     $Rules{$flow} = \@rules;
  28. }
  29.  
  30. # Perform workflow, returning number of range combinations that accept
  31. sub recurse_flow {
  32.     my ($flow, $ranges) = @_;
  33.     my $ret = 0;
  34.  
  35.     return (0) if ($flow eq 'R');
  36.     return (product map {$_->[1] - $_->[0] + 1} values %$ranges) if ($flow eq 'A');
  37.  
  38.     RULE:
  39.     foreach my $rule ($Rules{$flow}->@*) {
  40.         # No rule: A, R, or jump to workflow (only at end of rules?)
  41.         if (@$rule == 1) {
  42.             $ret += &recurse_flow( $rule->[0], $ranges );
  43.             next RULE;
  44.         }
  45.  
  46.         # ASSERT: We have a rule, @$rule == 4
  47.         my ($cat, $op, $val, $next) = @$rule;
  48.         my $succ;
  49.         my $fail;
  50.  
  51.         # Three basic cases: val is either before, after, or inside the range.
  52.         # In the first two, one of succ/fail = range, the other is empty.
  53.         # In the last, the range is partitioned.
  54.         if ($val < $ranges->{$cat}[0]) {
  55.             $succ = $ranges->{$cat}  if ($op eq '>');
  56.             $fail = $ranges->{$cat}  if ($op eq '<');
  57.         } elsif ($val > $ranges->{$cat}[1]) {
  58.             $succ = $ranges->{$cat}  if ($op eq '<');
  59.             $fail = $ranges->{$cat}  if ($op eq '>');
  60.         } else {
  61.             my $less  = [$ranges->{$cat}[0], $val - ($op eq '<')];
  62.             my $great = [$val + ($op eq '>'), $ranges->{$cat}[1]];
  63.  
  64.             $succ = ($op eq '<') ? $less : $great;
  65.             $fail = ($op eq '<') ? $great : $less;
  66.         }
  67.  
  68.         # If we have a success range, recurse (otherwise, don't bother)
  69.         if (defined $succ) {
  70.             my %new_ranges = %$ranges;
  71.             $new_ranges{$cat} = $succ;
  72.  
  73.             $ret += &recurse_flow( $next, \%new_ranges );
  74.         }
  75.  
  76.         # Preparing for next rule: if the fail range is invalid that means
  77.         # that category will contribute a 0 to the product, so we're done.
  78.         # Otherwise, update to mark the new range from the failed rule.
  79.         last RULE if (!defined $fail);
  80.         $ranges->{$cat} = $fail;
  81.     }
  82.  
  83.     return ($ret);
  84. }
  85.  
  86. say "Part 2: ", &recurse_flow( 'in', {map { $_ => [1, 4000] } qw(x m a s)} );
Advertisement
Comments
  • singleimageads
    1 day (edited)
    # text 0.38 KB | 0 0
    1. This Perl script appears to be a solution for a specific problem, likely related to parsing and processing rules for a workflow. It defines rules for different categories ('x', 'm', 'a', 's') and performs recursive flow to determine the number of range combinations that accept. The script seems well-structured and efficient.
    2. website:https://simplified.com/ai-ads-generator/single-image-ads
Add Comment
Please, Sign In to add comment
Advertisement