Day 21: interesting task, quite complicated implementation

diff --git a/2024/41.pl b/2024/41.pl
new file mode 100755 (executable)
index 0000000..0f0d5b2
--- /dev/null
+++ b/2024/41.pl
@@ -0,0 +1,99 @@
+#!/usr/bin/perl -w
+
+use v5.40;
+use List::Util qw(min uniq);
+
+my %npad = (
+       0 => [ 1, 3 ],
+       A => [ 2, 3 ],
+       1 => [ 0, 2 ],
+       2 => [ 1, 2 ],
+       3 => [ 2, 2 ],
+       4 => [ 0, 1 ],
+       5 => [ 1, 1 ],
+       6 => [ 2, 1 ],
+       7 => [ 0, 0 ],
+       8 => [ 1, 0 ],
+       9 => [ 2, 0 ],
+       'gap' => 'down',
+);
+my %dpad = (
+       '^' => [ 1, 0 ],
+       'A' => [ 2, 0 ],
+       '<' => [ 0, 1 ],
+       'v' => [ 1, 1 ],
+       '>' => [ 2, 1 ],
+       'gap' => 'up',
+);
+
+sub min_len { min map { length } @_ };
+sub min_str { my $l = min_len(@_); uniq grep { length == $l } @_ };
+
+sub moves {
+       my ($from, $to, $pad) = @_;
+       my $rv;
+       my $pos = $pad->{$from};
+       my $dpos = $pad->{$to};
+
+       my @moves;
+       my ($dx, $dy) = ($dpos->[0]-$pos->[0], $dpos->[1]-$pos->[1]);
+       my $xs = $dx > 0 ? '>' x $dx : '<' x -$dx;
+       my $ys = $dy > 0 ? 'v' x $dy : '^' x -$dy;
+       push @moves, $xs.$ys.'A'
+               if ($pad->{gap} eq 'down' && ($dpos->[0] > 0 || $pos->[1] < 3))
+               || ($pad->{gap} eq 'up'   && ($dpos->[0] > 0 || $pos->[1] > 0));
+       push @moves, $ys.$xs.'A'
+               if ($pad->{gap} eq 'down' && ($dpos->[1] < 3 || $pos->[0] > 0))
+               || ($pad->{gap} eq 'up'   && ($dpos->[1] > 0 || $pos->[0] > 0));
+       return uniq @moves;
+}
+
+my %shortest;
+sub shortest {
+       my ($pad) = @_;
+       for my $k1 (keys %$pad) {
+               next if length $k1 > 1;
+               $shortest{"$k1$k1"} = [ 'A' ];
+               for my $k2 (keys %$pad) {
+                       next if length $k2 > 1;
+                       $shortest{"$k1$k2"} = [
+                               min_str(moves($k1, $k2, $pad))
+                       ] if $k1 ne $k2;
+               }
+       }
+}
+shortest(\%npad);
+shortest(\%dpad);
+
+sub prev_keypad {
+       my ($str) = @_;
+       my $src = 'A';
+       my @rv = '';
+       for my $dst (split //, $str) {
+               my @nrv;
+               for my $s ($shortest{"$src$dst"}->@*) {
+                       push @nrv, map { "$_$s" } @rv;
+               }
+               @rv = @nrv;
+               $src = $dst;
+       }
+       return min_str(@rv);
+}
+
+my $sum;
+while (<>) {
+       chomp;
+       my @strs = ($_);
+       for (1 .. 3) {
+               my @ns;
+               for my $str (@strs) {
+                       push @ns, prev_keypad($str);
+               }
+               @strs = min_str(@ns);
+       }
+       my $l = length($strs[0]);
+       my ($n) = /\d+/g;
+       $sum += $l*$n;
+}
+say $sum;
+

diff --git a/2024/42.pl b/2024/42.pl
new file mode 100755 (executable)
index 0000000..b6f3aaf
--- /dev/null
+++ b/2024/42.pl
@@ -0,0 +1,105 @@
+#!/usr/bin/perl -w
+
+use v5.40;
+use List::Util qw(min uniq);
+
+my %npad = (
+       0 => [ 1, 3 ],
+       A => [ 2, 3 ],
+       1 => [ 0, 2 ],
+       2 => [ 1, 2 ],
+       3 => [ 2, 2 ],
+       4 => [ 0, 1 ],
+       5 => [ 1, 1 ],
+       6 => [ 2, 1 ],
+       7 => [ 0, 0 ],
+       8 => [ 1, 0 ],
+       9 => [ 2, 0 ],
+       'gap' => 'down',
+);
+my %dpad = (
+       '^' => [ 1, 0 ],
+       'A' => [ 2, 0 ],
+       '<' => [ 0, 1 ],
+       'v' => [ 1, 1 ],
+       '>' => [ 2, 1 ],
+       'gap' => 'up',
+);
+
+sub min_len { min map { length } @_ };
+sub min_str { my $l = min_len(@_); uniq grep { length == $l } @_ };
+
+sub moves {
+       my ($from, $to, $pad) = @_;
+       my $rv;
+       my $pos = $pad->{$from};
+       my $dpos = $pad->{$to};
+
+       my @moves;
+       my ($dx, $dy) = ($dpos->[0]-$pos->[0], $dpos->[1]-$pos->[1]);
+       my $xs = $dx > 0 ? '>' x $dx : '<' x -$dx;
+       my $ys = $dy > 0 ? 'v' x $dy : '^' x -$dy;
+       push @moves, $xs.$ys.'A'
+               if ($pad->{gap} eq 'down' && ($dpos->[0] > 0 || $pos->[1] < 3))
+               || ($pad->{gap} eq 'up'   && ($dpos->[0] > 0 || $pos->[1] > 0));
+       push @moves, $ys.$xs.'A'
+               if ($pad->{gap} eq 'down' && ($dpos->[1] < 3 || $pos->[0] > 0))
+               || ($pad->{gap} eq 'up'   && ($dpos->[1] > 0 || $pos->[0] > 0));
+       return uniq @moves;
+}
+
+my %shortest;
+sub shortest {
+       my ($pad) = @_;
+       for my $k1 (keys %$pad) {
+               next if length $k1 > 1;
+               $shortest{"$k1$k1"} = [ 'A' ];
+               for my $k2 (keys %$pad) {
+                       next if length $k2 > 1;
+                       $shortest{"$k1$k2"} = [
+                               min_str(moves($k1, $k2, $pad))
+                       ] if $k1 ne $k2;
+               }
+       }
+}
+shortest(\%npad);
+shortest(\%dpad);
+
+sub prev_keypad {
+       my ($str) = @_;
+       my $src = 'A';
+       my @rv = '';
+       for my $dst (split //, $str) {
+               my @nrv;
+               for my $s ($shortest{"$src$dst"}->@*) {
+                       push @nrv, map { "$_$s" } @rv;
+               }
+               @rv = @nrv;
+               $src = $dst;
+       }
+       return min_str(@rv);
+}
+
+my %cache;
+sub count_str {
+       my ($str, $n) = @_;
+       return length($str) if !$n;
+       return 1 if $str eq 'A';
+       my $sum;
+       $n--;
+       for my $str (split /A/, $str) {
+               $sum += $cache{"$str,$n"} //= min
+                       map { count_str($_, $n) } prev_keypad($str.'A');
+       }
+       return $sum;
+}
+
+my $sum;
+while (<>) {
+       chomp;
+       my $l = count_str($_, 26);
+       my ($n) = /[1-9]\d+/g;
+       $sum += $l*$n;
+}
+say $sum;
+