2023/24.pl

   1 #!/usr/bin/perl -w
   2
   3 use v5.38;
   4
   5 my %seen;
   6 sub walk($pat, @l) {
   7         my ($orig_p, @orig_l) = ($pat, @l);
   8         my $key = "$pat @l";
   9         return $seen{$key} if defined $seen{$key};
  10         # say "walk $pat | @l |";
  11         if (!@l) {
  12                 my $rv = $pat =~ /#/ ? 0 : 1;
  13                 # say "walk $pat | @l | returns $rv";
  14                 return $seen{$key} = $rv;
  15         }
  16         my $n = shift @l;
  17         my $sum = 0;
  18         while (1) {
  19                 my $p1 = $pat;
  20                 if ($p1 =~ s/^[\#\?]{$n}(?:\?|$)//) {
  21                         $sum += walk($p1, @l);
  22                 }
  23                 last if $pat !~ s/^\?//;
  24         }
  25         # say "walk $orig_p | @orig_l | returns $sum";
  26         return $seen{$key} = $sum;
  27 }
  28
  29 my %seen2;
  30 sub head {
  31         my ($subp1, $list1) = @_;
  32         my $key = "@$subp1|@$list1";
  33         return $seen2{$key} if defined $seen2{$key};
  34
  35         my @list = @$list1;
  36         my @subp = @$subp1;
  37
  38         # say "head @subp | @list";
  39
  40         my $sum = 0;
  41         my $first = shift @subp;
  42         my @l;
  43         my $lsum = 0;
  44         while ($lsum <= length $first) {
  45                 my $n = walk($first, @l);
  46                 if (!@subp && !@list) {
  47                         $sum += $n;
  48                         last;
  49                 } elsif ($n && @subp) {
  50                         my $restn = head(\@subp, \@list);
  51                         $sum += $n * $restn;
  52                 }
  53                 last if !@list;
  54                 push @l, shift @list;
  55                 $lsum++ if $lsum;
  56                 $lsum += $l[-1];
  57         }
  58         # say "head @$subp1 | @$list1 | returns $sum";
  59         return $seen2{$key} = $sum;
  60         return $sum;
  61 }
  62
  63 my $sum;
  64 while (<>) {
  65         chomp;
  66         my ($pattern, $list) = split / /;
  67         my @list = $list =~ /\d+/g;
  68
  69         $pattern = join('?', ($pattern) x 5);
  70         @list = (@list) x 5;
  71
  72         my $orig = $pattern;
  73         $pattern = ".$pattern.";
  74         $pattern =~ s/\.\.+/./g;
  75         $pattern =~ s/^\.//;
  76         # say "\n", $pattern;
  77         my @subp = split /\./, $pattern;
  78         # say join('|', @subp);
  79
  80         my $s = head(\@subp, \@list);
  81         say "$orig @list = $s";
  82         $sum += $s;
  83 }
  84 say $sum;