Day 12: first working solution

diff --git a/2023/23.pl b/2023/23.pl
new file mode 100755 (executable)
index 0000000..29c6228
--- /dev/null
+++ b/2023/23.pl
@@ -0,0 +1,35 @@
+#!/usr/bin/perl -w
+
+use v5.38;
+
+sub valid($pat, @l) {
+       my $re = '\A[^#]*' . join('[^#]+', map { "#{$_}" } @l) . '[^#]*\z';
+       # say "$pat =~ /$re/   @l";
+       return $pat =~ /$re/;
+}
+
+sub walk($pat, @l) {
+       my $p = $pat;
+       my $sum = 0;
+       if ($p =~ s/\?/./) {
+               $sum += walk($p, @l);
+               $p = $pat;
+               $p =~ s/\?/#/;
+               $sum += walk($p, @l);
+       } elsif (valid($pat, @l)) {
+               $sum = 1;
+       }
+       return $sum;
+}
+
+my $sum;
+while (<>) {
+       chomp;
+       my ($pattern, $list) = split / /;
+       my @list = $list =~ /\d+/g;
+
+       my $s = walk($pattern, @list);
+       say "$pattern @list = $s";
+       $sum += $s;
+}
+say $sum;

diff --git a/2023/24.pl b/2023/24.pl
new file mode 100755 (executable)
index 0000000..dd54161
--- /dev/null
+++ b/2023/24.pl
@@ -0,0 +1,84 @@
+#!/usr/bin/perl -w
+
+use v5.38;
+
+my %seen;
+sub walk($pat, @l) {
+       my ($orig_p, @orig_l) = ($pat, @l);
+       my $key = "$pat @l";
+       return $seen{$key} if defined $seen{$key};
+       # say "walk $pat | @l |";
+       if (!@l) {
+               my $rv = $pat =~ /#/ ? 0 : 1;
+               # say "walk $pat | @l | returns $rv";
+               return $seen{$key} = $rv;
+       }
+       my $n = shift @l;
+       my $sum = 0;
+       while (1) {
+               my $p1 = $pat;
+               if ($p1 =~ s/^[\#\?]{$n}(?:\?|$)//) {
+                       $sum += walk($p1, @l);
+               }
+               last if $pat !~ s/^\?//;
+       }
+       # say "walk $orig_p | @orig_l | returns $sum";
+       return $seen{$key} = $sum;
+}
+
+my %seen2;
+sub head {
+       my ($subp1, $list1) = @_;
+       my $key = "@$subp1|@$list1";
+       return $seen2{$key} if defined $seen2{$key};
+       
+       my @list = @$list1;
+       my @subp = @$subp1;
+
+       # say "head @subp | @list";
+
+       my $sum = 0;
+       my $first = shift @subp;
+       my @l;
+       my $lsum = 0;
+       while ($lsum <= length $first) {
+               my $n = walk($first, @l);
+               if (!@subp && !@list) {
+                       $sum += $n;
+                       last;
+               } elsif ($n && @subp) {
+                       my $restn = head(\@subp, \@list);
+                       $sum += $n * $restn;
+               }
+               last if !@list;
+               push @l, shift @list;
+               $lsum++ if $lsum;
+               $lsum += $l[-1];
+       }
+       # say "head @$subp1 | @$list1 | returns $sum";
+       return $seen2{$key} = $sum;
+       return $sum;
+}
+
+my $sum;
+while (<>) {
+       chomp;
+       my ($pattern, $list) = split / /;
+       my @list = $list =~ /\d+/g;
+
+       $pattern = join('?', ($pattern) x 5);
+       @list = (@list) x 5;
+
+       my $orig = $pattern;
+       $pattern = ".$pattern.";
+       $pattern =~ s/\.\.+/./g;
+       $pattern =~ s/^\.//;
+       # say "\n", $pattern;
+       my @subp = split /\./, $pattern;
+       # say join('|', @subp);
+
+       my $s = head(\@subp, \@list);
+       say "$orig @list = $s";
+       $sum += $s;
+}
+say $sum;