Commit f1115783 authored by Jan Kasprzak's avatar Jan Kasprzak
Browse files

Day 21: shortened version

parent 3463b129

2024/41.pl

+14 −38
Original line number Diff line number Diff line
@@ -3,35 +3,16 @@ 
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 make_pad {

	my $i = 0;

	return map { $_ => [ $i % 3, int($i++ / 3) ]  } split //, shift;

}



sub min_len { min map { length } @_ };

sub min_str { my $l = min_len(@_); uniq grep { length == $l } @_ };

my %npad = make_pad('789456123_0A');

my %dpad = make_pad('_^A<v>');



sub moves {

	my ($from, $to, $pad) = @_;

	my $rv;

	my $pos = $pad->{$from};

	my $dpos = $pad->{$to};
@@ -39,26 +20,20 @@ sub 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;

	my $spc = $pad->{_};

	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));

		if $dpos->[0] != $spc->[0] || $pos->[1] != $spc->[1];

	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;

		if $dpos->[1] != $spc->[1] || $pos->[0] != $spc->[0];

	return @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{"$k1$k2"} = [ moves($k1, $k2, $pad) ];

		}

	}

}
@@ -77,7 +52,7 @@ sub prev_keypad { 
		@rv = @nrv;

		$src = $dst;

	}

	return min_str(@rv);

	return @rv;

}



my $sum;
@@ -89,7 +64,8 @@ while (<>) { 
		for my $str (@strs) {

			push @ns, prev_keypad($str);

		}

		@strs = min_str(@ns);

		my $l = min map { length } @ns;

		@strs = uniq grep { length == $l } @ns;

	}

	my $l = length($strs[0]);

	my ($n) = /\d+/g;

2024/42.pl

+13 −38
Original line number Diff line number Diff line 
#!/usr/bin/perl -w



use v5.40;

use List::Util qw(min uniq);

use List::Util qw(min);



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 make_pad {

	my $i = 0;

	return map { $_ => [ $i % 3, int($i++ / 3) ]  } split //, shift;

}



sub min_len { min map { length } @_ };

sub min_str { my $l = min_len(@_); uniq grep { length == $l } @_ };

my %npad = make_pad('789456123_0A');

my %dpad = make_pad('_^A<v>');



sub moves {

	my ($from, $to, $pad) = @_;

	my $rv;

	my $pos = $pad->{$from};

	my $dpos = $pad->{$to};
@@ -39,26 +20,20 @@ sub 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;

	my $spc = $pad->{_};

	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));

		if $dpos->[0] != $spc->[0] || $pos->[1] != $spc->[1];

	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;

		if $dpos->[1] != $spc->[1] || $pos->[0] != $spc->[0];

	return @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{"$k1$k2"} = [ moves($k1, $k2, $pad) ];

		}

	}

}
@@ -77,7 +52,7 @@ sub prev_keypad { 
		@rv = @nrv;

		$src = $dst;

	}

	return min_str(@rv);

	return @rv;

}



my %cache;