X-Git-Url: https://www.fi.muni.cz/~kas/git//home/kas/public_html/git/?a=blobdiff_plain;f=2023%2F24.pl;fp=2023%2F24.pl;h=dd54161b954897a10040f8c853c0adfd7bd2a865;hb=73b57709afa3fb057fdba1fb706d0d49506be7cb;hp=0000000000000000000000000000000000000000;hpb=9e2ac1101f0c865e0c6e07e02213313ff75e625b;p=aoc.git

diff --git a/2023/24.pl b/2023/24.pl
new file mode 100755
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;