Day 21: interesting task, quite complicated implementation

#!/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;

#!/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;