This are my solutions for this year's contest.
If you want to copy these files, use the GitHub link.
All files covered by the UNLICENSE.
[ AoC problem link ] [ Discussion ].
#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;
my $testing = 0;
my $file = $testing ? 'test.txt' : 'input.txt' ;
my @input;
{
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }
}
my %new_dir = ( N => { L => ['W',-1, 0],
R => ['E', 1, 0] },
E => { L => ['N', 0, 1],
R => ['S', 0,-1] },
S => { L => ['E', 1, 0],
R => ['W',-1, 0] },
W => { L => ['S', 0,-1],
R => ['N', 0, 1] } );
my $pos = [ 'N', 0, 0 ];
my @dirs= split(/,\ /, $input[0]);
foreach my $turn ( @dirs ) {
my ( $v, $l ) = $turn =~ m/(.)(\d+)/;
say "$turn $v $l" if $testing;
my $dest = $new_dir{$pos->[0]}->{$v};
$pos->[0] = $dest->[0];
$pos->[1] = $pos->[1] + $dest->[1] * $l;
$pos->[2] = $pos->[2] + $dest->[2] * $l;
}
say join(' ', ('End position:',@{$pos}));
say "Distance: ", abs($pos->[1])+abs($pos->[2]);
30 lines [ Plain text ] [ ^Top ]
#!/usr/bin/perl
use 5.016; # implies strict, provides 'say'
use warnings;
use autodie;
my $testing = 0;
my @input;
my $file = $testing ? 'test.txt' : 'input.txt' ;
{
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }
}
my %new_dir = ( N => { L => ['W',-1, 0],
R => ['E', 1, 0] },
E => { L => ['N', 0, 1],
R => ['S', 0,-1] },
S => { L => ['E', 1, 0],
R => ['W',-1, 0] },
W => { L => ['S', 0,-1],
R => ['N', 0, 1] } );
my $pos = [ 'N', 0, 0 ];
my $seen;
my $location = [$pos->[1], $pos->[2]];
my @dirs= split(/,\ /, $input[0]);
foreach my $turn ( @dirs ) {
my ( $v, $l ) = $turn =~ m/(.)(\d+)/;
my $direction = $new_dir{$pos->[0]}->{$v};
my ( $x, $y ) = @{$pos}[1,2];
if ( $direction->[0] eq 'N' ) { # move positive Y
for ( my $i = $y; $i < $y+$l; $i++ ) {
$seen->{$x}->{$i}++ }
} elsif ( $direction->[0] eq 'E' ) { # move positive X
for ( my $i = $x; $i < $x+$l; $i++ ) {
$seen->{$i}->{$y}++ }
} elsif ( $direction->[0] eq 'S' ) { # move negative Y
for ( my $i = $y; $i > $y - $l; $i-- ) {
$seen->{$x}->{$i}++ }
} elsif ( $direction->[0] eq 'W' ) { # move negative X
for ( my $i = $x; $i > $x - $l; $i-- ) {
$seen->{$i}->{$y}++ }
} else {
die "what direction is this?! $direction->[0]";
}
# # check for intersections
foreach my $x (keys %{$seen}) {
foreach my $y (keys %{$seen->{$x}}) {
if ( $seen->{$x}->{$y} == 2 ) {
say "intersection at $x,$y, distance: ",abs($x)+abs($y);
exit 0;
}
}
}
# set new starting position
$pos->[0] = $direction->[0];
$pos->[1] = $x + $direction->[1] * $l;
$pos->[2] = $y + $direction->[2] * $l;
}
55 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#!/usr/bin/perl
use 5.016; # implies strict, provides 'say'
use warnings;
use autodie;
#### INIT
my $testing = 0;
my @input;
my $file = $testing ? 'test.txt' : 'input.txt';
{
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }
}
### CODE
my $keypad = [ [ 1, 2, 3 ], [ 4, 5, 6 ], [ 7, 8, 9 ] ];
my $next_move = { U => [ 0, 1 ],
D => [ 0, -1 ],
L => [ -1, 0 ],
R => [ 1, 0 ] };
# start with a Cartesian grid with the origin at 5:
# 1 2 3
# 4 5 6
# 7 8 9
my $key = [ 0, 0 ];
my $solution;
foreach my $line (@input) {
my @instructions = split( //, $line );
foreach my $move (@instructions) {
my $next = [ $key->[0] + $next_move->{$move}->[0],
$key->[1] + $next_move->{$move}->[1] ];
if ( abs( $next->[0] ) > 1 or abs( $next->[1] ) > 1 ) {
next;
} else {
$key = $next;
}
}
# To get the keys from the arrayref,
# rotate 90 degrees counter-clockwise: ( x , y ) -> ( -y, x )
# and translate [+1,+1]
$solution .= $keypad->[ -$key->[1] + 1 ]->[ $key->[0] + 1 ];
}
say $solution;
34 lines [ Plain text ] [ ^Top ]
#!/usr/bin/perl
use 5.016; # implies strict, provides 'say'
use warnings;
use autodie;
#### INIT - load input data into array
my $testing = 0;
my @input;
my $file = $testing ? 'test.txt' : 'input.txt';
{
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }
}
### CODE
# Layout - circle in taxicab geometry!
#
# 1
# 2 3 4
# 5 6 7 8 9
# A B C
# D
# Cartesian coordinates, center the origin at 7, x,y for the keys as below
my $keypad = { -2 => { 0 => 5 },
-1 => { -1 => 'A', 0 => 6, 1 => 2 },
0 => { -2 => 'D', -1 => 'B', 0 => 7, 1 => 3, 2 => 1 },
1 => { -1 => 'C', 0 => 8, 1 => 4 },
2 => { 0 => 9 } };
my $next_move = { U => [ 0, 1 ],
D => [ 0, -1 ],
L => [ -1, 0 ],
R => [ 1, 0 ] };
my $key = [ -2, 0 ];
my $solution;
foreach my $line (@input) {
my @instructions = split( //, $line );
foreach my $move (@instructions) {
my $next = [ $key->[0] + $next_move->{$move}->[0],
$key->[1] + $next_move->{$move}->[1] ];
if ( abs( $next->[0] ) + abs( $next->[1] ) > 2 ) {
next;
} else {
$key = $next;
}
}
$solution .= $keypad->{ $key->[0] }->{ $key->[1] };
}
say $solution;
35 lines [ Plain text ] [ ^Top ]
#!/usr/bin/perl
use 5.016; # implies strict, provides 'say'
use warnings;
use autodie;
#### INIT - load input data into array
my $testing = 0;
my @input;
my $file = $testing ? 'test.txt' : 'input.txt';
{
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }
}
### CODE
# Inspired by
# https://www.reddit.com/r/adventofcode/comments/5g1hfm/2016_day_2_solutions/dap5cuj/
my $movemap = { 1 => { D => 3 },
2 => { R => 3, D => 6 },
3 => { U => 1, D => 7, L => 2, R => 4 },
4 => { D => 8, L => 3 },
5 => { R => 6 },
6 => { U => 2, D => 'A', L => 5, R => 7 },
7 => { U => 3, D => 'B', L => 6, R => 8 },
8 => { U => 4, D => 'C', L => 7, R => 9 },
9 => { L => 8 },
A => { U => 6, R => 'B' },
B => { U => 7, D => 'D', L => 'A', R => 'C' },
C => { U => 8, L => 'B' },
D => { U => 'B' } };
my $pos = 5;
my $solution;
foreach my $line (@input) {
foreach my $move ( split( //, $line ) ) {
if ( exists $movemap->{$pos}->{$move} ) {
$pos = $movemap->{$pos}->{$move};
}
}
$solution .= $pos;
}
say $solution;
34 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#!/usr/bin/perl
use 5.016; # implies strict, provides 'say'
use warnings;
use autodie;
#### INIT - load input data into array
my $testing = 0;
my @input;
my $file = $testing ? 'test.txt' : 'input.txt';
{
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }
}
### CODE
my $count = 0;
foreach my $line (@input) {
my @triple = sort { $a <=> $b } ( $line =~ m/(\d+)\s+(\d+)\s+(\d+)/ );
$count++ if ( $triple[2] < $triple[0] + $triple[1] );
}
say "Number of triangles is $count";
16 lines [ Plain text ] [ ^Top ]
#!/usr/bin/perl
use 5.016; # implies strict, provides 'say'
use warnings;
use autodie;
#### INIT - load input data into array
my $testing = 0;
my @input;
my $file = $testing ? 'test.txt' : 'input.txt';
{
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }
}
### CODE
my $data;
foreach my $line (@input) {
my @row = $line =~ m/(\d+)\s+(\d+)\s+(\d+)/;
# put each column into its own arrayref
map { push @{ $data->[$_] }, $row[$_] } qw(0 1 2);
}
my $count = 0;
foreach my $col ( @{$data} ) {
while ( @{$col} ) {
my @triple = sort { $a <=> $b } ( splice @{$col}, 0, 3 );
$count++ if ( $triple[2] < $triple[0] + $triple[1] );
}
}
say "Number of triangles is $count";
24 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#!/usr/bin/perl
use 5.016; # implies strict, provides 'say'
use warnings;
use autodie;
#### INIT - load input data into array
my $testing = 0;
my @input;
my $file = $testing ? 'test.txt' : 'input.txt';
{
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }
}
### CODE
my $sum = 0;
foreach my $line (@input) {
my ( $code, $sector, $key ) = $line =~ m/(\D+)(\d+)\[(.*)\]/;
my %freq;
foreach my $c ( split( //, $code ) ) {
next if $c eq '-';
$freq{$c}++;
}
my @result;
foreach ( sort { ( $freq{$b} <=> $freq{$a} ) || ( $a cmp $b ) }
keys %freq )
{
push @result, $_;
}
if ( join( '', @result[ 0 .. 4 ] ) eq $key ) {
$sum += $sector;
}
}
say $sum;
29 lines [ Plain text ] [ ^Top ]
#!/usr/bin/perl
use 5.016; # implies strict, provides 'say'
use warnings;
use autodie;
#### INIT - load input data into array
my $testing = 0;
my @input;
my $file = $testing ? 'test.txt' : 'input.txt';
{
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }
}
### CODE
my $sum = 0;
foreach my $line (@input) {
my ( $code, $sector, $chk ) = $line =~ m/(\D+)(\d+)\[(.*)\]/;
my %freq;
foreach my $c ( split( //, $code ) ) {
next if $c eq '-';
$freq{$c}++;
}
my @result;
foreach ( sort { ( $freq{$b} <=> $freq{$a} ) || ( $a cmp $b ) }
keys %freq )
{
push @result, $_;
}
if ( join( '', @result[ 0 .. 4 ] ) eq $chk ) { # valid code, not decoy
my $key = $sector % 26;
my @decode;
foreach my $c ( split( //, $code ) ) {
if ( $c eq '-' ) { push @decode, ' '; next; }
my $ord = ord($c) + $key;
if ( $ord > ord('z') ) { $ord -= 26 }
push @decode, chr($ord);
}
# use `grep` on the output to find the desired string
say join( '', @decode ), $sector;
}
}
37 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#!/usr/bin/perl
use 5.016; # implies strict, provides 'say'
use warnings;
use autodie;
# this module is available from CPAN
use Digest::MD5 qw(md5_hex);
#### INIT
my $testing = 0;
my $input = $testing ? 'abc' : 'abbhdwsy';
### CODE
my $password = '';
my $i = 0;
while ( length($password) < 8 ) {
my $hash = md5_hex( $input . $i );
if ( $hash =~ m/^00000/ ) {
say "$i $hash" if $testing;
$password .= ( split( //, $hash ) )[5];
}
$i++;
}
say $password;
17 lines [ Plain text ] [ ^Top ]
#!/usr/bin/perl
use 5.016; # implies strict, provides 'say'
use warnings;
use autodie;
use List::Util qw/sum notall/;
# this module is available from CPAN
use Digest::MD5 qw(md5_hex);
#### INIT
my $testing = 0;
my $input = $testing ? 'abc' : 'abbhdwsy';
### CODE
my @password = (undef) x 8;
my $i = 0;
while ( notall { defined $_ } @password ) {
my $hash = md5_hex( $input . $i );
if ( $hash =~ m/^00000/ ) {
# 6th char indicates position 0-7, 7th indicates character to
# place there
my $pos = ( split( //, $hash ) )[5];
if ( $pos =~ m/[0-7]/ and !defined( $password[$pos] ) ) {
$password[$pos] .= ( split( //, $hash ) )[6];
# ANIMATE!
say join( '', map { $_ ? $_ : '_' } @password );
}
}
$i++;
}
say join( '', @password );
24 lines [ Plain text ] [ ^Top ]
#!/usr/bin/perl
use 5.016; # implies strict, provides 'say'
use warnings;
use autodie;
use List::Util qw/sum notall/;
use Time::HiRes qw/gettimeofday tv_interval/;
use Digest::MD5 qw(md5_hex);
#### INIT
my $testing = 0;
my $input = $testing ? 'abc' : 'abbhdwsy';
### CODE
my $t0 = [gettimeofday];
say " input: $input";
my @password = (undef) x 8;
my $i = 0;
while ( notall { defined $_ } @password ) {
my $hash = md5_hex( $input . $i );
if ( $hash =~ m/^00000/ ) {
# 6th char indicates position 0-7, 7th indicates character to
# place there
my $pos = ( split( //, $hash ) )[5];
if ( $pos =~ m/[0-7]/ and !defined( $password[$pos] ) ) {
$password[$pos] .= ( split( //, $hash ) )[6];
# ANIMATE!
# say join( '', map { $_ ? $_ : '_' } @password );
}
}
$i++;
}
my $elapsed = tv_interval($t0);
say 'answer: ', join( '', @password );
say sprintf( "%d hashes. Elapsed time: %d s, %.02f KH/s",
$i, $elapsed, $i / 1_000 / $elapsed );
30 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;
#### INIT - load input data into array
my $testing = 0;
my @input;
my $file = $testing ? 'test.txt' : 'input.txt';
{
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }
}
### CODE
# change value of $part for part 2
my $part = 1;
my $data;
foreach my $line (@input) {
my @chars = split( //, $line );
map { $data->[$_]->{ $chars[$_] }++ } ( 0 .. $#chars );
}
my $answer;
foreach my $hash ( @{$data} ) {
my $sortings = { 1 => sub { $hash->{$a} <=> $hash->{$b} },
2 => sub { $hash->{$b} <=> $hash->{$a} }, };
my @freq = sort { &{ $sortings->{$part} } } keys %{$hash};
$answer .= pop @freq;
}
say $answer;
24 lines [ Plain text ] [ ^Top ]
#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;
#### INIT - load input data into array
my $testing = 0;
my @input;
my $file = $testing ? 'test.txt' : 'input.txt';
{
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }
}
### CODE
my $part = 1;
my $data;
my $sortings = { 1 => sub { $data->[$_]->{$a} <=> $data->[$_]->{$b} },
2 => sub { $data->[$_]->{$b} <=> $data->[$_]->{$a} }, };
foreach my $line (@input) {
my @chars = split( //, $line );
map { $data->[$_]->{ $chars[$_] }++ } ( 0 .. $#chars );
}
say join( '', map { ( sort { &{ $sortings->{$part} } }
keys %{ $data->[$_] } )[-1] } ( 0 .. $#{$data} ) );
20 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#!/usr/bin/perl
use 5.016; # implies strict, provides 'say'
use warnings;
use autodie;
#### INIT - load input data into array
my $testing = 0;
my @input;
my $file = $testing ? 'test.txt' : 'input.txt';
{
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }
}
### CODE
my $count = 0;
foreach my $line (@input) {
my (@hypernets) = $line =~ m/\[([^]]+)\]/g;
my @parts = split( /\[.*?\]/, $line );
my $taboo = 0;
foreach my $hn (@hypernets) {
$taboo++ if ( $hn =~ m/(.)(.)\2\1/ and $1 ne $2 );
}
next if $taboo;
my $matches = 0;
foreach my $part (@parts) {
if ( $part =~ m/(.)(.)\2\1/ and $1 ne $2 ) {
$matches++;
}
}
$count++ if $matches > 0;
}
say $count;
28 lines [ Plain text ] [ ^Top ]
#!/usr/bin/perl
use 5.016; # implies strict, provides 'say'
use warnings;
use autodie;
#### INIT - load input data into array
my $testing = 0;
my @input;
my $file = $testing ? 'test2.txt' : 'input.txt';
{
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }
}
### CODE
my $count = 0;
foreach my $line (@input) {
my (@hypernets) = $line =~ m/\[([^]]+)\]/g;
my @supernets = split( /\[.*?\]/, $line );
my %compare;
my $matches = 0;
foreach my $hn (@hypernets) {
my @part = split( //, $hn );
for ( my $i = 0 ; $i < scalar @part - 2 ; $i++ ) {
if ( $part[$i] eq $part[ $i + 2 ]
and $part[$i] ne $part[ $i + 1 ] )
{
$compare{ $part[$i] . $part[ $i + 1 ] . $part[ $i + 2 ] }++;
}
}
}
foreach my $sn (@supernets) {
my @part = split( //, $sn );
for ( my $i = 0 ; $i < scalar @part - 2 ; $i++ ) {
if ( $part[$i] eq $part[ $i + 2 ]
and $part[$i] ne $part[ $i + 1 ] )
{
if ( exists $compare{ $part[ $i + 1 ]
. $part[$i]
. $part[ $i + 1 ] } )
{
$matches++;
}
}
}
}
$count++ if $matches > 0;
}
say $count;
44 lines [ Plain text ] [ ^Top ]
#!/usr/bin/perl
use 5.016; # implies strict, provides 'say'
use warnings;
use autodie;
#### INIT - load input data into array
my $testing = 0;
my @input;
my $file = $testing ? 'test2.txt' : 'input.txt';
{
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }
}
### CODE
my $count = 0;
foreach my $line (@input) {
my (@hypernets) = $line =~ m/\[([^]]+)\]/g;
my @supernets = split( /\[.*?\]/, $line );
my %compare;
my $matches = 0;
foreach my $hn (@hypernets) {
# following regex cargo-cult copied from
# https://stackoverflow.com/questions/14259677/matching-two-overlapping-patterns-with-perl
while ( $hn =~ m/(?=(.)(.)\1)/g ) {
next if $1 eq $2;
$compare{ $1 . $2 . $1 }++;
}
}
foreach my $sn (@supernets) {
while ( $sn =~ m/(?=(.)(.)\1)/g ) {
next if $1 eq $2;
if ( exists $compare{ $2 . $1 . $2 } ) {
$matches++;
}
}
}
$count++ if $matches > 0;
}
say $count;
35 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#!/usr/bin/perl
use 5.016; # implies strict, provides 'say'
use warnings;
use autodie;
#### INIT - load input data into array
my $testing = 0;
my @input;
my $file = $testing ? 'test.txt' : 'input.txt';
{
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }
}
### CODE
my ( $max_col, $max_row ) = $testing ? ( 7, 3 ) : ( 50, 6 );
my $M;
for my $r ( 0 .. $max_row - 1 ) {
for my $c ( 0 .. $max_col - 1 ) {
$M->[$c]->[$r] = 0;
}
}
sub rect {
my ( $col, $row ) = @_;
for my $r ( 0 .. $row - 1 ) {
for my $c ( 0 .. $col - 1 ) {
$M->[$r]->[$c] = 1;
}
}
}
sub rotate_row {
my ( $row, $shift ) = @_;
my @current_row = @{ $M->[$row] };
my @new_row;
for my $i ( 0 .. $#current_row ) {
$new_row[ ( $i + $shift ) % $max_col ]
= $current_row[$i] ? $current_row[$i] : 0;
}
$M->[$row] = \@new_row;
}
sub rotate_col {
my ( $col, $shift ) = @_;
my @current_col;
for my $r ( 0 .. $max_row - 1 ) {
push @current_col, $M->[$r]->[$col];
}
my @new_col;
for my $i ( 0 .. $#current_col ) {
$new_col[ ( $i + $shift ) % $max_row ]
= $current_col[$i] ? $current_col[$i] : 0;
}
for my $r ( 0 .. $max_row - 1 ) {
$M->[$r]->[$col] = $new_col[$r];
}
}
sub display {
for my $r ( 0 .. $max_row - 1 ) {
print ' ';
for my $c ( 0 .. $max_col - 1 ) {
if ( defined( $M->[$r]->[$c] ) and $M->[$r]->[$c] == 1 ) {
print '0';
} else {
print ' ';
}
}
print "\n";
}
}
sub count_cells {
my $count = 0;
for my $r ( 0 .. $max_row - 1 ) {
for my $c ( 0 .. $max_col - 1 ) {
if ( defined( $M->[$r]->[$c] ) and $M->[$r]->[$c] == 1 ) {
$count++;
}
}
}
return $count;
}
foreach my $line (@input) {
if ( $line =~ m/^rect (\d+)x(\d+)/ ) {
rect( $1, $2 );
} elsif ( $line =~ m/^rotate column x=(\d+) by (\d+)/ ) {
rotate_col( $1, $2 );
} elsif ( $line =~ m/^rotate row y=(\d+) by (\d+)/ ) {
rotate_row( $1, $2 );
} else {
die "can't parse $line";
}
}
say " Lit pixels: ", count_cells();
display();
87 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#!/usr/bin/perl
use 5.016; # implies strict, provides 'say'
use warnings;
use autodie;
#### INIT - load input data into array
my $testing = 0;
my @input;
my $file = $testing ? 'test.txt' : 'input.txt';
{
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }
}
### CODE
# we will only have one line for "real" input, this is for testing
foreach my $line (@input) {
my @stream = split( //, $line );
my $count = 0;
while (@stream) {
my $c = shift @stream;
if ( $c eq '(' ) {
# process marker
my $marker = $c;
my $t = shift @stream;
while ( $t ne ')' ) { # get end
$marker .= $t;
$t = shift @stream;
}
$marker .= ')';
# parse marker
my ( $part, $rep ) = ( 0, 0 );
if ( $marker =~ /\((\d+)x(\d+)\)/ ) {
( $part, $rep ) = ( $1, $2 );
} else { # this is not a marker, instead it's chars enclosed in parens
$count += length $marker;
next;
}
# read input and decompress
my @d = splice @stream, 0, $part;
$count += ( scalar @d ) * $rep;
} else {
$count++;
}
}
say $count;
}
41 lines [ Plain text ] [ ^Top ]
#!/usr/bin/perl
use 5.016; # implies strict, provides 'say'
use warnings;
use autodie;
use List::Util qw/sum/;
use Data::Dumper;
#### INIT - load input data into array
my $testing = 0;
my @input;
my $file = $testing ? 'test2.txt' : 'input.txt';
{
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }
}
### CODE
sub get_count {
my @ary = @_;
my $count = 0;
while (@ary) {
my $c = shift @ary;
if ( $c eq '(' ) {
my $marker = $c;
my $t = shift @ary;
while ( $t ne ')' ) {
$marker .= $t;
$t = shift @ary;
}
$marker .= ')';
my ( $part, $rep ) = ( 0, 0 );
if ( $marker =~ /\((\d+)x(\d+)\)/ ) {
( $part, $rep ) = ( $1, $2 );
} else {
$count += length $marker;
}
my @d = splice @ary, 0, $part;
$count += get_count(@d) * $rep;
} else {
$count++;
}
}
return $count;
}
# we will only have one line for "real" input, the foreach loop is for testing
foreach my $line (@input) {
my @stream = split( //, $line );
say get_count(@stream);
}
43 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#!/usr/bin/perl
use 5.016; # implies strict, provides 'say'
use warnings;
use autodie;
#### INIT - load input data into array
my $testing = 0;
my @input;
my $file = $testing ? 'test.txt' : 'input.txt';
{
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }
}
### CODE
my %state;
my @goal = $testing ? ( 2, 5 ) : ( 17, 61 );
while ( scalar @input > 0 ) {
my $cmd = shift @input;
if ( $cmd =~ m/^value/ ) {
my ( $init, $recip ) = $cmd =~ /value (\d+) goes to (bot \d+)/;
push @{ $state{$recip} }, $init;
} elsif ( $cmd =~ m/^bot.*low.*high/ ) {
my ( $giver, $lo, $hi )
= $cmd
=~ /(bot \d+) gives low to (\S+\s\d+) and high to (\S+\s\d+)/;
my @c = sort { $a <=> $b } @{ $state{$giver} }
if exists $state{$giver};
if ( scalar @c != 2 ) {
push @input, $cmd;
} else {
push @{ $state{$lo} }, shift @c;
push @{ $state{$hi} }, shift @c;
}
} else {
die "can't parse $cmd";
}
}
my $part2 = 1;
foreach my $e ( keys %state ) {
my @a = sort { $a <=> $b } @{ $state{$e} };
say "Part 1: $e" if ( join( '', @a ) eq join( '', @goal ) );
if ( $e eq 'output 0' or $e eq 'output 1' or $e eq 'output 2' ) {
$part2 *= ${ $state{$e} }[0];
}
}
say "Part 2: $part2";
42 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#!/usr/bin/perl
use 5.016; # implies strict, provides 'say'
use warnings;
use autodie;
use List::Util qw/sum all/;
use Algorithm::Combinatorics qw/combinations/;
#### INIT - load input data into array
my $testing = 0;
my $part2 = shift || 0;
# state->[0] = step, $state->[1] = elevator pos
# then a list of hashes with elements
# g = generator, m = microchip
# testing: h=Hydrogen l=Lithium
# t=Thulium p=Plutonium s=Strontium r=Ruthenium o=prOmethium
my $states;
my $target;
if ($testing) {
$states = [
{ steps => 0,
floor => 0,
state => [{ mh => 1, ml => 1, el => 1 },
{ gh => 1 },
{ gl => 1 },
{} ] } ];
$target = 4;
} else {
$states = [ { steps => 0,
floor => 0,
state => [ { gt => 1, mt => 1, gp => 1, gs => 1, el => 1 },
{ mp => 1, ms => 1 },
{ go => 1, mo => 1, gr => 1, mr => 1 },
{} ] } ];
$target = 10;
if ($part2) {
$states->[0]->{state}->[0]->{ge}++;
$states->[0]->{state}->[0]->{me}++;
$states->[0]->{state}->[0]->{gd}++;
$states->[0]->{state}->[0]->{md}++;
$target += 4;
}
}
### CODE ########################################
my %seen;
### SUBS ########################################
sub is_ok {
my ($a) = @_;
# none or 1 ok
return 1 if ( !defined($a) );
return 1 if ( scalar @{$a} <= 1 );
# all generators ok
return 1 if ( all { ( split( //, $_ ) )[0] eq 'g' } @$a );
# all microchips ok
return 1 if ( all { ( split( //, $_ ) )[0] eq 'm' } @$a );
my %set;
my @singles;
for my $i ( sort @$a ) {
my @c = split( //, $i );
push @{ $set{ $c[1] } }, $c[0];
}
foreach my $el ( keys %set ) {
next
if scalar @{ $set{$el} } == 2;
push @singles, $set{$el}->[0];
}
if (all {
$_ eq 'g';
}
@singles )
{
return 1;
} else {
return 0;
}
}
sub dump_state {
my ($s) = @_;
say "S: $s->{steps} F: $s->{floor}";
for my $f ( @{ $s->{state} } ) {
my $rest = $target - scalar keys %{$f};
say '[ ', join( ' ', ( sort keys %{$f} ), ( '...' x $rest ) ), ' ]';
}
say join( '', '-' x 16 );
}
sub stringify_state {
my ($state) = @_;
return
'<'
. join( '|', map { join( '', sort keys %{$_} ) } @{$state} ) . '>';
}
########################################
my $count = 0;
LOOP: while (1) {
my $move = shift @{$states} || die "no more states!";
my $str = stringify_state( $move->{state} );
if ( exists $seen{$str} ) {
next;
} else {
$seen{$str}++;
}
my $steps = $move->{steps};
my $from_floor = $move->{floor};
my $current = $move->{state};
delete $current->[$from_floor]->{el};
my %from_items = %{ $current->[$from_floor] };
# get the combinations of stuff to move from the source floor
my @items = combinations( [ keys %from_items ], 1 );
if ( scalar keys %from_items >= 2 ) {
push @items, combinations( [ keys %from_items ], 2 );
}
@items = grep { is_ok($_) } @items;
next unless scalar @items > 0;
$steps += 1;
# move up or down, if possible
STATE: for my $to_floor ( $from_floor - 1, $from_floor + 1 ) {
next if ( $to_floor < 0 or $to_floor > 3 );
for my $item_list (@items) {
my $new = [ {}, {}, {}, {} ];
# unchanged floors are copied over
my @unchanged
= grep { $_ != $to_floor and $_ != $from_floor } ( 0 .. 3 );
map { $new->[$_] = $current->[$_] } @unchanged;
# remove from origin floor
my $invalid_flag = 0;
for my $k ( keys %{ $current->[$from_floor] } ) {
if ( grep { $k eq $_ } @{$item_list} ) {
next;
} else {
$new->[$from_floor]->{$k}++;
}
}
if ( !is_ok( [ keys %{ $new->[$from_floor] } ] ) ) {
$invalid_flag += 1;
}
# add to dest floor
for my $k ( keys %{ $current->[$to_floor] } ) {
$new->[$to_floor]->{$k}++;
}
for my $j ( @{$item_list} ) {
$new->[$to_floor]->{$j}++;
}
if ( !is_ok( [ keys %{ $new->[$to_floor] } ] ) ) {
$invalid_flag += 1;
}
# check all are valid
next unless ( $invalid_flag == 0 );
# check we have reached goal
if ( scalar keys %{ $new->[3] } == $target ) {
say "$steps";
last LOOP;
}
# heuristic: don't move down 2 items
if ( ( $to_floor < $from_floor )
and ( scalar keys %{ $new->[$to_floor] } )
- ( scalar keys %{ $current->[$to_floor] } ) > 1 )
{
next;
}
# add elevator, then add to queue
$new->[$to_floor]->{el}++;
my $new_state = { steps => $steps,
floor => $to_floor,
state => $new };
push @{$states}, $new_state;
}
}
$count++;
}
157 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#!/usr/bin/perl
use 5.016; # implies strict, provides 'say'
use warnings;
use autodie;
#### INIT - load input data into array
my $testing = 0;
my $part = 2;
my @input;
my $file = $testing ? 'test.txt' : 'input.txt';
{
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }
}
### CODE
my %reg = map { $_ => 0 } qw(a b c d);
$reg{c} = 1 unless $part == 1;
my @instr;
while (@input) {
my ( $cmd, $arg1, $arg2 );
my $line = shift @input;
if ( $line =~ m/^(inc|dec) (.)$/ ) { push @instr, [ $1, $2, undef ] }
elsif ( $line =~ /^cpy (\S+) (\S+)$/ ) { push @instr, [ 'cpy', $1, $2 ] }
elsif ( $line =~ /^jnz (\S+) (-?\d+)$/ ) {
push @instr, [ 'jnz', $1, $2 ];
} else {
die "cannot parse $line";
}
}
my $pos = 0;
while ( $pos >= 0 and $pos <= $#instr ) {
my ( $cmd, $a1, $a2 ) = @{ $instr[$pos] };
if ( $cmd eq 'inc' ) {
$reg{$a1} += 1;
$pos++;
} elsif ( $cmd eq 'dec' ) {
$reg{$a1} -= 1;
$pos++;
} elsif ( $cmd eq 'cpy' ) {
# can either copy integer or content of other register
if ( $a1 =~ /\d+/ ) { $reg{$a2} = $a1 }
else { $reg{$a2} = $reg{$a1} }
$pos++;
} elsif ( $cmd eq 'jnz' ) {
# value to compare can be integer (one case) or content of register
if ( $a1 =~ /\d+/ ) { $pos = $pos + $a2 }
elsif ( $a1 =~ /[a-d]/ ) {
if ( $reg{$a1} != 0 ) { $pos = $pos + $a2 }
else { $pos++ }
}
}
}
say $reg{a};
49 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#!/usr/bin/perl
use 5.016; # implies strict, provides 'say'
use warnings;
use autodie;
#### INIT - load input data into array
my $testing = 0;
my ( $input, $target ) = ( 1358, [ 31, 39 ] );
if ($testing) { $input = 10; $target = [ 7, 4 ]; }
### CODE
my $maze;
my $seen;
sub count_ones {
# https://docstore.mik.ua/orelly/perl/cookbook/ch02_05.htm
my $str = unpack( "B32", pack( "N", shift ) );
$str =~ s/^0+(?=\d)//;
my $count = 0;
for my $c ( split( //, $str ) ) {
$count++ if ( $c == 1 );
}
return $count;
}
sub is_open {
my ( $x, $y ) = @_;
if ( $x < 0 or $y < 0 ) { return 0 }
if ( exists $maze->{$x}->{$y} ) {
return $maze->{$x}->{$y};
}
my $fact = ( $x * $x + 3 * $x + 2 * $x * $y + $y + $y * $y );
$fact += $input;
my $ones = count_ones($fact);
if ( $ones % 2 == 0 ) {
$maze->{$x}->{$y} = 1;
return 1;
} else {
$maze->{$x}->{$y} = 0;
return 0;
}
}
my @states = ( [ 0, [ 1, 1 ] ] );
LOOP: {
while (@states) {
my $move = shift @states;
my $step = $move->[0];
my ( $x, $y ) = @{ $move->[1] };
if ( exists $seen->{$x}->{$y} ) {
next;
} else {
$seen->{$x}->{$y}++;
}
# try to move
$step += 1;
my @new;
push @new,
( [ $x + 1, $y ], [ $x - 1, $y ],
[ $x, $y + 1 ], [ $x, $y - 1 ] );
while (@new) {
my $el = shift @new;
my ( $new_x, $new_y ) = @$el;
if ( is_open( $new_x, $new_y ) ) {
if ( $new_x == $target->[0]
and $new_y == $target->[1] )
{
#break out reporting sucess
say "steps: $step";
last LOOP;
}
push @states, [ $step, $el ];
}
}
}
}
68 lines [ Plain text ] [ ^Top ]
#!/usr/bin/perl
use 5.016; # implies strict, provides 'say'
use warnings;
use autodie;
#### INIT - load input data into array
my $testing = 0;
my ( $input, $target ) = ( 1358, [ 31, 39 ] );
if ($testing) { $input = 10; $target = [ 7, 4 ]; }
### CODE
my $maze;
my $seen;
sub count_ones { # https://docstore.mik.ua/orelly/perl/cookbook/ch02_05.htm
my $str = unpack( "B32", pack( "N", shift ) );
$str =~ s/^0+(?=\d)//;
my $count = 0;
for my $c ( split( //, $str ) ) {
$count++ if ( $c == 1 );
}
return $count;
}
sub is_open {
my ( $x, $y ) = @_;
if ( $x < 0 or $y < 0 ) { return 0 }
if ( exists $maze->{$x}->{$y} ) {
return $maze->{$x}->{$y};
}
my $fact = ( $x * $x + 3 * $x + 2 * $x * $y + $y + $y * $y );
$fact += $input;
my $ones = count_ones($fact);
if ( $ones % 2 == 0 ) {
$maze->{$x}->{$y} = 1;
return 1;
} else {
$maze->{$x}->{$y} = 0;
return 0;
}
}
my @states = ( [ 0, [ 1, 1 ] ] );
while (@states) {
my $move = shift @states;
my $step = $move->[0];
my ( $x, $y ) = @{ $move->[1] };
if ( exists $seen->{$x}->{$y} ) {
next;
} else {
$seen->{$x}->{$y}++;
}
# try to move
$step += 1;
next if $step > 50;
my @new;
push @new,
( [ $x + 1, $y ], [ $x - 1, $y ], [ $x, $y - 1 ], [ $x, $y + 1 ] );
while (@new) {
my $el = shift @new;
my ( $new_x, $new_y ) = @$el;
if ( is_open( $new_x, $new_y ) ) {
push @states, [ $step, $el ];
}
}
}
my $count = 0;
for my $x ( keys %{$seen} ) {
for my $y ( keys %{ $seen->{$x} } ) {
$count++;
}
}
say $count;
65 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#!/usr/bin/perl
use 5.016; # implies strict, provides 'say'
use warnings;
use autodie;
use Digest::MD5 qw(md5_hex);
#### INIT
my $debug = 0;
my $testing = 0;
my $salt = $testing ? 'abc' : 'qzyelonm';
# pass an argument for part 2
my $part2 = shift || undef;
### CODE
my $index = 0;
my @keys = ();
my %lookup = ();
#### yak-shaving debug output
sub dump_state {
say " /// Index: $index";
say map {
sprintf( "%3x: %3d", $_, $lookup{$_} ? scalar @{ $lookup{$_} } : 0 )
} ( 0 .. 7 );
say map {
sprintf( "%3x: %3d",
$_,
$lookup{ sprintf( "%x", $_ ) }
? scalar @{ $lookup{ sprintf( "%x", $_ ) } }
: 0 )
} ( 8 .. 15 );
say ' Last 3 keys: ... ',
join( ', ', ( sort { $a <=> $b } @keys )[ -3 .. -1 ] ), ' )';
}
sub dbg_line {
my ($str, $c, $hex) = @_;
say sprintf("%5d %6s %s %s", $index, $str, $c, $hex);
}
###############
while ( scalar @keys <= 70 ) {
my $hex = md5_hex( $salt . $index );
if ($part2) {
for ( 1 .. 2016 ) { $hex = md5_hex($hex) }
}
# check for triples
if ( $hex =~ m/(.)\1{2}/ ) {
dbg_line('triple', $1, $hex) if $debug;
push @{ $lookup{$1} }, $index;
}
# check for quints
if ( $hex =~ m/(.)\1{4}/ ) {
dbg_line('quint', $1, $hex) if $debug;
if ( exists $lookup{$1} ) {
# get the lists of indexes found for this hex char
while ( @{ $lookup{$1} } ) {
my $el = shift @{ $lookup{$1} };
if ( $index == $el ) {
say " **> skip $el for now, check later" if $debug;
next;
} elsif ( $index - $el < 1000 ) {
say " ==> add $el to keys" if $debug;
push @keys, $el;
} else {
say " --> $el too old, discard" if $debug;
}
}
}
# finally add the quint to the lookup
push @{ $lookup{$1} }, $index;
}
$index++;
if ( $debug and $index % 1_000 == 0 ) { dump_state }
}
@keys = sort { $a <=> $b } @keys;
say '==>', $keys[63];
66 lines [ Plain text ] [ ^Top ]
#!/usr/bin/perl
use 5.016; # implies strict, provides 'say'
use warnings;
use autodie;
use Digest::MD5 qw(md5_hex);
#### INIT
my $debug = 1;
my $testing = 0;
my $salt = $testing ? 'abc' : 'qzyelonm';
# mine: 'qzyelonm';
# Tenjou: 'yjdafjpo'
# pass an argument for part 2
my $part2 = shift || undef;
### CODE
my $index = 0;
my @keys = ();
my %lookup = ();
#### yak-shaving debug output
sub dump_state {
say " /// Index: $index";
say map {
sprintf( "%3x: %3d", $_, $lookup{$_} ? scalar @{ $lookup{$_} } : 0 )
} ( 0 .. 7 );
say map {
sprintf( "%3x: %3d",
$_,
$lookup{ sprintf( "%x", $_ ) }
? scalar @{ $lookup{ sprintf( "%x", $_ ) } }
: 0 )
} ( 8 .. 15 );
say ' Last 3 keys: ... ',
join( ', ', ( sort { $a <=> $b } @keys )[ -3 .. -1 ] ), ' )';
}
sub dbg_line {
my ( $str, $c, $hex ) = @_;
say sprintf( "%5d %6s %s %s", $index, $str, $c, $hex );
}
###############
# code below inspired by this comment
# https://www.reddit.com/r/adventofcode/comments/5iaszm/how_long_does_day_14_take_to_run/db7id7f/
my %keys;
for ( my ( $index, $end ) = ( 0, 1e99 ) ; $index < $end ; $index++ ) {
my $hex = md5_hex( $salt . $index );
if ($part2) {
for ( 1 .. 2016 ) { $hex = md5_hex($hex) }
}
# check for quints
while ( $hex =~ m/(.)(?=\1\1\1\1)/g ) {
next unless defined $lookup{$1};
my @list = @{ $lookup{$1} };
delete $lookup{$1};
for my $candidate (@list) {
next if $index - $candidate > 1000;
$keys{$candidate}++;
if ( keys %keys == 64 ) {
$end = $index + 1000;
}
}
}
# add triples
if ( $hex =~ m/(.)\1\1/ ) {
push @{ $lookup{$1} }, $index;
}
}
say '' . ( sort { $a <=> $b } keys %keys )[ 64 - 1 ];
55 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#!/usr/bin/perl
use 5.016; # implies strict, provides 'say'
use warnings;
use autodie;
use List::Util qw/all max/;
#### INIT - load input data into array
my $testing = 0;
my $part2 = shift || 0; # call with any argument for part 2
my @input;
my $file = $testing ? 'test.txt' : 'input.txt';
{
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }
}
### CODE
my %discs;
for my $line (@input) {
my ( $disc_id, $slots, $initial )
= $line
=~ m/^Disc \#(\d+) has (\d+) positions\; at time=0, it is at position (\d+)\.$/;
$discs{$disc_id} = { slots => $slots, pos => $initial };
}
if ($part2) {
my $new = max( keys %discs ) + 1;
$discs{$new} = { slots => 11, pos => 0 };
}
my $t0 = 0;
while (1) {
my @vec;
for my $d ( sort { $a <=> $b } keys %discs ) {
my $t = $t0 + $d;
my $pos = $discs{$d}->{pos} + $t;
push @vec, $pos % $discs{$d}->{slots};
}
if ( all { $_ == 0 } (@vec) ) {
say $t0;
last;
}
$t0++;
}
37 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#!/usr/bin/perl
use 5.016; # implies strict, provides 'say'
use warnings;
use autodie;
#### INIT - load input data into array
my $part2 = shift || 0;
my $testing = 0;
my $input;
my $target_length;
if ($testing) {
$input = '10000';
$target_length = 20;
} else {
$input = '10111100110001111';
$target_length = $part2 ? 35651584 : 272;
}
### CODE
sub generate_curve {
my ( $str, $target ) = @_;
return $str if length($str) >= $target;
my $cpy = $str;
my $out = $str . '0';
# fsck regex
for my $c ( reverse split( //, $cpy ) ) {
if ( $c == 1 ) { $out .= '0' }
else { $out .= '1' }
}
generate_curve( $out, $target );
}
sub generate_checksum {
my ($str) = @_;
my $out;
my @a = split( //, $str );
while (@a) {
my @pair = splice( @a, 0, 2 );
if ( $pair[0] == $pair[1] ) { $out .= '1' }
else { $out .= '0' }
}
if ( ( length $out ) % 2 == 0 ) {
generate_checksum($out);
} else {
return $out;
}
}
if ($testing) {
for my $teststr (qw/1 0 11111 111100001010/) {
say $teststr, ' becomes ',
generate_curve( $teststr, 2 * length($teststr) + 1 ) . '.';
}
say generate_checksum('110010110100');
}
my $curve = generate_curve( $input, $target_length );
if ( length $curve > $target_length ) {
$curve = substr( $curve, 0, $target_length );
}
say generate_checksum($curve);
53 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#!/usr/bin/perl
use 5.016; # implies strict, provides 'say'
use warnings;
use autodie;
use List::Util qw/max/;
use Digest::MD5 qw/md5_hex/;
#### INIT - load input data into array
my $testing = 0;
my $input;
if ( $testing ) {
$input = 'hijkl';
} else {
$input = shift || 'yjjvjgan';
}
### CODE
my @sequence = ( [ '', 0, 0 ] );
my @solutions;
LOOP: while (@sequence) {
# grab the door configuration based on current path
my $current = shift @sequence;
my $path = $current->[0];
my ( $cur_x, $cur_y ) = @{$current}[ 1, 2 ];
my $hex = md5_hex( $input . $path );
# U D L R
my ( $u, $d, $l, $r ) = $hex =~ m/^(.)(.)(.)(.)/;
# generate potential paths
my @tries;
if ( $u =~ m/[b-f]/ ) { push @tries, [ 'U', $cur_x, $cur_y - 1 ] }
if ( $d =~ m/[b-f]/ ) { push @tries, [ 'D', $cur_x, $cur_y + 1 ] }
if ( $l =~ m/[b-f]/ ) { push @tries, [ 'L', $cur_x - 1, $cur_y ] }
if ( $r =~ m/[b-f]/ ) { push @tries, [ 'R', $cur_x + 1, $cur_y ] }
while (@tries) {
my $next = shift @tries;
# are the moves legal?
if ( $next->[1] < 0
or $next->[1] > 3
or $next->[2] < 0
or $next->[2] > 3 )
{
next;
}
if ( $next->[1] == 3 and $next->[2] == 3 ) {
# say $path.$next->[0];
push @solutions, $path . $next->[0];
next;
}
push @sequence, [ $path . $next->[0], $next->[1], $next->[2] ];
}
}
if (scalar @solutions == 0 ) {
say "input $input didn't result in valid path";
exit 1;
}
say "Part 1: ", $solutions[0];
say "Part 2: ", max map {length $_} @solutions;
52 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#!/usr/bin/perl
use 5.016; # implies strict, provides 'say'
use warnings;
use autodie;
#### INIT - load input data into array
my $part2 = shift || 0;
my $testing = 0;
my @input;
my $target = $testing? 10 : 40;
$target = 400_000 if $part2;
my $file = $testing ? 'test.txt' : 'input.txt';
{
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }
}
### CODE
my @rows;
my $safe_count = 0;
push @rows, $input[0];
while ( scalar @rows < $target ) {
my @prev = split(//,$rows[-1]);
my $new;
for my $i (0..$#prev ){
my ( $left, $center, $right ) = map {$prev[$i+$_]} (-1,0,1);
if ( $i-1 < 0 ) { $left = '.' }
if ( $i+1 > $#prev ) {$right = '.' }
# apply rules
if ( $left eq '^' and $center eq '^' and $right ne '^' ) {
$new .= '^'
} elsif ( $left ne '^' and $center eq '^' and $right eq '^' ) {
$new .= '^'
} elsif ( $left eq '^' and $center ne '^' and $right ne '^' ) {
$new .= '^'
} elsif ( $left ne '^' and $center ne '^' and $right eq '^' ) {
$new .= '^'
} else {
$new .= '.';
}
}
push @rows, $new;
}
for my $r ( @rows ) {
for my $i ( split //, $r) {
$safe_count +=1 if $i eq '.'
}
}
say ">>> $safe_count";
44 lines [ Plain text ] [ ^Top ]
#!/usr/bin/perl
use 5.016; # implies strict, provides 'say'
use warnings;
use autodie;
use List::Util qw/sum/;
#### INIT - load input data into array
my $part2 = shift || 0;
my $testing = 0;
my @input;
my $target = $testing? 10 : 40;
$target = 400_000 if $part2;
my $file = $testing ? 'test.txt' : 'input.txt';
{
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }
}
### CODE
# inspiration:
# https://www.reddit.com/r/adventofcode/comments/5iyp50/2016_day_18_solutions/dbcp5m0/
# don't load all data, just count 2 at a time
my $safe = 1;
my $trap = 0;
my $safe_count = 0;
my @row = ( $safe,
map {$_ eq '^' ? $trap : $safe } (split //, $input[0]),
$safe );
$safe_count = sum( @row ) - 2;
for my $count ( 1 .. $target - 1 ) {
my @new = (undef) x @row;
$new[0] = $new[-1] = $safe;
for ( my $i = 1; $i < @row -1 ; $i++ ) {
$new[$i] //= ( $row[$i-1] xor $row[$i+1])? $trap : $safe ;
}
$safe_count = sum( @new ) - 2;
@row = @new;
}
say ">>> $safe_count";
31 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#!/usr/bin/perl
use 5.016; # implies strict, provides 'say'
use warnings;
use autodie;
#### INIT - load input data into array
my $testing = 0;
my $no_of_elves = $testing ? 5 : 3005290;
### CODE
my @elves = ( 1 .. $no_of_elves );
while ( scalar @elves > 1 ) {
my $taker = shift @elves;
shift @elves;
push @elves, $taker;
}
say ">>> ", join( '', @elves );
12 lines [ Plain text ] [ ^Top ]
#!/usr/bin/perl
use 5.016; # implies strict, provides 'say'
use warnings;
use autodie;
#### INIT - load input data into array
my $testing = 0;
my $no_of_elves = $testing ? 5 : 3005290;
### CODE
# Credit:
# https://www.reddit.com/r/adventofcode/comments/5j4lp1/2016_day_19_solutions/dbdgnwd/
my $winner = 1;
for ( my $i = 1 ; $i < $no_of_elves ; $i++ ) {
$winner = $winner % $i + 1;
if ( $winner > int( $i + 1 ) / 2 ) {
$winner++;
}
}
say ">>> $winner";
13 lines [ Plain text ] [ ^Top ]
#!/usr/bin/perl
use 5.016; # implies strict, provides 'say'
use warnings;
use autodie;
#### INIT - load input data into array
my $testing = 0;
my $no_of_elves = $testing ? 5 : 3005290;
### CODE
# Credit:
# https://www.reddit.com/r/adventofcode/comments/5j4lp1/2016_day_19_solutions/dbdnz4l/
# Divide the elves into left and right "halves", the right half being
# bigger if there's an odd number.
my @left = ( 1.. $no_of_elves / 2);
my @right= ( $no_of_elves/2 + 1 .. $no_of_elves );
while ( @left ) {
# remove the giver
shift @right;
# keep the halves balanced
if ( @right == @left ) {
my $transfer = shift @right;
push @left, $transfer;
}
# shift the taker to the end of the @right array
my $taker = shift @left;
push @right, $taker;
}
say ">>> ", join('',@right);
20 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#!/usr/bin/perl
use 5.016; # implies strict, provides 'say'
use warnings;
use autodie;
use List::Util qw/max/;
#### INIT - load input data into array
my $testing = 0;
my @input;
my $file = $testing ? 'test.txt' : 'input.txt';
{
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }
}
### CODE
my $debug = 0;
my $MAX_IP = 4294967295;
my @ranges;
for my $line (@input) {
my ( $start, $end ) = $line =~ m/^(\d+)\-(\d+)$/;
push @ranges, [ $start, $end ];
}
sub stringify {
my ($n) = @_;
die "can't stringify this giant number $n!" unless $n <= $MAX_IP;
my @dotted = unpack 'C4', pack 'N', $n;
return sprintf( "%10d (%3d.%3d.%3d.%3d)", $n, @dotted );
}
@ranges = sort { $a->[0] <=> $b->[0] } @ranges;
my $starting = shift @ranges;
my $hwm = $starting->[1];
my $allowed = 0;
my $first_allowed = undef;
while (@ranges) {
my $ending = shift @ranges;
if ($debug) {
say " HWM: ", stringify($hwm);
# printf( " HWM: %10s %10d\n", '', $hwm );
say "Start: ",
stringify( $starting->[0] ), ' - ',
stringify( $starting->[1] );
say " End: ",
stringify( $ending->[0] ), ' - ',
stringify( $ending->[1] );
}
if ( $debug and ( $starting->[1] >= $ending->[1] ) ) {
printf( ">OVER: %10d < %10d (%d)\n",
$ending->[1], $starting->[1], $starting->[1] - $ending->[1] );
}
if ( $ending->[0] - $hwm > 1 ) {
if ( !defined $first_allowed ) {
$first_allowed = $hwm + 1;
say "1>> first not blocked: $first_allowed";
}
if ($debug) {
say ">>GAP next highest: ", stringify( $ending->[0] );
say " HWM: ", stringify($hwm);
say " DIFF: ", $ending->[0] - $hwm;
}
$allowed += $ending->[0] - $hwm - 1;
}
my $this_max = max( @{$starting}, @{$ending} );
$hwm = $this_max if ( $this_max > $hwm );
$starting = $ending;
}
$allowed += $MAX_IP - $hwm;
say "2>> number of allowed: $allowed";
63 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#!/usr/bin/perl
use 5.016; # implies strict, provides 'say'
use warnings;
use autodie;
#### INIT - load input data into array
my $testing = 0;
my @input;
my $file = $testing ? 'test.txt' : 'input.txt';
{
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }
}
### SUBS
sub rotate_right {
my ( $ary, $offset, $no_of_rotations ) = @_;
my @a = @{$ary};
my @t = @a;
for my $idx ( 0 .. $#t ) {
$t[ ( $idx + $offset * $no_of_rotations ) % scalar @t ] = $a[$idx];
}
return \@t;
}
sub rotate_left {
my ( $ary, $offset, $no_of_rotations ) = @_;
my @a = @{$ary};
my @t = @a;
for my $idx ( 0 .. $#t ) {
$t[ ( $idx - $offset * $no_of_rotations ) % scalar @t ] = $a[$idx];
}
return \@t;
}
sub move_pos {
my ( $ary, $from, $to ) = @_;
my @a = @{$ary};
my $el = splice @a, $from, 1;
splice @a, $to, 0, ($el);
return \@a;
}
### CODE
my $starting = $testing ? 'abcde' : 'abcdefgh';
my @code = split( //, $starting );
my $debug = 0;
for my $line (@input) {
if ( $line =~ m/^move position (\d+) to position (\d+)$/ ) {
printf( "%36s: %s -> ", $line, join( '', @code ) ) if $debug;
my $t = move_pos( \@code, $1, $2 );
@code = @{$t};
say @code if $debug;
} elsif ( $line =~ m/^reverse positions (\d+) through (\d+)$/ ) {
printf( "%36s: %s -> ", $line, join( '', @code ) ) if $debug;
@code[$1..$2] = reverse @code[$1..$2];
say @code if $debug;
} elsif ( $line =~ m/^rotate based on position of letter (.)$/ ) {
printf( "%36s: %s -> ", $line, join( '', @code ) ) if $debug;
# find the position of the letter
# https://www.perlmonks.org/?node_id=75660
my ($idx) = grep { $code[$_] eq $1 } 0 .. $#code;
my $no_of_rotations = 1 + $idx;
if ( $idx >= 4 ) { $no_of_rotations++ }
my $t = rotate_right( \@code, 1, $no_of_rotations );
@code = @{$t};
say @code if $debug;
} elsif ( $line =~ m/^rotate (left|right) (\d+) steps?$/ ) {
printf( "%36s: %s -> ", $line, join( '', @code ) ) if $debug;
my $t;
if ( $1 eq 'left' ) {
$t = rotate_left( \@code, $2, 1 );
@code = @{$t};
} elsif ( $1 eq 'right' ) {
$t = rotate_right( \@code, $2, 1 );
@code = @{$t};
}
say @code if $debug;
} elsif ( $line =~ m/^swap letter (.) with letter (.)$/ ) {
printf( "%36s: %s -> ", $line, join( '', @code ) ) if $debug;
my ($idx1) = grep { $code[$_] eq $1 } 0 .. $#code;
my ($idx2) = grep { $code[$_] eq $2 } 0 .. $#code;
my @tmp = @code;
$tmp[$idx1] = $code[$idx2];
$tmp[$idx2] = $code[$idx1];
@code = @tmp;
say @code if $debug;
} elsif ( $line =~ m/^swap position (\d+) with position (\d+)$/ ) {
printf( "%36s: %s -> ", $line, join( '', @code ) ) if $debug;
@code[$2,$1] = @code[$1,$2];
say @code if $debug;
} else {
die "can't parse line: $line";
}
}
say join( '', @code );
87 lines [ Plain text ] [ ^Top ]
#!/usr/bin/perl
use 5.016; # implies strict, provides 'say'
use warnings;
use autodie;
use Algorithm::Combinatorics qw(permutations);
#### INIT - load input data into array
my $testing = 0;
my @input;
my $file = $testing ? 'test.txt' : 'input.txt';
{
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }
}
### SUBS
sub rotate_right {
my ( $ary, $offset, $no_of_rotations ) = @_;
my @a = @{$ary};
my @t = @a;
for my $idx ( 0 .. $#t ) {
$t[ ( $idx + $offset * $no_of_rotations ) % scalar @t ] = $a[$idx];
}
return \@t;
}
sub rotate_left {
my ( $ary, $offset, $no_of_rotations ) = @_;
my @a = @{$ary};
my @t = @a;
for my $idx ( 0 .. $#t ) {
$t[ ( $idx - $offset * $no_of_rotations ) % scalar @t ] = $a[$idx];
}
return \@t;
}
sub move_pos {
my ( $ary, $from, $to ) = @_;
my @a = @{$ary};
my $el = splice @a, $from, 1;
splice @a, $to, 0, ($el);
return \@a;
}
### CODE
my $target = 'fbgdceah';
my @start = sort split( //, $target );
my $iter = permutations( \@start );
my $found = 0;
my $count = 0;
while ( my $c = $iter->next and !$found ) {
my @code = @{$c};
for my $line (@input) {
if ( $line =~ m/^move position (\d+) to position (\d+)$/ ) {
my $t = move_pos( \@code, $1, $2 );
@code = @{$t};
} elsif ( $line =~ m/^reverse positions (\d+) through (\d+)$/ ) {
my @tmp = @code[ $1 .. $2 ];
@tmp = reverse @tmp;
my $count = 0;
while (@tmp) {
$code[ $1 + $count ] = shift @tmp;
$count++;
}
} elsif ( $line =~ m/^rotate based on position of letter (.)$/ ) {
# find the position of the letter
# https://www.perlmonks.org/?node_id=75660
my ($idx) = grep { $code[$_] eq $1 } 0 .. $#code;
my $no_of_rotations = 1 + $idx;
if ( $idx >= 4 ) { $no_of_rotations++ }
my $t = rotate_right( \@code, 1, $no_of_rotations );
@code = @{$t};
} elsif ( $line =~ m/^rotate (left|right) (\d+) steps?$/ ) {
my $t;
if ( $1 eq 'left' ) {
$t = rotate_left( \@code, $2, 1 );
@code = @{$t};
} elsif ( $1 eq 'right' ) {
$t = rotate_right( \@code, $2, 1 );
@code = @{$t};
}
} elsif ( $line =~ m/^swap letter (.) with letter (.)$/ ) {
my ($idx1) = grep { $code[$_] eq $1 } 0 .. $#code;
my ($idx2) = grep { $code[$_] eq $2 } 0 .. $#code;
my @tmp = @code;
$tmp[$idx1] = $code[$idx2];
$tmp[$idx2] = $code[$idx1];
@code = @tmp;
} elsif ( $line =~ m/^swap position (\d+) with position (\d+)$/ ) {
my @tmp = @code;
$tmp[$1] = $code[$2];
$tmp[$2] = $code[$1];
@code = @tmp;
} else {
die "can't parse line: $line";
}
}
if ( join( '', @code ) eq $target ) {
say '>> ', join( '', @{$c} );
$found = 1;
}
$count++;
if ( $count % 1000 == 0 ) {
say $count, ' ', join( '', @{$c} );
}
}
97 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#!/usr/bin/perl
use 5.016; # implies strict, provides 'say'
use warnings;
use autodie;
#### INIT - load input data into array
my $testing = 0;
my @input;
my $file = $testing ? 'test.txt' : 'input.txt';
{
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }
}
### CODE
my @nodes;
for my $line (@input) {
if ($line =~ m|node\-(x\d+\-y\d+)\s+(\d+)T\s+(\d+)T\s+(\d+)T\s+(\d+)\%$| )
{
my ( $id, $size, $used, $avail, $pct ) = ( $1, $2, $3, $4, $5 );
my ( $x, $y ) = $id =~ m/^x(\d+)\-y(\d+)$/;
push @nodes,
{ id => $id,
x => $x,
y => $y,
size => $size,
used => $used,
avail => $avail,
pct => $pct };
}
}
my @pairs;
for my $node1 (@nodes) {
for my $node2 (@nodes) {
next if ( $node1->{id} eq $node2->{id} );
next if ( $node1->{used} == 0 );
if ( $node1->{used} <= $node2->{avail} ) {
push @pairs, [ $node1, $node2 ];
}
}
}
say scalar @pairs;
37 lines [ Plain text ] [ ^Top ]
#!/usr/bin/perl
use 5.016; # implies strict, provides 'say'
use warnings;
use autodie;
#### INIT - load input data into array
my $testing = 0;
my @input;
my $file = $testing ? 'test.txt' : 'input.txt';
{
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }
}
### CODE
my $debug = 0;
my $nodes;
my ( $max_x, $max_y ) = ( 0, 0 );
for my $line (@input) {
if ($line =~ m|node\-(x\d+\-y\d+)\s+(\d+)T\s+(\d+)T\s+(\d+)T\s+(\d+)\%$| )
{
my ( $id, $size, $used, $avail, $pct ) = ( $1, $2, $3, $4, $5 );
my ( $x, $y ) = $id =~ m/^x(\d+)\-y(\d+)$/;
if ( $x > $max_x ) { $max_x = $x }
if ( $y > $max_y ) { $max_y = $y }
$nodes->{$y}->{$x} = { id => $id,
size => $size,
used => $used,
avail => $avail,
pct => $pct };
}
}
say "max_x $max_x max_y $max_y";
for my $x ( 0 .. $max_x ) {
$nodes->{-1}->{$x} = { size => 10000 };
$nodes->{ $max_y + 1 }->{$x} = { size => 10000 };
}
for my $y ( 0 .. $max_y ) {
$nodes->{$y}->{-1} = { size => 10000 };
$nodes->{$y}->{ $max_x + 1 } = { size => 10000 };
}
my $start;
# print the grid!
for my $y ( sort { $a <=> $b } keys %{$nodes} ) {
next unless ( $y >= 0 and $y <= $max_y );
for my $x ( sort { $a <=> $b } keys %{ $nodes->{$y} } ) {
next unless ( $x >= 0 and $x <= $max_x );
if ($debug) {
printf( "%3d/%3d ",
map { $nodes->{$y}->{$x}->{$_} } qw/used size/ );
} else {
if ( $x == 0 and $y == 0 ) { print 'O'; next; }
if ( $x == $max_x and $y == 0 ) { print 'G'; next; }
if ( $nodes->{$y}->{$x}->{used} == 0 ) {
$start->{x} = $x;
$start->{y} = $y;
print '_';
next;
}
# can we transfer to neighbor?
# if not, it's a "wall"
my $up = $nodes->{ $y - 1 }->{$x}->{size};
my $down = $nodes->{ $y + 1 }->{$x}->{size};
my $left = $nodes->{$y}->{ $x - 1 }->{size};
my $right = $nodes->{$y}->{ $x + 1 }->{size};
my $used = $nodes->{$y}->{$x}->{used};
if ( $used > $up
or $used > $down
or $used > $left
or $used > $right )
{
print '#';
next;
} else {
print '.';
}
}
}
print "\n";
}
printf( "Start: x=%d y=%d\n", $start->{x}, $start->{y} );
# Solution strategy:
# https://www.reddit.com/r/adventofcode/comments/5jor9q/2016_day_22_solutions/dbhvzaw/
# move empty to 0,0: moves = start_x + start_y
# move empty to x_max,0: moves += x_max
# each move of goal data one step left is 5 moves,
# as the empty "cycles around":
# moves += (x_max - 1)*5
say "Part 2: ", $start->{x} + $start->{y} + $max_x + ( $max_x - 1 ) * 5;
76 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#!/usr/bin/perl
use 5.016; # implies strict, provides 'say'
use warnings;
use autodie;
#### INIT - load input data into array
my $testing = 0;
my $part = 2;
my @input;
my $file = $testing ? 'test.txt' : 'input.txt';
{
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }
}
### CODE
my $debug = 0;
my %reg = map { $_ => 0 } qw(a b c d);
$reg{a} = $part == 2 ? 12 : 7;
my @instr;
while (@input) {
my ( $cmd, $arg1, $arg2 );
my $line = shift @input;
if ( $line =~ m/^(inc|dec) (.)$/ ) { push @instr, [ $1, $2, undef ] }
elsif ( $line =~ /^cpy (\S+) (\S+)$/ ) { push @instr, [ 'cpy', $1, $2 ] }
elsif ( $line =~ /^jnz (\S+) (-?\d+)$/ ) {
push @instr, [ 'jnz', $1, $2 ];
} elsif ( $line =~ /^jnz (\d+) (\S+)$/ ) {
push @instr, [ 'jnz', $1, $2 ];
} elsif ( $line =~ /^tgl (\S+)$/ ) {
push @instr, [ 'tgl', $1, undef ];
} else {
die "cannot parse $line";
}
}
my %freq;
sub dump_state {
my ( $count, $pos, $cmd, $a1, $a2 ) = @_;
printf( "%d cmd=[%s %s %s] => reg:[%d %d %d %d] next=%d\n",
$count, $cmd, $a1,
$a2 ? $a2 : '_',
( map { $reg{$_} } qw/a b c d/ ), $pos );
$freq{$pos}++;
}
my $pos = 0;
my $count = 0;
while ( $pos >= 0 and $pos <= $#instr ) {
my ( $cmd, $a1, $a2 ) = @{ $instr[$pos] };
$count++;
warn "==> $count" if ( $debug and $count % 10_000 == 0 );
if ( $cmd eq 'inc' ) {
$reg{$a1} += 1;
$pos++;
dump_state( $count, $pos, $cmd, $a1, $a2 ) if $debug;
} elsif ( $cmd eq 'dec' ) {
$reg{$a1} -= 1;
$pos++;
dump_state( $count, $pos, $cmd, $a1, $a2 ) if $debug;
} elsif ( $cmd eq 'cpy' ) {
# can either copy integer or content of other register
if ( $a1 =~ /\d+/ ) { $reg{$a2} = $a1 }
else { $reg{$a2} = $reg{$a1} }
$pos++;
dump_state( $count, $pos, $cmd, $a1, $a2 ) if $debug;
} elsif ( $cmd eq 'jnz' ) {
my $compare;
if ( $a1 =~ /\d+/ ) { $compare = $a1 }
else { $compare = $reg{$a1} }
my $jump;
if ( $a2 =~ /\d+/ ) { $jump = $a2 }
else { $jump = $reg{$a2} }
if ( $compare != 0 ) {
$pos = $pos + $jump;
} else {
$pos++;
}
dump_state( $count, $pos, $cmd, $a1, $a2 ) if $debug;
} elsif ( $cmd eq 'tgl' ) {
my $newpos;
if ( $a1 =~ /\d+/ ) { $newpos = $pos + $a1 }
elsif ( $a1 =~ /[a-d]/ ) {
$newpos = $pos + $reg{$a1};
}
if ( $newpos < 0 or $newpos > $#instr ) {
# NOP
} elsif ( $newpos == $pos ) {
$pos++;
} else {
# do the toggle!
if ( !defined( $instr[$newpos]->[2] ) ) {
if ( $instr[$newpos]->[0] eq 'inc' ) {
$instr[$newpos]->[0] = 'dec';
} else {
$instr[$newpos]->[0] = 'inc';
}
} elsif ( defined( $instr[$newpos]->[2] ) ) {
if ( $instr[$newpos]->[0] eq 'jnz' ) {
$instr[$newpos]->[0] = 'cpy';
} else {
$instr[$newpos]->[0] = 'jnz';
}
}
}
$pos++;
dump_state( $count, $pos, $cmd, $a1, $a2 ) if $debug;
}
}
say $reg{a};
if ($debug) {
for my $p ( sort { $a <=> $b } keys %freq ) {
say "$p: $freq{$p}";
}
}
108 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#!/usr/bin/perl
use 5.016; # implies strict, provides 'say'
use warnings;
use autodie;
use Algorithm::Combinatorics qw(permutations);
#### INIT - load input data into array
my $testing = 0;
my $part2 = shift || 0;
my @input;
my $file = $testing ? 'test.txt' : 'input.txt';
{
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }
}
### CODE
my $maze;
my $targets;
sub find_shortest_path {
my ( $start, $end ) = @_;
my $seen;
my $shortest = 0;
my @states = ( [ 0, $start ] );
LOOP: {
while (@states) {
my $move = shift @states;
my $step = $move->[0];
my ( $r, $c ) = @{ $move->[1] };
if ( exists $seen->{$r}->{$c} ) {
next;
} else {
$seen->{$r}->{$c}++;
}
# try to move
$step += 1;
my @new = ( [ $r - 1, $c ],
[ $r + 1, $c ],
[ $r, $c - 1 ],
[ $r, $c + 1 ] );
while (@new) {
my $try = shift @new;
my ( $t_r, $t_c ) = @{$try};
if ( $maze->[$t_r]->[$t_c] ne '#' ) {
if ( $t_r == $end->[0] and $t_c == $end->[1] ) {
$shortest = $step;
last LOOP;
}
push @states, [ $step, $try ];
}
}
}
}
return $shortest;
}
# load the maze
my $row = 0;
for my $line (@input) {
my $col = 0;
for my $cell ( split( //, $line ) ) {
if ( $cell =~ /\d/ ) {
$targets->{$cell} = [ $row, $col ];
}
$maze->[$row]->[$col] = $cell;
$col++;
}
$row++;
}
# calculate distances using BFS
my $map;
for my $k ( sort keys %{$targets} ) {
for my $j ( sort keys %{$targets} ) {
next if $k == $j;
$map->{$k}->{$j}
= find_shortest_path( $targets->{$k}, $targets->{$j} );
}
}
my @distances;
# always start at 0, so remove that for now
delete $targets->{0};
my $iter = permutations( [ keys %{$targets} ] );
while ( my $p = $iter->next ) {
unshift @$p, '0';
push @$p, '0' if $part2;
my $dist = 0;
for ( my $i = 0 ; $i < $#$p ; $i++ ) {
my $j = $i + 1;
$dist += $map->{ $p->[$i] }->{ $p->[$j] };
}
say "$dist: ", join( '-', @$p );
}
83 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#!/usr/bin/perl
use 5.016; # implies strict, provides 'say'
use warnings;
use autodie;
#### INIT - load input data into array
my $testing = 0;
my @input;
my $file = $testing ? 'test.txt' : 'input.txt';
{
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }
}
### CODE
my $debug = 0;
my %reg = map { $_ => 0 } qw(a b c d);
my @instr;
while (@input) {
my ( $cmd, $arg1, $arg2 );
my $line = shift @input;
if ( $line =~ m/^(inc|dec) (.)$/ ) { push @instr, [ $1, $2, undef ] }
elsif ( $line =~ /^cpy (\S+) (\S+)$/ ) { push @instr, [ 'cpy', $1, $2 ] }
elsif ( $line =~ /^jnz (\S+) (-?\d+)$/ ) {
push @instr, [ 'jnz', $1, $2 ];
} elsif ( $line =~ /^jnz (\d+) (\S+)$/ ) {
push @instr, [ 'jnz', $1, $2 ];
} elsif ( $line =~ /^tgl (\S+)$/ ) {
push @instr, [ 'tgl', $1, undef ];
} elsif ( $line =~ /^out (\S+)$/ ) {
push @instr, [ 'out', $1, undef ];
} else {
die "cannot parse $line";
}
}
my $in = 0;
LOOP: {
for $in ( 0 .. 1000 ) {
$reg{a} = $in;
my $pos = 0;
my $count = 0;
my @output = ();
warn "==> $in" if ( $debug and $in % 100 == 0 );
while ( $pos >= 0 and $pos <= $#instr and scalar @output < 20 ) {
my ( $cmd, $a1, $a2 ) = @{ $instr[$pos] };
$count++;
warn "==> $count" if ( $debug and $count % 10_000 == 0 );
if ( $cmd eq 'inc' ) {
$reg{$a1} += 1;
$pos++;
} elsif ( $cmd eq 'dec' ) {
$reg{$a1} -= 1;
$pos++;
} elsif ( $cmd eq 'cpy' ) {
# can either copy integer or content of other register
if ( $a1 =~ /\d+/ ) { $reg{$a2} = $a1 }
else { $reg{$a2} = $reg{$a1} }
$pos++;
} elsif ( $cmd eq 'jnz' ) {
my $compare;
if ( $a1 =~ /\d+/ ) { $compare = $a1 }
else { $compare = $reg{$a1} }
my $jump;
if ( $a2 =~ /\d+/ ) { $jump = $a2 }
else { $jump = $reg{$a2} }
if ( $compare != 0 ) {
$pos = $pos + $jump;
} else {
$pos++;
}
} elsif ( $cmd eq 'tgl' ) {
my $newpos;
if ( $a1 =~ /\d+/ ) { $newpos = $pos + $a1 }
elsif ( $a1 =~ /[a-d]/ ) {
$newpos = $pos + $reg{$a1};
}
if ( $newpos < 0 or $newpos > $#instr ) {
# NOP
} elsif ( $newpos == $pos ) {
$pos++;
} else {
# do the toggle!
if ( !defined( $instr[$newpos]->[2] ) ) {
if ( $instr[$newpos]->[0] eq 'inc' ) {
$instr[$newpos]->[0] = 'dec';
} else {
$instr[$newpos]->[0] = 'inc';
}
} elsif ( defined( $instr[$newpos]->[2] ) ) {
if ( $instr[$newpos]->[0] eq 'jnz' ) {
$instr[$newpos]->[0] = 'cpy';
} else {
$instr[$newpos]->[0] = 'jnz';
}
}
}
$pos++;
} elsif ( $cmd eq 'out' ) {
push @output, $reg{$a1};
$pos++;
}
}
if ( join( '', @output[ 0 .. 7 ] ) eq '01010101'
or join( '', @output[ 1 .. 8 ] ) eq '01010101' )
{
say "$in: ", join( ' ', @output );
last LOOP;
}
}
}
105 lines [ Plain text ] [ ^Top ]
Generated on Sun Dec 25 18:06:06 2016 UTC.