Advertisement
musifter

AoC 2021 day 16 (Perl)

Dec 16th, 2021
1,658
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Perl 2.85 KB | None | 0 0
  1. #!/usr/bin/perl
  2.  
  3. use strict;
  4. use warnings;
  5.  
  6. # To remove warnings that 32+bit binary numbers converted by oct aren't portable
  7. no warnings 'portable';
  8.  
  9. use List::Util  qw(sum product min max);
  10.  
  11. $| = 1;
  12.  
  13. my $part1 = 0;
  14.  
  15. my %operations = (
  16.                      0 => sub { sum @_ },
  17.                      1 => sub { product @_ },
  18.                      2 => sub { min @_ },
  19.                      3 => sub { max @_ },
  20.                      5 => sub { int($_[0] > $_[1]) },
  21.                      6 => sub { int($_[0] < $_[1]) },
  22.                      7 => sub { int($_[0] == $_[1]) }
  23.                  );
  24.  
  25. # Read input as string of binary digits (yes, we're going BASIC-style!)
  26. chomp( $_ = <> );
  27.  
  28. my $input;
  29. foreach my $nyb (split //) {
  30.     $input .= sprintf( "%04b", hex($nyb) );
  31. }
  32.  
  33. # Read an integer of len bits from front of input
  34. sub read_int_field (\$$) {
  35.     my ($input, $len) = @_;
  36.  
  37.     return (oct("0b" . substr( $$input, 0, $len, '' )));
  38. }
  39.  
  40. # Read an extended literal integer from front of input
  41. sub read_literal (\$) {
  42.     my $input = shift;
  43.  
  44.     my $extend;
  45.     my $val = '';
  46.  
  47.     do {
  48.         $extend = substr( $$input, 0, 1, '' );
  49.         $val .= substr( $$input, 0, 4, '' );
  50.     } until (!$extend);
  51.  
  52.     return (oct( "0b$val" ));
  53. }
  54.  
  55. # Read the next pack from the front of input
  56. sub process_next_packet (\$) {
  57.     my $input = shift;
  58.     my $ret;
  59.  
  60.     # read in 6-bit header info
  61.     my $version = &read_int_field( $input, 3 );
  62.     my $type    = &read_int_field( $input, 3 );
  63.  
  64.     $part1 += $version;
  65.  
  66.     if ($type == 4) {
  67.         # literal value
  68.         $ret = &read_literal( $input );
  69.     } else {
  70.         # operation on sub-packets
  71.         my $len_type = substr( $$input, 0, 1, '' );
  72.  
  73.         # to collect values from sub-packets
  74.         my @vals;
  75.  
  76.         if ($len_type == 0) {
  77.             # process sub-packets from next len bits
  78.             my $len = &read_int_field( $input, 15 );
  79.             my $sub = substr( $$input, 0, $len, '' );
  80.  
  81.             push( @vals, &process_packets( \$sub ) );
  82.         } else {
  83.             # process num packets
  84.             my $num = &read_int_field( $input, 11 );
  85.  
  86.             foreach (1 .. $num) {
  87.                 push( @vals, &process_next_packet( $input ) );
  88.             }
  89.         }
  90.  
  91.         # execute operation of type on values collected
  92.         $ret = &{$operations{$type}}( @vals );
  93.     }
  94.  
  95.     return ($ret);
  96. }
  97.  
  98. # Loop to read multiple packets from a string (at the top layer this should be just 1)
  99. sub process_packets (\$) {
  100.     my $input = shift;
  101.     my @val = ();
  102.  
  103.     while ($$input && $$input != 0) {
  104.         push( @val, &process_next_packet( $input ) );
  105.     }
  106.  
  107.     return (@val);
  108. }
  109.  
  110. # Part 2 should be just one value, but we'll display all we collect to detect bugs!
  111. print "Part 2: ", join(', ', &process_packets( \$input )), "\n";
  112. print "Part 1: $part1\n";
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement