From: Jan "Yenya" Kasprzak <kas@fi.muni.cz>
Date: Tue, 12 Dec 2023 08:38:02 +0000 (+0100)
Subject: Day 12: first working solution
X-Git-Url: https://www.fi.muni.cz/~kas/git//home/kas/public_html/git/?p=aoc.git;a=commitdiff_plain;h=73b57709afa3fb057fdba1fb706d0d49506be7cb

Day 12: first working solution
---

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