These 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/env perl
use Modern::Perl '2015';
# useful modules
use List::Util qw/sum/;
use Data::Dumper;
use POSIX qw/floor/;
#### INIT - load input data from file 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;
my $sum2;
while (@input) {
my $mass = shift @input;
my $fuel = floor( $mass / 3 ) - 2;
say "$mass $fuel" if $testing;
$sum += $fuel;
$sum2 += $fuel;
while ( $fuel >= 6 ) {
$fuel = floor( $fuel / 3 ) - 2;
say $fuel if $testing;
$sum2 += $fuel;
}
}
say "Part 1: $sum";
say "Part 2: $sum2";
25 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#! /usr/bin/env perl
use Modern::Perl '2015';
# useful modules
use List::Util qw/sum all/;
use Data::Dumper;
#### INIT - load input data from file into array
my $testing = 0;
use Test::Simple tests => 6;
my @input;
my $file = 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }
close $fh;
### CODE
my @state;
sub dump_state;
sub run;
my $halt = 99;
my %opcodes = (
1 => \&add,
2 => \&mult,
);
my @tests;
while () {
chomp;
push @tests, $_;
}
foreach my $line (@tests) {
# say $line;
my ( $input, $output ) = split / /, $line;
# say "$input $output";
@state = split( ',', $input );
run();
ok( join( ',', @state ) eq $output );
}
my @initial = split( /,/, $input[0] );
@state = @initial;
my $cur;
my ( $part1, $part2 );
my $target = 19690720;
LOOPS: foreach my $noun ( 0 .. 99 ) {
foreach my $verb ( 0 .. 99 ) {
@state = @initial;
$state[1] = $noun;
$state[2] = $verb;
run();
if ( $noun == 12 and $verb == 2 ) {
$part1 = $state[0];
say "Part 1: ", $part1;
}
if ( $state[0] == $target ) {
$part2 = 100 * $noun + $verb;
say "Part 2: ", $part2;
last LOOPS;
}
}
}
ok( $part1 == 5434663 );
ok( $part2 == 4559 );
### Subs
sub add {
my ( $i, $j ) = @_;
return $state[$i] + $state[$j];
}
sub mult {
my ( $i, $j ) = @_;
return $state[$i] * $state[$j];
}
sub dump_state {
say join( ',', @state );
}
sub run {
my $cur = 0;
while ( $state[$cur] != $halt ) {
my ( $op, $in1, $in2, $out ) =
@state[ $cur, $cur + 1, $cur + 2, $cur + 3 ];
last unless all { defined $_ } ( $in1, $in2, $out );
my $res;
die "unknown op: $state[$cur]" unless defined $opcodes{$op};
$res = $opcodes{$op}->( $in1, $in2 );
$state[$out] = $res;
$cur += 4;
}
}
__DATA__
1,0,0,0,99 2,0,0,0,99
2,3,0,3,99 2,3,0,6,99
2,4,4,5,99,0 2,4,4,5,99,9801
1,1,1,4,99,5,6,0,99 30,1,1,4,2,5,6,0,99
84 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#! /usr/bin/env perl
use Modern::Perl '2015';
# useful modules
use List::Util qw/sum/;
use Test::Simple tests => 2;
#### INIT - load input data from file 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 $grid;
sub manhattan_distance;
my %set_line = (
U => \&up,
D => \&down,
L => \&left,
R => \&right,
);
my $id = 1;
foreach my $line (@input) {
say "loading a line....";
my $cur = [ 0, 0, 0 ];
push @{ $grid->{0}->{0} }, { id => $id, $id=>0 };
my @list = split( /,/, $line );
my $prev = '';
while (@list) {
my $move = shift @list;
if ( $move =~ m/(U|D|L|R)(\d+)/ ) {
$cur = $set_line{$1}->( $id, $cur, $2 );
}
else {
die "can't parse move: $move";
}
}
$id++;
}
say "finding crossings...";
my @distances;
my @signals;
for my $x ( keys %$grid ) {
for my $y ( keys %{ $grid->{$x} } ) {
if ( ref $grid->{$x}->{$y} eq 'ARRAY'
and scalar @{ $grid->{$x}->{$y} } > 1 )
{
my %ids;
my $signal = 0;
foreach my $el ( @{ $grid->{$x}->{$y} } ) {
$ids{ $el->{id} }++;
$signal += sum( map { $el->{$_} ? $el->{$_} : 0 } ( 1, 2 ) );
}
if ( scalar keys %ids > 1 and ( $x != 0 and $y != 0 ) ) {
# part 1
push @distances, sum( map { abs($_) } ( $x, $y ) );
# part 2
push @signals, $signal;
}
}
}
}
my $part1 = ( sort { $a <=> $b } @distances )[0];
my $part2 = ( sort { $a <=> $b } @signals )[0];
ok( $part1 == 1626 );
ok( $part2 == 27330 );
say "Part 1: $part1";
say "Part 2: $part2";
### Subs
sub up {
my ( $id, $start, $steps ) = @_;
my ( $x_0, $y_0, $d_0 ) = @$start;
for ( my $y = 0 ; $y <= $steps ; $y++ ) {
push @{ $grid->{$x_0}->{ $y_0 + $y } }, { id => $id, $id => $d_0 + $y };
}
return [ $x_0, $y_0 + $steps, $d_0 + $steps ];
}
sub down {
my ( $id, $start, $steps ) = @_;
my ( $x_0, $y_0, $d_0 ) = @$start;
for ( my $y = 0 ; $y >= -$steps ; $y-- ) {
push @{ $grid->{$x_0}->{ $y_0 + $y } },
{ id => $id, $id => $d_0 + abs($y) };
}
return [ $x_0, $y_0 - $steps, $d_0 + $steps ];
}
sub left {
my ( $id, $start, $steps ) = @_;
my ( $x_0, $y_0, $d_0 ) = @$start;
for ( my $x = 0 ; $x >= -$steps ; $x-- ) {
push @{ $grid->{ $x_0 + $x }->{$y_0} },
{ id => $id, $id => $d_0 + abs($x) };
}
return [ $x_0 - $steps, $y_0, $d_0 + $steps ];
}
sub right {
my ( $id, $start, $steps ) = @_;
my ( $x_0, $y_0, $d_0 ) = @$start;
for ( my $x = 0 ; $x <= $steps ; $x++ ) {
push @{ $grid->{ $x_0 + $x }->{$y_0} }, { id => $id, $id => $d_0 + $x };
}
return [ $start->[0] + $steps, $start->[1], $d_0 + $steps ];
}
97 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#! /usr/bin/env perl
use Modern::Perl '2015';
# useful modules
use List::Util qw/sum all any none/;
use Test::Simple tests => 2;
my $testing = 0;
### CODE
# problem input
my @limits = ( 245182, 790572 );
if ($testing) { $limits[1] = 300000 }
my $part1;
my $part2;
for my $N ( $limits[0] .. $limits[1] ) {
my @digits = split( //, $N );
# increasing?
my $inc = all { $digits[$_] <= $digits[ $_ + 1 ] } ( 0 .. 4 );
# duplicated digits?
my $dbl = any { $digits[$_] == $digits[ $_ + 1 ] } ( 0 .. 4 );
next unless ( $inc && $dbl );
$part1++;
my %hist;
for my $d (@digits) { $hist{$d}++ }
# discard any solutions where there are only groups of 3 or more,
# and no separate doubles
next if ( any { $_ > 2 } values %hist and none { $_ == 2 } values %hist );
$part2++;
}
ok( $part1 == 1099 );
ok( $part2 == 710 );
say "Part 1: $part1";
say "Part 2: $part2";
27 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#! /usr/bin/env perl
use Modern::Perl '2015';
# useful modules
use List::Util qw/sum/;
use Data::Dumper;
use Test::Simple tests => 1;
#### INIT - load input data from file into array
my $testing = 0;
my $debug = 0;
my @file_contents;
my $file = $testing ? 'test.txt' : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @file_contents, $_; }
### CODE
my $halt = 99;
my $part2 = shift || 0;
my $initial_val = $part2 ? 5 : 1;
my $program = [ split( ',', $file_contents[0] ) ];
#dump_state($program);
my ( $out_state, $out ) = run_vm( $program, [$initial_val] );
my $ans = $out->[-1];
if ($part2) {
ok( $ans == 7616021 );
}
else {
ok( $ans == 15259545 );
}
say $part2? "Part 2: " : "Part 1: ", $ans;
### SUBS
sub run_vm {
my ( $state, $in_val ) = @_;
# my @state = @{$program};
my @input = @{$in_val};
my $ptr = 0;
my $out_val;
while ( $state->[$ptr] != $halt ) {
my ( $op, $a1, $a2, $a3 ) =
@$state[ $ptr, $ptr + 1, $ptr + 2, $ptr + 3 ];
say join( ' ', $ptr, $op, $a1, $a2, $a3 ) if $debug;
my $mask;
if ( length $op > 2 )
{ # assume values in this position are either 2 digits or more
my @instr = split( //, $op );
my @tail;
for ( 1, 2 ) {
unshift @tail, pop @instr;
}
$op = join( '', @tail ) + 0;
while ( scalar @instr < 3 ) {
unshift @instr, 0;
}
$mask = [ reverse @instr ];
}
else {
$mask = [ 0, 0, 0 ];
}
my %ops = (
1 => sub { $state->[ $_[2] ] = $_[0] + $_[1]; $ptr += 4 },
2 => sub { $state->[ $_[2] ] = $_[0] * $_[1]; $ptr += 4 },
4 => sub { push @{$out_val}, $_[0]; $ptr += 2 },
5 => sub {
if ( $_[0] != 0 ) { $ptr = $_[1]; }
else { $ptr += 3; }
},
6 => sub {
if ( $_[0] == 0 ) { $ptr = $_[1]; }
else { $ptr += 3; }
},
7 => sub {
if ( $_[0] < $_[1] ) { $state->[ $_[2] ] = 1; }
else { $state->[ $_[2] ] = 0; }
$ptr += 4;
},
8 => sub {
if ( $_[0] == $_[1] ) {
$state->[ $_[2] ] = 1;
}
else {
$state->[ $_[2] ] = 0;
}
$ptr += 4;
},
);
if ( $op == 3 ) {
$state->[$a1] = shift @$in_val;
$ptr += 2;
}
else {
$a1 = $mask->[0] ? $a1 : $state->[$a1];
$a2 = $mask->[1] ? $a2 : $state->[$a2];
$ops{$op}->( $a1, $a2, $a3 );
}
}
return ( $state, $out_val );
}
sub dump_state { # shows a pretty-printed grid of the current state
my @show = split( ',', $_[0] );
print ' ';
for my $i ( 0 .. 9 ) { printf( "___%d ", $i ) }
print "\n";
my $full_rows = int( scalar @show / 10 );
my $r;
for $r ( 0 .. $full_rows - 1 ) {
printf "%2d|", $r;
for my $c ( 0 .. 9 ) {
my $el = shift @show;
printf "%4d ", $el;
}
print "\n";
}
printf "%2d|", $full_rows;
while (@show) {
my $el = shift @show;
printf "%4d ", $el;
}
print "\n";
}
111 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#! /usr/bin/env perl
use Modern::Perl '2015';
# useful modules
use List::Util qw/sum/;
use Data::Dumper;
use Test::Simple tests => 2;
#### INIT - load input data from file 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 %orbits;
while (@input) {
my ( $p, $s ) = split( /\)/, shift @input );
$orbits{$s} = $p;
}
my $count = 0;
foreach my $s ( keys %orbits ) {
count_orbits($s);
}
ok( $count == 314702 );
say "Part 1: $count";
# credit: rtbrsp
# https://www.reddit.com/r/adventofcode/comments/e6tyva/2019_day_6_solutions/f9tb2gi/
my %path;
my $S;
my $Y;
my $s;
for ( $s = 'SAN' ; $s ne 'COM' ; $s = $orbits{$s} ) {
$path{ $orbits{$s} } = $S++;
}
for ( $s = 'YOU' ; !$path{ $orbits{$s} } ; $s = $orbits{$s} ) {
$Y++;
}
$Y += $path{ $orbits{$s} };
ok( $Y == 439 );
say "Part 2: $Y";
# credit: /u/domm_plix
# https://www.reddit.com/r/adventofcode/comments/e6tyva/2019_day_6_solutions/f9tr612/
sub count_orbits {
no warnings 'recursion';
my ($in) = @_;
return unless exists $orbits{$in};
$count++;
count_orbits( $orbits{$in} );
}
40 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#! /usr/bin/env perl
use Modern::Perl '2015';
# useful modules
use List::Util qw/sum/;
use Data::Dumper;
use Test::Simple tests=>1;
#### INIT - load input data from file into array
my $testing = 0;
my $debug = 0;
my @file_contents;
my $file = $testing ? 'test.txt' : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @file_contents, $_; }
### CODE
# generate list of starting phase settings
my @program = split(',',$file_contents[0]);
my @list_of_phases;
my @range= (0..4);
for my $a (@range) {
for my $b (@range) {
for my $c (@range) {
for my $d (@range) {
for my $e (@range) {
my %seen = map {$_ => 1} ($a,$b,$c,$d,$e);
next unless scalar %seen == 5;
push @list_of_phases,[$a,$b,$c,$d,$e];
}
}
}
}
}
my $ptr;
my $halt = 99;
my $max = {val=>0, phase => '' };
foreach my $phase(@list_of_phases) {
my @inputs= (0);
for my $register (0..4) {
my $input = $inputs[-1];
my $p = $phase->[$register];
my ( $out_state, $out_val) = run_vm(\@program, [$p,$input]);
say "$register ", join(',',@$out_val) if $debug;
push @inputs, $out_val->[-1];
}
if ($inputs[-1] > $max->{val}) {
$max->{val} = $inputs[-1];
$max->{phase} =join ('', @$phase);
}
# say "Phase: ",join ('', @$phase), " gives $inputs[-1]";
}
ok( $max->{val} == 116680 );
say "Part 1: $max->{val}";
### Subs
sub run_vm {
my ( $state, $in_val ) = @_;
# my @state = @{$program};
my @input = @{$in_val};
my $ptr = 0;
my $out_val;
while ( $state->[$ptr] != $halt ) {
my ( $op, $a1, $a2, $a3 ) =
@$state[ $ptr, $ptr + 1, $ptr + 2, $ptr + 3 ];
# say join( ' ', $ptr, $op, $a1, $a2, $a3 ) if $debug;
my $mask;
if ( length $op > 2 )
{ # assume values in this position are either 2 digits or more
my @instr = split( //, $op );
my @tail;
for ( 1, 2 ) {
unshift @tail, pop @instr;
}
$op = join( '', @tail ) + 0;
while ( scalar @instr < 3 ) {
unshift @instr, 0;
}
$mask = [ reverse @instr ];
}
else {
$mask = [ 0, 0, 0 ];
}
my %ops = (
1 => sub { $state->[ $_[2] ] = $_[0] + $_[1]; $ptr += 4 },
2 => sub { $state->[ $_[2] ] = $_[0] * $_[1]; $ptr += 4 },
4 => sub { push @{$out_val}, $_[0]; $ptr += 2 },
5 => sub {
if ( $_[0] != 0 ) { $ptr = $_[1]; }
else { $ptr += 3; }
},
6 => sub {
if ( $_[0] == 0 ) { $ptr = $_[1]; }
else { $ptr += 3; }
},
7 => sub {
if ( $_[0] < $_[1] ) { $state->[ $_[2] ] = 1; }
else { $state->[ $_[2] ] = 0; }
$ptr += 4;
},
8 => sub {
if ( $_[0] == $_[1] ) {
$state->[ $_[2] ] = 1;
}
else {
$state->[ $_[2] ] = 0;
}
$ptr += 4;
},
);
if ( $op == 3 ) {
$state->[$a1] = shift @$in_val;
$ptr += 2;
}
else {
$a1 = $mask->[0] ? $a1 : $state->[$a1];
$a2 = $mask->[1] ? $a2 : $state->[$a2];
$ops{$op}->( $a1, $a2, $a3 );
}
}
return ( $state, $out_val );
}
sub dump_state { # shows a pretty-printed grid of the current state
my @show = split( ',', $_[0] );
print ' ';
for my $i ( 0 .. 9 ) { printf( "___%d ", $i ) }
print "\n";
my $full_rows = int( scalar @show / 10 );
my $r;
for $r ( 0 .. $full_rows - 1 ) {
printf "%2d|", $r;
for my $c ( 0 .. 9 ) {
my $el = shift @show;
printf "%4d ", $el;
}
print "\n";
}
printf "%2d|", $full_rows;
while (@show) {
my $el = shift @show;
printf "%4d ", $el;
}
print "\n";
}
132 lines [ Plain text ] [ ^Top ]
#! /usr/bin/env perl
use Modern::Perl '2015';
# useful modules
use List::Util qw/sum/;
use Data::Dumper;
use Test::Simple tests => 1;
#### INIT - load input data from file into array
my $testing = 0;
my $debug = 0;
my @file_contents;
my $file = $testing ? 'test.txt' : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @file_contents, $_; }
### CODE
# generate list of starting phase settings
my @program = split( ',', $file_contents[0] );
my @list_of_phases;
my @range = ( 5 .. 9 );
for my $a (@range) {
for my $b (@range) {
for my $c (@range) {
for my $d (@range) {
for my $e (@range) {
my %seen = map { $_ => 1 } ( $a, $b, $c, $d, $e );
next unless scalar %seen == 5;
push @list_of_phases, [ $a, $b, $c, $d, $e ];
}
}
}
}
}
my $halt = 99;
my $max = { val => 0, phase => '' };
foreach my $phases (@list_of_phases) {
my $amp_states;
for ( 0 .. 4 ) { push @$amp_states, { state => \@program, ptr => 0 } }
my $loop_cnt = 0;
my $amp = 0;
my $prev = [0];
my $ptr;
my $state;
my @last_amp_res;
do {
for my $amp ( 0 .. 4 ) {
# only add the current phase in the very first pass
my $in_val =
$loop_cnt == 0 ? [ $phases->[$amp], $prev->[0] ] : [ $prev->[0] ];
( $prev, $ptr, $state ) = run_vm(
$in_val,
$amp_states->[$amp]->{ptr},
$amp_states->[$amp]->{state}
);
$amp_states->[$amp]->{ptr} = $ptr;
$amp_states->[$amp]->{state} = $state;
push @last_amp_res, $prev->[0] if $amp == 4 and defined $prev->[0];
}
$loop_cnt++;
} while ( scalar @$prev > 0 );
if ( $last_amp_res[-1] > $max->{val} ) {
$max = {
val => $last_amp_res[-1],
phase => join '',
@$phases
};
}
}
ok( $max->{val} == 89603079 );
say "Part 2: ", $max->{val};
### Subs
sub run_vm {
my ( $in_val, $start_ptr, $state ) = @_;
my @input = @{$in_val};
my $ptr = $start_ptr;
my $out_val = [];
LOOP: while ( $state->[$ptr] != $halt ) {
my ( $op, $a1, $a2, $a3 ) =
@$state[ $ptr, $ptr + 1, $ptr + 2, $ptr + 3 ];
my $mask;
if ( length $op > 2 )
{ # assume values in this position are either 2 digits or more
my @instr = split( //, $op );
my @tail;
for ( 1, 2 ) {
unshift @tail, pop @instr;
}
$op = join( '', @tail ) + 0;
while ( scalar @instr < 3 ) {
unshift @instr, 0;
}
$mask = [ reverse @instr ];
}
else {
$mask = [ 0, 0, 0 ];
}
my %ops = (
1 => sub { $state->[ $_[2] ] = $_[0] + $_[1]; $ptr += 4 },
2 => sub { $state->[ $_[2] ] = $_[0] * $_[1]; $ptr += 4 },
4 => sub { push @{$out_val}, $_[0]; $ptr += 2 },
5 => sub {
if ( $_[0] != 0 ) { $ptr = $_[1]; }
else { $ptr += 3; }
},
6 => sub {
if ( $_[0] == 0 ) { $ptr = $_[1]; }
else { $ptr += 3; }
},
7 => sub {
if ( $_[0] < $_[1] ) { $state->[ $_[2] ] = 1; }
else { $state->[ $_[2] ] = 0; }
$ptr += 4;
},
8 => sub {
if ( $_[0] == $_[1] ) {
$state->[ $_[2] ] = 1;
}
else {
$state->[ $_[2] ] = 0;
}
$ptr += 4;
},
);
dump_state($state) if $debug;
if ( $op == 3 ) {
my $in = shift @$in_val;
if ( !defined $in ) {
last LOOP;
}
$state->[$a1] = $in;
$ptr += 2;
}
else {
$a1 = $mask->[0] ? $a1 : $state->[$a1];
$a2 = $mask->[1] ? $a2 : $state->[$a2];
$ops{$op}->( $a1, $a2, $a3 );
}
}
return ( $out_val, $ptr, $state );
}
sub dump_state { # shows a pretty-printed grid of the current state
my ($in) = @_;
my @show = @{$in};
print ' ';
for my $i ( 0 .. 9 ) { printf( "___%d ", $i ) }
print "\n";
my $full_rows = int( scalar @show / 10 );
my $r;
for $r ( 0 .. $full_rows - 1 ) {
printf "%2d|", $r;
for my $c ( 0 .. 9 ) {
my $el = shift @show;
printf "%4d ", $el;
}
print "\n";
}
printf "%2d|", $full_rows;
while (@show) {
my $el = shift @show;
printf "%4d ", $el;
}
print "\n";
}
155 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#! /usr/bin/env perl
use Modern::Perl '2015';
# useful modules
use List::Util qw/sum/;
use Data::Dumper;
use Test::Simple tests => 2;
#### INIT - load input data from file into array
my $testing = 0;
my $debug = 0;
my @file_contents;
my $file = $testing ? 'test.txt' : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @file_contents, $_; }
### CODE
my @input = split( //, $file_contents[0] );
my $height = 6;
my $width = 25;
my $layers;
my ( $product, $min ) = ( undef, 10_000 );
while (@input) {
my $count = 0;
my $layer;
my %freq;
while ( $count < $height * $width ) {
my $d = shift @input;
push @$layer, $d;
$freq{$d}++;
$count++;
}
if ($freq{0} < $min) {
$min = $freq{0};
$product = $freq{1} * $freq{2};
}
push @$layers, $layer;
}
say "Part 1: ",$product;
say "Part 2:";
my $image;
foreach my $row ( 0 .. $height - 1 ) {
foreach my $col ( 0 .. $width - 1 ) {
my $current_idx = $row * $width + $col;
foreach my $layer (@$layers) {
my $char = $layer->[$current_idx];
if ( $char != 2 ) {
print $char == 0 ? ' ' : '█';
$image .= $char;
last;
}
}
}
print "\n";
}
ok ( $product == 1950 );
ok ( $image eq '111101001001100100101000010000101001001010010100001110011000100101111010000100001010011110100101000010000101001001010010100001000010010100101001011110');
50 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#! /usr/bin/env perl
use Modern::Perl '2015';
# useful modules
use List::Util qw/sum/;
use Data::Dumper;
use Test::More tests => 2;
#### INIT - load input data from file into array
my $debug = 0;
my @file_contents;
my $file = 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @file_contents, $_; }
### CODE
my $program = [ split( /,/, $file_contents[0] ) ];
my @ans = ( 3512778005, 35920 );
for my $part ( 1, 2 ) {
my $initial = [$part];
my $res = run_vm(
{ state => [@$program], positions => [ 0, 0 ], input_ary => $initial }
);
say "Part $part: ", $res->{output_ary}->[0];
is( $res->{output_ary}->[0], $ans[ $part - 1 ] );
}
### SUBS
sub run_vm {
my ($params) = @_;
my $input_ary = $params->{input_ary};
my ( $ptr, $offset ) = @{ $params->{positions} };
my $state = $params->{state};
my $output_ary = [];
### keep our opcodes here, called later from a dispatch table;
my $add = sub {
say "1 [add] => add $_[0] to $_[1], store in position $_[2]" if $debug;
$state->[ $_[2] ] = $_[0] + $_[1];
$ptr += 4;
};
my $multiply = sub {
say "2 [multiply] => multiply $_[0] with $_[1], store in position $_[2]"
if $debug;
$state->[ $_[2] ] = $_[0] * $_[1];
$ptr += 4;
};
my $write = sub {
say "4 [write] => push $_[0] to output array" if $debug;
push @{$output_ary}, $_[0];
$ptr += 2;
};
my $jump_if_true = sub {
say "5 [jump-if-true] => checking $_[0] for truth: ",
$_[0] != 0
? " it is true, set pointer to $_[1]"
: " it is false, skip instruction"
if $debug;
if ( $_[0] != 0 ) { $ptr = $_[1]; }
else { $ptr += 3; }
};
my $jump_if_false = sub {
say "6 [jump-if-false] => compare $_[0] to 0: ",
$_[0] == 0
? " it is 0, set pointer to $_[1] "
: " skip to next instruction"
if $debug;
if ( $_[0] == 0 ) { $ptr = $_[1]; }
else { $ptr += 3; }
};
my $less_than = sub {
say "7 [less-than] => compare $_[0] to $_[1]: ",
$_[0] < $_[1]
? " it is less, set position $_[2] to 1 "
: " it is not less, set position $_[2] to 0"
if $debug;
if ( $_[0] < $_[1] ) { $state->[ $_[2] ] = 1; }
else { $state->[ $_[2] ] = 0; }
$ptr += 4;
};
my $equals = sub {
say "8 [equals] => compare $_[0] to $_[1]: ",
$_[0] == $_[1]
? " they are equal, set position $_[2] to 1 "
: " they differ, set position $_[2] to 0"
if $debug;
if ( $_[0] == $_[1] ) {
$state->[ $_[2] ] = 1;
}
else {
$state->[ $_[2] ] = 0;
}
$ptr += 4;
};
my $adjust_offset = sub {
say "9 [adjust-offset] => modify offset by $_[0]" if $debug;
$offset = $offset + $_[0];
$ptr += 2;
};
my $loop_counter = 0;
LOOP: while ( $state->[$ptr] != 99 ) {
my ( $op, $a1, $a2, $a3 ) =
@$state[ $ptr, $ptr + 1, $ptr + 2, $ptr + 3 ];
my $raw = [ $op, $a1, $a2, $a3 ];
my $mask;
if ( length $op > 2 )
{ # assume values in this position are either 2 digits or more
my @instr = split( //, $op );
my @tail;
for ( 1, 2 ) {
unshift @tail, pop @instr;
}
$op = join( '', @tail ) + 0;
while ( scalar @instr < 3 ) {
unshift @instr, 0;
}
$mask = [ reverse @instr ];
}
else {
$mask = [ 0, 0, 0 ];
}
my %ops = (
1 => $add,
2 => $multiply,
4 => $write,
9 => $adjust_offset,
5 => $jump_if_true,
6 => $jump_if_false,
7 => $less_than,
8 => $equals,
);
if ($debug) {
my $addr = 1024;
# dump_state($state);
print "--------------------------------------------------\n";
say "Value at $addr: ", $state->[$addr] ? $state->[$addr] : 0;
say "Pass $loop_counter Position [$ptr, $offset] IN ["
. join( ',', @$input_ary )
. "] OUT ["
. join( ',', @$output_ary ) . ']';
print '['
. join( ',', @$raw ) . '] => '
. join( ' ', ( $op, $a1, $a2, $a3 ) );
print ' [' . join( ',', @$mask ) . "]\n";
}
# we keep this operand outside the dispatch table because it
# has control flow - if no input is received, it will pause
# the VM
if ( $op == 3 ) {
my $in = shift @$input_ary;
if ( !defined $in ) {
last LOOP;
}
if ( $mask->[0] == 2 ) {
$state->[ $a1 + $offset ] = $in;
}
else {
$state->[$a1] = $in;
}
$ptr += 2;
}
else {
# first operand handled by $mask->[0]
if ( $mask->[0] == 0 ) { # position mode
$a1 = $state->[$a1] ? $state->[$a1] : 0;
}
elsif ( $mask->[0] == 1 ) { # immediate mode
$a1 = $a1;
}
elsif ( $mask->[0] == 2 ) { # relative mode
$a1 = $state->[ $offset + $a1 ] ? $state->[ $offset + $a1 ] : 0;
}
else {
die "unknown mode: ", $mask->[0];
}
# second operand handled by $mask->[1]
if ( $mask->[1] == 0 ) { # position mode
$a2 = $state->[$a2] ? $state->[$a2] : 0;
}
elsif ( $mask->[1] == 1 ) { # immediate mode
$a2 = $a2;
}
elsif ( $mask->[1] == 2 ) { # relative mode
$a2 = $state->[ $offset + $a2 ] ? $state->[ $offset + $a2 ] : 0;
}
else {
die "unknown mode: ", $mask->[1];
}
# third operand
if ( $mask->[2] == 2 ) { #relative mode
$a3 = $offset + $a3;
}
$ops{$op}->( $a1, $a2, $a3 );
}
$loop_counter++;
}
return { output_ary => $output_ary, positions => [$ptr], state => $state };
}
sub dump_state { # shows a pretty-printed grid of the current state
my ($in) = @_;
my @show = @{$in};
print ' ';
for my $i ( 0 .. 9 ) { printf( "___%d ", $i ) }
print "\n";
my $full_rows = int( scalar @show / 10 );
my $r;
for $r ( 0 .. $full_rows - 1 ) {
printf "%2d|", $r;
for my $c ( 0 .. 9 ) {
my $el = shift @show;
printf "%4d ", $el ? $el : 0;
}
print "\n";
}
printf "%2d|", $full_rows;
while (@show) {
my $el = shift @show;
printf "%4d ", $el;
}
print "\n";
}
211 lines [ Plain text ] [ ^Top ]
#! /usr/bin/env perl
use Modern::Perl '2015';
# useful modules
use List::Util qw/sum/;
use Data::Dumper;
use Test::More;
#### INIT - load input data from file into array
my $debug = 0;
my @file_contents;
my $file = 'intcode_test_data.txt';
my $r = open( my $fh, '<', "$file" );
if (defined $r) {
while (<$fh>) { chomp; s/\r//gm; push @file_contents, $_; }
} else {
say "Can't find file $file, continuing with built-in tests."
}
while () {
chomp;
push @file_contents, $_;
}
### CODE
foreach my $line (@file_contents) {
my ( $label, $in_data, $expected, $program ) = split('\|',$line);
$program = [split(',',$program)];
$in_data = $in_data?[split(',',$in_data)]:[];
my $pos = [0,0];
my $res = run_vm({state=>[@$program],
positions=>$pos,
input_ary=>[@$in_data]});
if ($label eq "Day 5 part 1") {
is($res->{output_ary}->[-1],$expected,$label);
} else {
is(join(',',@{$res->{output_ary}}),$expected, $label);
}
}
done_testing();
sub run_vm {
my ($params) = @_;
my $input_ary = $params->{input_ary};
my ( $ptr, $offset ) = @{ $params->{positions} };
my $state = $params->{state};
my $output_ary = [];
### keep our opcodes here, called later from a dispatch table;
my $add = sub {
say "1 [add] => add $_[0] to $_[1], store in position $_[2]" if $debug;
$state->[ $_[2] ] = $_[0] + $_[1];
$ptr += 4;
};
my $multiply = sub {
say "2 [multiply] => multiply $_[0] with $_[1], store in position $_[2]"
if $debug;
$state->[ $_[2] ] = $_[0] * $_[1];
$ptr += 4;
};
my $write = sub {
say "4 [write] => push $_[0] to output array" if $debug;
push @{$output_ary}, $_[0];
$ptr += 2;
};
my $jump_if_true = sub {
say "5 [jump-if-true] => checking $_[0] for truth: ",
$_[0] != 0
? " it is true, set pointer to $_[1]"
: " it is false, skip instruction"
if $debug;
if ( $_[0] != 0 ) { $ptr = $_[1]; }
else { $ptr += 3; }
};
my $jump_if_false = sub {
say "6 [jump-if-false] => compare $_[0] to 0: ",
$_[0] == 0
? " it is 0, set pointer to $_[1] "
: " skip to next instruction"
if $debug;
if ( $_[0] == 0 ) { $ptr = $_[1]; }
else { $ptr += 3; }
};
my $less_than = sub {
say "7 [less-than] => compare $_[0] to $_[1]: ",
$_[0] < $_[1]
? " it is less, set position $_[2] to 1 "
: " it is not less, set position $_[2] to 0"
if $debug;
if ( $_[0] < $_[1] ) { $state->[ $_[2] ] = 1; }
else { $state->[ $_[2] ] = 0; }
$ptr += 4;
};
my $equals = sub {
say "8 [equals] => compare $_[0] to $_[1]: ",
$_[0] == $_[1]
? " they are equal, set position $_[2] to 1 "
: " they differ, set position $_[2] to 0"
if $debug;
if ( $_[0] == $_[1] ) {
$state->[ $_[2] ] = 1;
}
else {
$state->[ $_[2] ] = 0;
}
$ptr += 4;
};
my $adjust_offset = sub {
say "9 [adjust-offset] => modify offset by $_[0]" if $debug;
$offset = $offset + $_[0];
$ptr += 2;
};
my $loop_counter = 0;
LOOP: while ( $state->[$ptr] != 99 ) {
my ( $op, $a1, $a2, $a3 ) =
@$state[ $ptr, $ptr + 1, $ptr + 2, $ptr + 3 ];
my $raw = [ $op, $a1, $a2, $a3 ];
my $mask;
if ( length $op > 2 )
{ # assume values in this position are either 2 digits or more
my @instr = split( //, $op );
my @tail;
for ( 1, 2 ) {
unshift @tail, pop @instr;
}
$op = join( '', @tail ) + 0;
while ( scalar @instr < 3 ) {
unshift @instr, 0;
}
$mask = [ reverse @instr ];
}
else {
$mask = [ 0, 0, 0 ];
}
my %ops = (
1 => $add,
2 => $multiply,
4 => $write,
9 => $adjust_offset,
5 => $jump_if_true,
6 => $jump_if_false,
7 => $less_than,
8 => $equals,
);
if ($debug) {
my $addr = 1024;
# dump_state($state);
print "--------------------------------------------------\n";
say "Value at $addr: ", $state->[$addr] ? $state->[$addr] : 0;
say "Pass $loop_counter Position [$ptr, $offset] IN ["
. join( ',', @$input_ary )
. "] OUT ["
. join( ',', @$output_ary ) . ']';
print '['
. join( ',', @$raw ) . '] => '
. join( ' ', ( $op, $a1, $a2, $a3 ) );
print ' [' . join( ',', @$mask ) . "]\n";
}
# we keep this operand outside the dispatch table because it
# has control flow - if no input is received, it will pause
# the VM
if ( $op == 3 ) {
my $in = shift @$input_ary;
if ( !defined $in ) {
last LOOP;
}
if ( $mask->[0] == 2 ) {
$state->[ $a1 + $offset ] = $in;
}
else {
$state->[$a1] = $in;
}
$ptr += 2;
}
else {
# first operand handled by $mask->[0]
if ( $mask->[0] == 0 ) { # position mode
$a1 = $state->[$a1] ? $state->[$a1] : 0;
}
elsif ( $mask->[0] == 1 ) { # immediate mode
$a1 = $a1;
}
elsif ( $mask->[0] == 2 ) { # relative mode
$a1 = $state->[ $offset + $a1 ] ? $state->[ $offset + $a1 ] : 0;
}
else {
die "unknown mode: ", $mask->[0];
}
# second operand handled by $mask->[1]
if ( $mask->[1] == 0 ) { # position mode
$a2 = $state->[$a2] ? $state->[$a2] : 0;
}
elsif ( $mask->[1] == 1 ) { # immediate mode
$a2 = $a2;
}
elsif ( $mask->[1] == 2 ) { # relative mode
$a2 = $state->[ $offset + $a2 ] ? $state->[ $offset + $a2 ] : 0;
}
else {
die "unknown mode: ", $mask->[1];
}
# third operand
if ( $mask->[2] == 2 ) { #relative mode
$a3 = $offset + $a3;
}
$ops{$op}->( $a1, $a2, $a3 );
}
$loop_counter++;
}
return { output_ary => $output_ary, positions => [$ptr], state => $state };
}
sub dump_state { # shows a pretty-printed grid of the current state
my ($in) = @_;
my @show = @{$in};
print ' ';
for my $i ( 0 .. 9 ) { printf( "___%d ", $i ) }
print "\n";
my $full_rows = int( scalar @show / 10 );
my $r;
for $r ( 0 .. $full_rows - 1 ) {
printf "%2d|", $r;
for my $c ( 0 .. 9 ) {
my $el = shift @show;
printf "%4d ", $el ? $el : 0;
}
print "\n";
}
printf "%2d|", $full_rows;
while (@show) {
my $el = shift @show;
printf "%4d ", $el;
}
print "\n";
}
__END__
Day 9 example 1|''|109,1,204,-1,1001,100,1,100,1008,100,16,101,1006,101,0,99|109,1,204,-1,1001,100,1,100,1008,100,16,101,1006,101,0,99
Day 9 example 1|''|1219070632396864|1102,34915192,34915192,7,4,7,99,0
Day 9 example 3|''|1125899906842624|104,1125899906842624,99
Day 5 example <8|5|999|3,21,1008,21,8,20,1005,20,22,107,8,21,20,1006,20,31,1106,0,36,98,0,0,1002,21,125,20,4,20,1105,1,46,104,999,1105,1,46,1101,1000,1,20,4,20,1105,1,46,98,99
Day 5 example =8|8|1000|3,21,1008,21,8,20,1005,20,22,107,8,21,20,1006,20,31,1106,0,36,98,0,0,1002,21,125,20,4,20,1105,1,46,104,999,1105,1,46,1101,1000,1,20,4,20,1105,1,46,98,99
Day 5 example >8|13|1001|3,21,1008,21,8,20,1005,20,22,107,8,21,20,1006,20,31,1106,0,36,98,0,0,1002,21,125,20,4,20,1105,1,46,104,999,1105,1,46,1101,1000,1,20,4,20,1105,1,46,98,99
231 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#! /usr/bin/env perl
use Modern::Perl '2015';
# useful modules
use List::Util qw/sum any/;
use Data::Dumper;
use Test::More;
use Math::Trig;
#### INIT - load input data from file into array
my $testing = 0;
my $debug = 0;
my @files = ('input.txt');
my @correct = ( '292,20,20', 317 );
my $testnr = 0;
foreach my $file (@files) {
my @file_contents;
open( my $fh, '<', $file );
while (<$fh>) {
chomp;
s/\r//gm;
push @file_contents, $_;
}
close $fh;
my $y = 0;
my $x;
my $Map;
while (@file_contents) {
$x = 0;
foreach ( split( //, shift @file_contents ) ) {
if ( $_ eq '#' ) {
$Map->{$x}->{$y} = 1;
}
$x++;
}
$y++;
}
my $seen = find_occlusions($Map);
my @result;
foreach my $x ( keys %$seen ) {
foreach my $y ( keys %{ $seen->{$x} } ) {
push @result, [ scalar keys %{ $seen->{$x}->{$y} }, $x, $y ];
}
}
my $ans = ( sort { $b->[0] <=> $a->[0] } @result )[0];
is( join( ',', @$ans ), $correct[$testnr], "part 1 - test $testnr" );
printf( "Part 1: %d at (%d,%d)\n", @$ans );
my $part2;
$part2 = fire_laser( $seen, $ans );
is( $part2, $correct[ $testnr + 1 ], "part 2 - test $testnr" );
say "Part 2: ", $part2;
$testnr++;
}
done_testing;
sub fire_laser {
my ( $data, $center ) = @_;
shift @$center; # discard count
my %angles = %{ $data->{ $center->[0] }->{ $center->[1] } };
# re-sort for running
my @list;
my @tail;
for my $angle ( sort { $a <=> $b } keys %angles ) {
if ( $angle < -90 ) { # this value found by inspection
push @tail, $angle;
}
else {
push @list, $angle;
}
# reorder by distance
my @objects = sort {$a->[0] <=> $b->[0]} @{$angles{$angle}};
$angles{$angle} = [@objects];
}
my $ans;
my $count = 1;
foreach my $entry (@list,@tail) {
my $target = shift @{$angles{$entry}};
if ($count==200) {
$ans = $target->[1]*100 + $target->[2];
last;
}
$count++;
}
die "seems there's a flaw in the algorithm!" unless defined $ans;
return $ans;
}
sub find_occlusions {
my ($map) = @_;
my $result;
foreach my $i ( keys %$map ) {
foreach my $j ( keys %{ $map->{$i} } ) {
foreach my $x ( keys %$map ) {
foreach my $y ( keys %{ $map->{$x} } ) {
next if ( $x == $i and $y == $j ); # skip same point
# angle between (i,j) and (x,y)
my $key = sprintf(
"%.06f",
atan2( ( $y - $j ), ( $x - $i ) ) * 180 / pi
);
printf( "Angle between (%d,%d) and (%d,%d): %s\n",
$i, $j, $x, $y, $key )
if $debug;
my $cartesian = sqrt( ( $x - $i )**2 + ( $y - $j )**2 );
push @{ $result->{$i}->{$j}->{$key} },
[ $cartesian, $x, $y ];
}
}
}
}
return $result;
}
105 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#! /usr/bin/env perl
use Modern::Perl '2015';
# useful modules
use List::Util qw/sum/;
use Data::Dumper;
use Test::More;
#### INIT - load input data from file into array
my $testing = 0;
my $debug = 0;
my $part2 = shift || 0;
my @file_contents;
my $file = $testing ? 'test.txt' : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @file_contents, $_; }
### CODE
my $program = [ split( /,/, $file_contents[0] ) ];
my $Map;
my %directions = (
'^' => sub { !$_[0]?['<', 0,-1 ]:['>', 0, 1 ] },
'<' => sub { !$_[0]?['v', 1, 0 ]:['^',-1, 0 ] },
'v' => sub { !$_[0]?['>', 0, 1 ]:['<', 0,-1 ] },
'>' => sub { !$_[0]?['^',-1, 0 ]:['v', 1, 0 ] },
);
# arbitrary choose some positive coordinate
my ( $row, $col ) = ( 0, 0 );
# 0: black
# 1: white
$Map->{$row}->{$col} = $part2 ? 1 : 0;
my $pos = [ $row, $col ];
my $seen; #->{$row}->{$col}=0;
my $dir = '^';
#my @instr = ([1,0],[0,0],[1,0],[1,0],[0,1],[1,0],[1,0]);
my $count = 0;
my $state = [@$program];
my $pointers = [ 0, 0 ];
my $out;
do {
# first element - color to paint,
# 0: black
# 1: white
# second - left or right
# 0: left 90deg
# 1: right 90deg
my $in_data = defined $Map->{$row}->{$col} ? $Map->{$row}->{$col} : 0;
my $res = run_vm(
{
input_ary => [$in_data],
state => [@$state],
positions => [ @{$pointers} ]
}
);
$out = $res->{output_ary};
$pointers = $res->{positions};
$state = $res->{state};
if ( !$out->[0] ) {
$Map->{$row}->{$col} = 0;
}
else {
$Map->{$row}->{$col} = 1;
}
$seen->{$row}->{$col}++;
my $newpos = $directions{$dir}->( $out->[1] );
$dir = shift @$newpos;
$row = $row + $newpos->[0];
$col = $col + $newpos->[1];
$count++;
} while ( scalar @$out > 0 );
if ( !$part2 ) {
my $painted = 0;
foreach my $r ( keys %$seen ) {
foreach my $c ( keys %{ $seen->{$r} } ) {
$painted++;
}
}
is( $painted, 1747, "... part 1" );
say "Part 1: ", $painted;
}
else {
# find dimensions of image
my ( $r_min, $r_max, $c_min, $c_max ) = ( 0, 0, 0, 0 );
foreach my $r ( keys %$Map ) {
$r_min = $r if $r < $r_min;
$r_max = $r if $r > $r_max;
foreach my $c ( keys %{ $Map->{$r} } ) {
$c_min = $c if $c < $c_min;
$c_max = $c if $c > $c_max;
}
}
say "Part 2: ";
foreach my $r ( 0 .. $r_max + abs($r_min) ) {
$r_min = $r if $r < $r_min;
$r_max = $r if $r > $r_max;
foreach my $c ( 0 .. $c_max + abs($c_min) ) {
$c_min = $c if $c < $c_min;
$c_max = $c if $c > $c_max;
if ( !defined $Map->{$r}->{$c} ) {
print '.';
}
elsif ( $Map->{$r}->{$c} == 0 ) {
print '.';
}
else {
print '▓';
}
}
print "\n";
}
}
done_testing;
### SUBS
sub run_vm {
# IN : hashref with keys input_ary, positions, state, all values arrayrefs
# OUT: hashref with keys output_ary,positions, state, all values arrayrefs
my ($params) = @_;
my $input_ary = $params->{input_ary};
my ( $ptr, $offset ) = @{ $params->{positions} };
my $state = $params->{state};
my $output_ary = [];
### keep our opcodes here, called later from a dispatch table;
my $add = sub {
say "1 [add] => add $_[0] to $_[1], store in position $_[2]" if $debug;
$state->[ $_[2] ] = $_[0] + $_[1];
$ptr += 4;
};
my $multiply = sub {
say "2 [multiply] => multiply $_[0] with $_[1], store in position $_[2]"
if $debug;
$state->[ $_[2] ] = $_[0] * $_[1];
$ptr += 4;
};
my $write = sub {
say "4 [write] => push $_[0] to output array" if $debug;
push @{$output_ary}, $_[0];
$ptr += 2;
};
my $jump_if_true = sub {
say "5 [jump-if-true] => checking $_[0] for truth: ",
$_[0] != 0
? " it is true, set pointer to $_[1]"
: " it is false, skip instruction"
if $debug;
if ( $_[0] != 0 ) { $ptr = $_[1]; }
else { $ptr += 3; }
};
my $jump_if_false = sub {
say "6 [jump-if-false] => compare $_[0] to 0: ",
$_[0] == 0
? " it is 0, set pointer to $_[1] "
: " skip to next instruction"
if $debug;
if ( $_[0] == 0 ) { $ptr = $_[1]; }
else { $ptr += 3; }
};
my $less_than = sub {
say "7 [less-than] => compare $_[0] to $_[1]: ",
$_[0] < $_[1]
? " it is less, set position $_[2] to 1 "
: " it is not less, set position $_[2] to 0"
if $debug;
if ( $_[0] < $_[1] ) { $state->[ $_[2] ] = 1; }
else { $state->[ $_[2] ] = 0; }
$ptr += 4;
};
my $equals = sub {
say "8 [equals] => compare $_[0] to $_[1]: ",
$_[0] == $_[1]
? " they are equal, set position $_[2] to 1 "
: " they differ, set position $_[2] to 0"
if $debug;
if ( $_[0] == $_[1] ) {
$state->[ $_[2] ] = 1;
}
else {
$state->[ $_[2] ] = 0;
}
$ptr += 4;
};
my $adjust_offset = sub {
say "9 [adjust-offset] => modify offset by $_[0]" if $debug;
$offset = $offset + $_[0];
$ptr += 2;
};
my $loop_counter = 0;
LOOP: while ( $state->[$ptr] != 99 ) {
my ( $op, $a1, $a2, $a3 ) =
@$state[ $ptr, $ptr + 1, $ptr + 2, $ptr + 3 ];
my $raw = [ $op, $a1, $a2, $a3 ];
my $mask;
if ( length $op > 2 )
{ # assume values in this position are either 2 digits or more
my @instr = split( //, $op );
my @tail;
for ( 1, 2 ) {
unshift @tail, pop @instr;
}
$op = join( '', @tail ) + 0;
while ( scalar @instr < 3 ) {
unshift @instr, 0;
}
$mask = [ reverse @instr ];
}
else {
$mask = [ 0, 0, 0 ];
}
my %ops = (
1 => $add,
2 => $multiply,
4 => $write,
9 => $adjust_offset,
5 => $jump_if_true,
6 => $jump_if_false,
7 => $less_than,
8 => $equals,
);
if ($debug) {
# my $addr = 1024;
# dump_state($state);
print "--------------------------------------------------\n";
# say "Value at $addr: ", $state->[$addr] ? $state->[$addr] : 0;
print "Pass $loop_counter Position [$ptr, $offset] IN [";
print join( ',', @$input_ary ) . "] OUT [";
print join( ',', @$output_ary ) . "]\n";
print '['
. join( ',', @$raw ) . '] => '
. join( ' ', ( $op, $a1, $a2, $a3 ) );
print ' [' . join( ',', @$mask ) . "]\n";
}
# we keep this operand outside the dispatch table because it
# has control flow - if no input is received, it will pause
# the VM
if ( $op == 3 ) {
my $in = shift @$input_ary;
if ( !defined $in ) {
last LOOP;
}
if ( $mask->[0] == 2 ) {
$state->[ $a1 + $offset ] = $in;
}
else {
$state->[$a1] = $in;
}
$ptr += 2;
}
else {
# first operand handled by $mask->[0]
if ( $mask->[0] == 0 ) { # position mode
$a1 = $state->[$a1] ? $state->[$a1] : 0;
}
elsif ( $mask->[0] == 1 ) { # immediate mode
$a1 = $a1;
}
elsif ( $mask->[0] == 2 ) { # relative mode
$a1 = $state->[ $offset + $a1 ] ? $state->[ $offset + $a1 ] : 0;
}
else {
die "unknown mode: ", $mask->[0];
}
# second operand handled by $mask->[1]
if ( $mask->[1] == 0 ) { # position mode
$a2 = $state->[$a2] ? $state->[$a2] : 0;
}
elsif ( $mask->[1] == 1 ) { # immediate mode
$a2 = $a2;
}
elsif ( $mask->[1] == 2 ) { # relative mode
$a2 = $state->[ $offset + $a2 ] ? $state->[ $offset + $a2 ] : 0;
}
else {
die "unknown mode: ", $mask->[1];
}
# third operand
if ( $mask->[2] == 2 ) { #relative mode
$a3 = $offset + $a3;
}
$ops{$op}->( $a1, $a2, $a3 );
}
$loop_counter++;
}
return {
output_ary => $output_ary,
positions => [ $ptr, $offset ],
state => $state
};
}
sub dump_state { # shows a pretty-printed grid of the current state
my ($in) = @_;
my @show = @{$in};
print ' ';
for my $i ( 0 .. 9 ) { printf( "___%d ", $i ) }
print "\n";
my $full_rows = int( scalar @show / 10 );
my $r;
for $r ( 0 .. $full_rows - 1 ) {
printf "%2d|", $r;
for my $c ( 0 .. 9 ) {
my $el = shift @show;
printf "%4d ", $el ? $el : 0;
}
print "\n";
}
printf "%2d|", $full_rows;
while (@show) {
my $el = shift @show;
printf "%4d ", $el;
}
print "\n";
}
298 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#! /usr/bin/env perl
use Modern::Perl '2015';
# useful modules
use List::Util qw/sum any all/;
use Data::Dumper;
use Test::More;
use ntheory qw/lcm/;
#### INIT - load input data from file into array
my $run_nr = 1;
while () {
chomp;
my @data = split( /\|/, $_ );
my $part2 = pop @data;
my $part1 = pop @data;
my $energy_loop_count = pop @data;
my $moons;
my $initial_pos;
my $id = 0;
foreach my $line (@data) {
if ( $line =~ m// ) {
my @pos = ( $1, $2, $3 );
$moons->[$id]->{pos} = [@pos];
push @{$initial_pos}, [@pos];
$moons->[$id]->{vel} = [ 0, 0, 0 ];
}
else {
die "can't parse line: $line!";
}
$id++;
}
my $res = run_code( $moons, $initial_pos, $energy_loop_count );
is( $res->[0], $part1, "test $run_nr part 1");
is( $res->[1], $part2, "test $run_nr part 2");
# next unless $run_nr==3;
say "==Answers==";
say "Part 1: $res->[0]";
say "Part 2: $res->[1]";
$run_nr++;
}
### CODE
sub run_code {
my ( $matrix, $start_matrix, $energy_loop_count ) = @_;
my $steps = 1;
my $energy;
my @cycles = ( [], [], [] );
while ( any { scalar @{ $cycles[$_] } == 0 } ( 0 .. 2 ) ) {
my @deltas;
foreach my $i ( 0 .. 3 ) {
foreach my $j ( 0 .. 3 ) {
next if $i == $j;
foreach my $k ( 0 .. 2 ) { # x,y,z
my $delta = 0;
if ( $matrix->[$i]->{pos}->[$k] <
$matrix->[$j]->{pos}->[$k] )
{
$delta = $delta + 1;
}
elsif ( $matrix->[$i]->{pos}->[$k] >
$matrix->[$j]->{pos}->[$k] )
{
$delta = $delta - 1;
}
elsif ( $matrix->[$i]->{pos}->[$k] ==
$matrix->[$j]->{pos}->[$k] )
{
}
else {
die "how did we get here?!";
}
push @{ $deltas[$i]->[$k] }, $delta;
}
}
for my $k ( 0 .. 2 ) {
my $sum = sum( @{ $deltas[$i]->[$k] } );
$matrix->[$i]->{vel}->[$k] += $sum;
}
}
foreach my $i ( 0 .. 3 ) {
foreach my $k ( 0 .. 2 ) {
$matrix->[$i]->{pos}->[$k] += $matrix->[$i]->{vel}->[$k];
}
}
# energy for part 1
if ( $steps == $energy_loop_count ) {
for my $i ( 0 .. 3 ) {
my $pot = sum map { abs($_) } @{ $matrix->[$i]->{pos} };
my $kin = sum map { abs($_) } @{ $matrix->[$i]->{vel} };
# say "id: $i pot: $pot kin: $kin";
$energy += ( $pot * $kin );
}
}
# check if we have a repeat
# for each dimension
for my $k ( 0 .. 2 ) {
if ( all { $matrix->[$_]->{vel}->[$k] == 0 } ( 0 .. 3 ) )
{
say "zero velocity vector for $k at step $steps";
push @{ $cycles[$k] }, $steps;
}
}
$steps++;
}
# due to symmetry, every loop "stops" with 0 speed twice, so we
# multiply the cycles by 2
my $cycle_loops = lcm( map { $cycles[$_]->[0] * 2} ( 0 .. 2 ) );
return [ $energy, $cycle_loops ];
}
done_testing;
__END__
||||10|179|2772
||||100|1940|4686774924
||||1000|8044|362375881472136
107 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#! /usr/bin/env perl
use Modern::Perl '2015';
# useful modules
use List::Util qw/sum/;
use Data::Dumper;
use Test::More;
use lib '/home/gustaf/prj/AdventOfCode/Intcode';
use Intcode qw/run_vm/;
#### INIT - load input data from file into array
my $testing = 0;
my @file_contents;
my $file = $testing ? 'test.txt' : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @file_contents, $_; }
### CODE
my $pos = [ 0, 0 ];
my $program = [ split( /,/, $file_contents[0] ) ];
my $res = run_vm(
{
state => [@$program],
positions => $pos,
input_ary => []
}
);
my $Map;
my $block_count = 0;
my @output = @{ $res->{output_ary} };
while (@output) {
my $col = shift @output;
my $row = shift @output;
my $tile = shift @output;
$block_count++ if $tile == 2;
}
is( $block_count,372 ,"part 1");
say "Part 1: ",$block_count;
my %blocks = ( 0 => ' ', 1 => '#', 2 => '=', 3 => '_', 4 => 'o' );
$program->[0] = 2;
# initial state
my $score = 0;
$res = run_vm(
{
state => [@$program],
positions => [ 0, 0 ],
input_ary => [0]
}
);
my $row_count = 0;
my @ball_pos = ();
my $paddle_col;
my $joystick = 0;
while ( @{ $res->{output_ary} } ) {
my $col = shift @{ $res->{output_ary} };
my $row = shift @{ $res->{output_ary} };
my $tile = shift @{ $res->{output_ary} };
$Map->[$row]->[$col] = $tile;
if ( $tile == 4 ) {
@ball_pos = ( $row, $col );
}
if ( $tile == 3 ) {
$paddle_col = $col;
}
}
my $count = 1;
while ( $count < 150000 ) {
say "Count: $count Score: $score" if $count % 1000 == 0;
$res = run_vm(
{
state => $res->{state},
positions => $res->{positions},
input_ary => [$joystick]
}
);
last if scalar @{ $res->{output_ary} } == 0;
while ( @{ $res->{output_ary} } ) {
my $col = shift @{ $res->{output_ary} };
my $row = shift @{ $res->{output_ary} };
my $tile = shift @{ $res->{output_ary} };
if ( $row == 0 and $col == -1 ) {
$score = $tile;
}
else {
if ( $tile == 4 ) {
@ball_pos = ( $row, $col );
}
if ( $tile == 3 ) {
$paddle_col = $col;
}
$Map->[$row]->[$col] = $tile;
}
}
# move paddle
if ( $ball_pos[1] < $paddle_col ) {
$joystick = -1;
}
elsif ( $ball_pos[1] > $paddle_col ) {
$joystick = 1;
}
else {
$joystick = 0;
}
$count++;
}
is( $score,19297,"part 2");
say "Count: $count";
say "Part 2: ", $score;
done_testing;
sub dump_output {
my ($data) = @_;
while (@$data) {
my $col = shift @$data;
my $row = shift @$data;
my $tile = shift @$data;
say "R: $row C: $col T: $tile";
}
}
sub paint_screen {
my $row_count = 0;
my $width = 36;
print ' ';
for ( 0 .. $width ) {
print $_% 10;
}
print "\n";
for my $r (@$Map) {
print $row_count% 10;
for my $c ( @{$r} ) {
print $blocks{$c};
}
print "\n";
$row_count++;
}
print ' ';
for ( 0 .. $width ) {
print $_% 10;
}
print "\n";
say "Score: $score";
}
__END__
134 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#! /usr/bin/env perl
use Modern::Perl '2015';
# useful modules
use List::Util qw/sum/;
use Data::Dumper;
use Test::More;
#### INIT - load input data from file into array
my $testing = shift || 0;
my $debug = 0;
my @file_contents;
my $file = $testing ? 'test' . $testing . '.txt' : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @file_contents, $_; }
### CODE
my $reactions;
my %store;
while (@file_contents) {
my ( $LHS, $RHS ) = split( / \=\> /, shift @file_contents );
my $reqs;
for my $el ( split( /,/, $LHS ) ) {
if ( $el =~ m/(\d+) (\S+)/ ) {
$reqs->{$2} = $1;
$store{$2}=0;
}
else {
die "can't parse $el!";
}
}
if ( $RHS =~ m/(\d+) (\S+)/ ) {
$reactions->{$2} = {
amount => $1,
requires => $reqs
};
my @reqlist = keys %$reqs;
if ( scalar @reqlist == 1 and $reqlist[0] eq 'ORE' ) {
$store{$2} = 0;
}
}
else {
die "can't parse $RHS";
}
}
# part 1
my $fuel_amount = 1;
my $part1 = ore_per_fuel($fuel_amount);
my %correct = ( 1=>31, 2=>165,3=>13312,4=>180697,5=>2210736,live=>220019);
if ($testing != 0){
is ($part1, $correct{$testing}, "testfile $file: $part1");
}
else { is ($part1, $correct{live}, "Part 1: $part1");}
# part 2
if ($testing==1 or $testing==2) {
done_testing;
exit 0;
}
# 3 82892753
# 4 5586022
# 5 460664
# live 5650230
my %ranges = ( 3=>[0,90_000_000],
4=>[0,6_000_000],
5=>[0,500_000],
live=>[0,6_000_000]);
my %correct2 = ( 3=> 82892753,
4=> 5586022,
5=> 460664,
live => 5650230);
# binary search
my $target = 1000000000000;
my $L = $ranges{$testing?$testing:'live'}->[0];
my $R = $ranges{$testing?$testing:'live'}->[1];
while ($L < $R) {
my $m = int( ($L+$R)/2);
if (ore_per_fuel($m)> $target ) {
$R = $m
} else {
$L = $m+1
}
}
my $part2 = $L-1;
if ($testing != 0){
is ($part2, $correct2{$testing}, "testfile $file: $part2");
}
else { is ($part2, $correct2{live}, "Part 2: $part2");}
done_testing;
sub ore_per_fuel {
my ($given) = @_;
my @queue;
my $ore_count = 0;
foreach my $el ( sort keys %{ $reactions->{FUEL}->{requires} } ) {
push @queue, [ $el, $reactions->{FUEL}->{requires}->{$el} * $given ];
}
dump_queue() if $debug;
while (@queue) {
my ( $cur, $needed ) = @{ shift @queue };
if ( exists $reactions->{$cur}->{requires}->{ORE} ) {
print "[end] Needed: $needed of $cur" if $debug;
if ( $store{$cur} > $needed ) {
say " grabbing from store" if $debug;
$store{$cur} -= $needed;
}
else {
# add from store
$needed -= $store{$cur};
$store{$cur} = 0;
say " reduced to $needed" if $debug;
next if $needed == 0;
# consume ORE for this reagent, store excess
my $multiple = 1;
my $yield = $reactions->{$cur}->{amount};
while ( $needed % $yield != 0 ) {
$needed++;
$store{$cur}++;
}
$needed = $needed / $yield;
printf(
"adding %d x %d = %d to total\n",
$needed,
$reactions->{$cur}->{requires}->{ORE},
$needed * $reactions->{$cur}->{requires}->{ORE}
) if $debug;
$ore_count += $needed * $reactions->{$cur}->{requires}->{ORE};
}
}
else {
print "[mid] Needed: $needed of $cur" if $debug;
if ( $store{$cur} > $needed ) {
say " grabbing from store" if $debug;
$store{$cur} -= $needed;
next;
}
else {
$needed -= $store{$cur};
$store{$cur} = 0;
say " reduced to $needed" if $debug;
next if $needed == 0;
my $yield = $reactions->{$cur}->{amount};
if ( $needed < $yield ) {
say "We will generate an excess of ", $yield - $needed,
", storing"
if $debug;
$store{$cur} = $yield - $needed;
$needed = 1;
}
else {
while ( $needed % $yield != 0 ) {
$needed++;
$store{$cur}++;
say "Increasing to $needed" if $debug;
}
$needed = $needed / $yield;
}
}
foreach my $el ( keys %{ $reactions->{$cur}->{requires} } ) {
push @queue,
[ $el, $reactions->{$cur}->{requires}->{$el} * $needed ];
}
}
dump_queue() if $debug;
}
return $ore_count;
}
151 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#! /usr/bin/env perl
use Modern::Perl '2015';
# useful modules
use List::Util qw/sum/;
use Data::Dumper;
use Test::More;
use lib '/home/gustaf/prj/AdventOfCode/Intcode';
use Intcode qw/run_vm/;
#### INIT - load input data from file into array
my $testing = 0;
my @file_contents;
my $file = $testing ? 'test.txt' : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @file_contents, $_; }
my $limit = shift || 10;
### CODE
my $program = [ split( /,/, $file_contents[0] ) ];
my $res = {
state => [@$program],
positions => [ 0, 0 ]
};
my $Map;
my @start = ( 21, 21 );
my $dpos = [@start];
$Map->{ $dpos->[0] }->{ $dpos->[1] } = '>';
my $visited;
$visited->{ $dpos->[0] }->{ $dpos->[1] }++;
my $out;
my $orientation = 1; # start north
my %labels = ( 1 => 'N', 2 => 'S', 3 => 'W', 4 => 'E' );
# north (1), south (2), west (3), and east (4)
my %ccw = ( 1 => 3, 3 => 2, 2 => 4, 4 => 1 );
my %cw = ( 1 => 4, 4 => 2, 2 => 3, 3 => 1 );
my $count = 1;
my @sought;
while ( $visited->{ $start[0] }->{ $start[1] } < 2 ) {
my $cur = [@$dpos];
$res = run_vm(
{
state => $res->{state},
positions => $res->{positions},
input_ary => [$orientation]
}
);
plot( $orientation, $res->{output_ary}->[0] );
if ( $dpos->[0] != $cur->[0] or $dpos->[1] != $cur->[1] ) { # we have moved
# keep orientation
$orientation = $cw{$orientation};
$visited->{ $dpos->[0] }->{ $dpos->[1] }++;
}
else {
# turn so we have our right hand on the wall
$orientation = $ccw{$orientation};
}
$count++;
}
my @node;
paint_map();
say join( ',', @sought );
# find shortest path, overkill with Djikstras
my $infinity = 'inf';
#my $root = join(',',@start);
for my $r ( 0 .. 40 ) {
for my $c ( 0 .. 40 ) {
if ( defined $Map->{$r}->{$c} and $Map->{$r}->{$c} ne '█' ) {
push @node, join( ',', ( $r, $c ) );
}
}
}
my $dist1 = djikstras( join( ',', @start ) );
my $part1 = $dist1->{ join( ',', @sought ) };
my $dist2 = djikstras( join( ',', @sought ) );
my $part2 = $dist2->{'1,27'};
is( $part1, 424, "Part 1: $part1" );
is( $part2, 446, "Part 2: $part2" );
done_testing;
#foreach my $n (sort {$dist2->{$b} <=> $dist2->{$a}} keys %{$dist2}) { say "$n $dist2->{$n}";}
sub djikstras {
my ($root) = @_;
my @unsolved = @node;
my @solved;
my %dist;
my %edge;
my %prev;
my $bydistance = sub {
$dist{$a} eq $infinity ? +1
: $dist{$b} eq $infinity ? -1
: $dist{$a} <=> $dist{$b};
};
# calculate edges
for my $r ( 0 .. 40 ) {
for my $c ( 0 .. 40 ) {
# try to move
for my $d ( [ -1, 0 ], [ 1, 0 ], [ 0, -1 ], [ 0, 1 ] ) {
my ( $r2, $c2 ) = ( $r + $d->[0], $c + $d->[1] );
if ( defined $Map->{$r2}->{$c2}
and $Map->{$r2}->{$c2} ne '█' )
{
$edge{ join( ',', $r, $c ) }->{ join( ',', $r2, $c2 ) } = 1;
}
}
}
}
foreach my $n (@node) {
$dist{$n} = $infinity;
$prev{$n} = $n;
}
$dist{$root} = 0;
while (@unsolved) {
@unsolved = sort { &{$bydistance} } @unsolved;
my $n = shift @unsolved;
push @solved, $n;
foreach my $n2 ( keys %{ $edge{$n} } ) {
if ( $dist{$n2} eq $infinity
|| $dist{$n2} > ( $dist{$n} + $edge{$n}->{$n2} ) )
{
$dist{$n2} = $dist{$n} + $edge{$n}->{$n2};
$prev{$n2} = $n;
}
}
}
return \%dist;
}
sub paint_map {
foreach my $row ( 0 .. 40 ) {
print $row% 10;
foreach my $col ( 0 .. 40 ) {
if ( $dpos->[0] == $row and $dpos->[1] == $col ) {
print $labels{$orientation};
}
else {
print $Map->{$row}->{$col} ? $Map->{$row}->{$col} : ' ';
}
if ( defined $Map->{$row}->{$col}
and $Map->{$row}->{$col} eq '*' )
{
@sought = ( $row, $col );
}
}
print "\n";
}
print ' ';
foreach ( 0 .. 40 ) {
print $_% 10;
}
print ' ' . join( ',', @$dpos ) . "\n";
}
sub plot {
my ( $dir, $out ) = @_;
# mark map
my %markers = ( 0 => '█', 1 => '•', 2 => '*' );
if ( $dir == 1 ) { # N
$Map->{ $dpos->[0] - 1 }->{ $dpos->[1] } = $markers{$out};
$dpos->[0]-- unless $out == 0;
}
elsif ( $dir == 2 ) { #S
$Map->{ $dpos->[0] + 1 }->{ $dpos->[1] } = $markers{$out};
$dpos->[0]++ unless $out == 0;
}
elsif ( $dir == 3 ) { #W
$Map->{ $dpos->[0] }->{ $dpos->[1] - 1 } = $markers{$out};
$dpos->[1]-- unless $out == 0;
}
elsif ( $dir == 4 ) { #E
$Map->{ $dpos->[0] }->{ $dpos->[1] + 1 } = $markers{$out};
$dpos->[1]++ unless $out == 0;
}
}
160 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#! /usr/bin/env perl
use Modern::Perl '2015';
# useful modules
use List::Util qw/sum/;
use Data::Dumper;
use Test::More;
#### INIT - load input data from file into array
my $testing = shift || 0;
my $debug = 0;
my @file_contents;
my $file = $testing ? 'test'.$testing.'.txt' : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @file_contents, $_; }
### CODE
my @mask = (0, 1, 0, -1);
my $input =$file_contents[0];
say "===> $input" if $debug;
my $matrix;
say "calculating matrix...";
generate_matrix( length $input );
my $round = 1;
my @signal = split(//,$input);
while ($round <=100 ) {
my @result;
for (my $i=0; $i[$i]->[$j]*$signal[$j]
}
push @result, abs( $sum )%10;
}
printf("%03d: %s\n", $round, join('',@result)) if $debug;
@signal = @result;
$round++;
}
my $part1 = join('',splice(@signal,0,8));
my %correct = (1=>24176176,
2=>73745418,
3=>52432133,
live=>45834272);
if ($testing) {
is( $part1, $correct{$testing}, "testing $testing: $part1");
}
else {
is($part1, $correct{live} ,"Part 1: $part1");
}
done_testing;
sub generate_matrix {
my ( $l ) = @_;
for my $pos (1..$l) {
my @pattern;
for my $i (0..3) {
push @pattern, ($mask[$i]) x $pos;
}
while (scalar @pattern -1 < $l) {
@pattern = (@pattern, @pattern);
}
shift @pattern;
push @{$matrix}, [@pattern];
}
}
57 lines [ Plain text ] [ ^Top ]
#! /usr/bin/env perl
use Modern::Perl '2015';
# useful modules
use List::Util qw/sum/;
use Data::Dumper;
use Test::More;
#### INIT - load input data from file into array
my $testing = shift || 0;
my $debug = 0;
my @file_contents;
my $file = $testing ? 'test2_'.$testing.'.txt' : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @file_contents, $_; }
### CODE
my @mask = (0, 1, 0, -1);
my $input =$file_contents[0];
my $offset= substr( $input, 0,7);
my @signal =split(//,$input);
for (1..10_000-1) {
for (0..(length $input)-1) {
push @signal, $signal[$_];
}
}
die "not correct length: ", scalar @signal unless scalar @signal == 10_000 * length($input);
@signal = splice(@signal, $offset);
say scalar @signal if $debug;
my $round = 1;
while ($round <=100) {
say $round unless $testing;
my @result;
unshift @result, $signal[-1];
for (my $k=scalar @signal-1;$k>=0;$k--) {
$result[$k]=($signal[$k]+(defined $result[$k+1]?$result[$k+1]:0))%10;
}
@signal= @result;
$round++;
}
my @p2 =splice( @signal, 0,8);
my $part2 = join('',@p2);
my %correct = (1=>84462026
,2=>78725270
,3=>53553731);
if ($testing) {
is( $part2, $correct{$testing}, "test $testing: ".$correct{$testing});
} else {
is($part2, 37615297, "Part 2: $part2");
}
done_testing;
44 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#! /usr/bin/env perl
use Modern::Perl '2015';
# useful modules
use List::Util qw/sum any all/;
use Data::Dumper;
use Test::More;
use lib '/home/gustaf/prj/AdventOfCode/Intcode';
use Intcode qw/run_vm/;
#### INIT - load input data from file into array
my $testing = 0;
my @file_contents;
my $file = $testing ? 'test.txt' : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @file_contents, $_; }
### CODE
my $program = [ split( /,/, $file_contents[0] ) ];
my $res = run_vm(
{
state => [@$program],
positions => [ 0, 0 ],
input_ary => []
}
);
my $Map;
my $row;
foreach ( @{ $res->{output_ary} } ) {
if ( $_ != 10 ) {
push @$row, $_;
}
else {
push @$Map, $row;
$row = [];
}
}
#print_grid();
# part1
my $crosses;
for ( my $r = 0 ; $r < scalar @{$Map} ; $r++ ) {
for ( my $c = 0 ; $c < scalar @{ $Map->[$r] } ; $c++ ) {
my $cur = $Map->[$r]->[$c];
my $left = $Map->[$r]->[ $c - 1 ];
my $right = $Map->[$r]->[ $c + 1 ];
my $up = $Map->[ $r - 1 ]->[$c];
my $down = $Map->[ $r + 1 ]->[$c];
if ( all { $_ == ord('#') }
map { defined $_ ? $_ : 0 } ( $cur, $up, $down, $left, $right ) )
{
$crosses += $r * $c;
}
}
}
is( $crosses, 6024, "Part 1: $crosses" );
$program->[0] =2;
# this sequence found by inspection:
my $seq = 'A,B,A,B,C,C,B,A,B,C';
my $s_A = 'L,12,L,6,L,8,R,6';
my $s_B = 'L,8,L,8,R,4,R,6,R,6';
my $s_C = 'L,12,R,6,L,8';
my $input;
for my $str ($seq, $s_A, $s_B,$s_C) {
my @a=map{ord($_)}((split(//,$str)));
push @$input,(@a,10);
}
push @$input, (ord('n'),10);
$res = run_vm({state=>[@$program],
positions=>[0,0],
input_ary=>[@$input]});
my $part2=$res->{output_ary}->[-1];
is($part2 ,897344 ,"Part 2: $part2");
done_testing();
sub dump_output {
my ( $out ) = @_;
while (@$out) {
my $c = shift @$out;
print $c>127?$c:chr($c);
}
}
sub print_grid {
foreach my $row (@{$Map}) {
foreach my $chr (@{$row}) {
print chr($chr);
}
print "\n";
}
}
78 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#! /usr/bin/env perl
use Modern::Perl '2015';
# useful modules
use List::Util qw/sum all/;
use Data::Dumper;
use Test::More;
use lib '/home/gustaf/prj/AdventOfCode/Intcode';
use Intcode qw/run_vm/;
#### INIT - load input data from file into array
my $testing = 0;
my @file_contents;
my $file = $testing ? 'test.txt' : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @file_contents, $_; }
### CODE
my $program = [ split( /,/, $file_contents[0] ) ];
my $res;
my %stats;
for my $y ( 0 .. 49 ) {
for my $x ( 0 .. 49 ) {
$res = run_vm(
{
state => [@$program],
positions => [ 0, 0 ],
input_ary => [ $x, $y ]
}
);
$stats{ $res->{output_ary}->[0] }++;
}
}
my $part1 = $stats{1};
is( $part1, 217, "Part 1: $part1" );
my $delta = 99;
my $part2;
LOOP: for my $y ( 937 .. 1175 ) { # found by inspection
my $x_1 = int( 0.66 * $y );
my $x_2 = int( 0.836521739 * $y );
for my $x ( $x_1 .. $x_2 ) {
my $ok = check_corners( $y, $x );
if ($ok) {
$part2 = 10_000 * $x + $y;
last LOOP;
}
}
}
is( $part2, 6840937, "Part 2: $part2" );
done_testing();
sub check_corners {
my ( $y_start, $x_start ) = @_;
my @output;
for my $corners (
[ $x_start, $y_start ],
[ $x_start + $delta, $y_start ],
[ $x_start, $y_start + $delta ],
[ $x_start + $delta, $y_start + $delta ]
)
{
$res = run_vm(
{
state => [@$program],
positions => [ 0, 0 ],
input_ary => [@$corners]
}
);
push @output, $res->{output_ary}->[0];
}
if ( all { $_ == 1 } @output ) {
return 1;
}
else {
return 0;
}
}
69 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#! /usr/bin/env perl
use Modern::Perl '2015';
# useful modules
use List::Util qw/sum all/;
use Data::Dumper;
use Test::More;
#### INIT - load input data from file into array
my $testing = 0;
my $debug = 0;
my @file_contents;
my $file = $testing ? 'test2.txt' : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @file_contents, $_; }
### CODE
my $Map;
foreach my $line (@file_contents) {
push @$Map, [ split( //, $line ) ];
}
# scan for wormholes
my %wormholes;
for ( my $row = 0 ; $row < scalar @$Map ; $row++ ) {
for ( my $col = 0 ; $col < scalar @{ $Map->[$row] } ; $col++ ) {
# only consider tiles we can occupy
next unless $Map->[$row]->[$col] eq '.';
# read left
if ( all { $Map->[$row]->[ $col - $_ ] =~ m/[A-Z]/ } ( 2, 1 ) ) {
push @{ $wormholes{ $Map->[$row]->[ $col - 2 ]
. $Map->[$row]->[ $col - 1 ] } },
{
exit => [ $row, $col ],
entry => [ $row, $col - 1 ]
};
}
# read up
if ( all { $Map->[ $row - $_ ]->[$col] =~ m/[A-Z]/ } ( 2, 1 ) ) {
push @{ $wormholes{ $Map->[ $row - 2 ]->[$col]
. $Map->[ $row - 1 ]->[$col] } },
{
exit => [ $row, $col ],
entry => [ $row - 1, $col ]
};
}
# read right
if ( all { $Map->[$row]->[ $col + $_ ] =~ m/[A-Z]/ } ( 1, 2 ) ) {
push @{ $wormholes{ $Map->[$row]->[ $col + 1 ]
. $Map->[$row]->[ $col + 2 ] } },
{
exit => [ $row, $col ],
entry => [ $row, $col + 1 ]
};
}
# read down
if ( all { $Map->[ $row + $_ ]->[$col] =~ m/[A-Z]/ } ( 1, 2 ) ) {
push @{ $wormholes{ $Map->[ $row + 1 ]->[$col]
. $Map->[ $row + 2 ]->[$col] } },
{
exit => [ $row, $col ],
entry => [ $row + 1, $col ]
};
}
}
}
my $entries;
for my $label ( keys %wormholes ) {
next if ( $label eq 'AA' or $label eq 'ZZ' );
die unless scalar @{ $wormholes{$label} } == 2;
$entries->{ $wormholes{$label}->[0]->{entry}->[0] }
->{ $wormholes{$label}->[0]->{entry}->[1] } = {
exit => $wormholes{$label}->[1]->{exit},
entry => $wormholes{$label}->[1]->{entry},
label => $label
};
$entries->{ $wormholes{$label}->[1]->{entry}->[0] }
->{ $wormholes{$label}->[1]->{entry}->[1] } = {
exit => $wormholes{$label}->[0]->{exit},
entry => $wormholes{$label}->[0]->{entry},
label => $label
};
}
my ( $start_a, $end_z ) =
( $wormholes{AA}->[0]->{exit}, $wormholes{ZZ}->[0]->{exit} );
printf( "finding path between AA at [%2d,%2d] and ZZ at [%2d,%2d]\n",
@$start_a, @$end_z );
my $part1 = find_shortest_path( $wormholes{AA}->[0]->{exit},
$wormholes{ZZ}->[0]->{exit} );
is( $part1, 568, "Part 1: $part1");
done_testing;
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};
next unless ( defined $Map->[$t_r]->[$t_c] );
if ( $Map->[$t_r]->[$t_c] ne '#'
and $Map->[$t_r]->[$t_c] ne ' ' )
{
printf( "step %2d: trying [%2d,%2d]\n", $step, @$try )
if $debug;
if ( exists $entries->{$t_r}->{$t_c} ) {
my ( $j_r, $j_c ) =
@{ $entries->{$t_r}->{$t_c}->{exit} };
printf(
"step %2d: hit %s at [%2d,%2d], jumping to [%2d,%2d], adding [%2d,%2d] to seen list\n",
$step,
$entries->{$t_r}->{$t_c}->{label},
$t_r,
$t_c,
$j_r,
$j_c,
@{ $entries->{$t_r}->{$t_c}->{entry} }
) if $debug;
$seen->{ $entries->{$t_r}->{$t_c}->{entry}->[0] }
->{ $entries->{$t_r}->{$t_c}->{entry}->[1] }++;
$try = [ $j_r, $j_c ];
}
if ( $t_r == $end->[0] and $t_c == $end->[1] ) {
$shortest = $step;
last LOOP;
}
push @states, [ $step, $try ];
}
}
}
}
return $shortest;
}
140 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#! /usr/bin/env perl
use Modern::Perl '2015';
# useful modules
use List::Util qw/sum/;
use Data::Dumper;
use Test::More;
use lib '/home/gustaf/prj/AdventOfCode/Intcode';
use Intcode qw/run_vm/;
#### INIT - load input data from file into array
my $testing = 0;
my @file_contents;
my $file = $testing ? 'test.txt' : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @file_contents, $_; }
### CODE
my $program = [ split( /,/, $file_contents[0] ) ];
my @ins;
my $walk;
my $res;
# part 1
# https://www.reddit.com/r/adventofcode/comments/edocmd/2019_day_21_part_1_all_41_instruction_solutions/
@ins = ( 'NOT A T',
'NOT C J',
'OR T J',
'AND D J' );
$walk = 'WALK';
my $input;
for my $str ( @ins, $walk ) {
my @a = map { ord($_) } ( ( split( //, $str ) ) );
push @$input, ( @a, 10 );
}
$res = run_vm(
{
state => [@$program],
positions => [ 0, 0 ],
input_ary => [@$input]
}
);
my $part1 = $res->{output_ary}->[-1];
is( $part1, 19355227, "Part 1: $part1" );
# Part 2
# https://www.reddit.com/r/adventofcode/comments/edntkk/2019_day_21_minimal_instructions/
@ins = ( 'OR B J',
'AND C J',
'NOT J J',
'AND D J',
'AND H J',
'NOT A T',
'OR T J' );
$walk = 'RUN';
$input = undef;
for my $str ( @ins, $walk ) {
my @a = map { ord($_) } ( ( split( //, $str ) ) );
push @$input, ( @a, 10 );
}
$res = run_vm(
{
state => [@$program],
positions => [ 0, 0 ],
input_ary => [@$input]
}
);
my $part2 = $res->{output_ary}->[-1];
is( $part2, 1143802926, "Part 2: $part2" );
done_testing();
sub dump_output {
my ($out) = @_;
while (@$out) {
my $c = shift @$out;
print $c> 127 ? $c : chr($c);
}
}
64 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#! /usr/bin/env perl
use Modern::Perl '2015';
# useful modules
use List::Util qw/sum/;
use Data::Dumper;
use Test::More;
#### INIT - load input data from file into array
my $testing = shift || 0;
my $debug = $testing;
my @file_contents;
# files test{1..4}.txt contain the instructions for the test examples
my $file = $testing ? 'test' . $testing . '.txt' : 'input.txt';
open( my $fh, '<', "$file" ) or die "can't open file $file: $!";
while (<$fh>) { chomp; s/\r//gm; push @file_contents, $_; }
### CODE
my $size = $testing ? 10 : 10_007;
my @deck = ( 0 .. $size - 1 );
for my $instr (@file_contents) {
say "==> $instr" if $debug;
if ( $instr eq 'deal into new stack' ) {
@deck = reverse @deck;
say @deck if $debug;
}
if ( $instr =~ m/cut (-?\d+)/ ) {
my @cut;
if ( $1 > 0 ) {
@cut = splice( @deck, 0, $1 );
@deck = ( @deck, @cut );
}
else {
@cut = splice( @deck, $1 );
@deck = ( @cut, @deck );
}
say @deck if $debug;
}
if ( $instr =~ m/deal with increment (\d+)/ ) {
my $incr = $1;
my $pos = 0;
my @stack;
push @stack, shift @deck; # first card
while (@deck) {
$pos = ( $pos + $incr ) % $size;
$stack[$pos] = shift @deck;
}
@deck = @stack;
say @deck if $debug;
}
}
my $part1;
for ( my $idx = 0 ; $idx < scalar @deck ; $idx++ ) {
if ( $deck[$idx] == 2019 ) {
$part1 = $idx;
last;
}
}
my %correct = (
1 => '0 3 6 9 2 5 8 1 4 7',
2 => '3 0 7 4 1 8 5 2 9 6',
3 => '6 3 0 7 4 1 8 5 2 9',
4 => '9 2 5 8 1 4 7 0 3 6',
live => 6831
);
if ($testing) {
is( join( ' ', @deck ), $correct{$testing}, "test $testing" );
}
else {
is( $part1, $correct{live}, "Part 1: $part1" );
}
done_testing();
64 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#! /usr/bin/env perl
use Modern::Perl '2015';
# useful modules
use List::Util qw/sum all/;
use Data::Dumper;
use Test::More;
use lib '/home/gustaf/prj/AdventOfCode/Intcode';
use Intcode qw/run_vm/;
#### INIT - load input data from file into array
my $testing = 0;
my $debug = 0;
my @file_contents;
my $file = $testing ? 'test.txt' : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @file_contents, $_; }
### CODE
my $program = [ split( /,/, $file_contents[0] ) ];
my %nics;
my %queues;
my $NAT_id = 255;
my $prev_Y = undef;
my $round = 1;
my ( $part1, $part2 ) = ( undef, undef );
# initialize the NICs
foreach my $id ( 0 .. 49 ) {
say "initializing $id... " if $debug;
my $res = run_vm(
{
state => [@$program],
positions => [ 0, 0 ],
input_ary => [$id]
}
);
if ( scalar @{ $res->{output_ary} } > 2 ) { # we get a packet immediately
say " packet emitted..." if $debug;
while ( @{ $res->{output_ary} } ) {
print Dumper @{ $res->{output_ary} } if $debug;
my $dest = shift @{ $res->{output_ary} };
push @{ $queues{$dest} },
[ shift @{ $res->{output_ary} }, shift @{ $res->{output_ary} } ];
}
}
$nics{$id} = {
state => $res->{state},
positions => $res->{positions}
};
}
LOOP: while (1) {
if ($debug) {
foreach my $addr ( sort { $a <=> $b } keys %queues ) {
if ( scalar @{ $queues{$addr} } > 0 ) {
print "$addr: ";
for my $p ( @{ $queues{$addr} } ) {
printf( "[%d,%d]", @$p );
}
print "\n";
}
else {
say "$addr: []";
}
}
}
foreach my $id ( 0 .. 49 ) {
say "NIC $id working..." if $debug;
my @list;
if ( exists $queues{$id} and scalar @{ $queues{$id} } > 0 ) {
while ( @{ $queues{$id} } ) {
say "we have inputs waiting... " if $debug;
push @list, shift @{ $queues{$id} };
}
}
else {
push @list, [-1];
}
while (@list) {
my $res = run_vm(
{
state => $nics{$id}->{state},
positions => $nics{$id}->{positions},
input_ary => shift @list
}
);
if ( scalar @{ $res->{output_ary} } > 2 ) {
say " packet(s) emitted..." if $debug;
while ( @{ $res->{output_ary} } ) {
my ( $dest, $X, $Y ) =
splice( @{ $res->{output_ary} }, 0, 3 );
printf( "[%2d %d %d]", ( $dest, $X, $Y ) ) if $debug;
if ( $dest != $NAT_id ) {
push @{ $queues{$dest} }, [ $X, $Y ];
}
else {
# overwrite existing value
$queues{$dest}->[0] = [ $X, $Y ];
}
print "\n" if $debug;
}
}
$nics{$id} = {
state => $res->{state},
positions => $res->{positions}
};
}
}
# check if every NIC is idle...
if ( all { scalar @{ $queues{$_} } == 0 }
grep { $_ != $NAT_id } keys %queues )
{
if ($debug) {
say "all NICs are idle!";
printf( "[%d,%d]\n", @{ $queues{$NAT_id}->[0] } );
}
if ( $round == 1 ) {
$part1 = $queues{$NAT_id}->[0]->[1];
}
if ( $queues{$NAT_id}->[0]->[1] == $prev_Y ) {
$part2 = $queues{$NAT_id}->[0]->[1];
last LOOP;
}
push @{ $queues{0} }, [ @{ $queues{$NAT_id}->[0] } ];
$prev_Y = $queues{$NAT_id}->[0]->[1];
$round++;
}
}
is( $part1, 23057, "Part 1: $part1" );
is( $part2, 15156, "Part 2: $part2" );
done_testing();
122 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#! /usr/bin/env perl
use Modern::Perl '2015';
# useful modules
use List::Util qw/sum/;
use Data::Dumper;
use Test::More;
#### INIT - load input data from file into array
my $testing = 0;
my @file_contents;
my $file = $testing ? 'test.txt' : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @file_contents, $_; }
### CODE
my $map;
my %patterns;
my $row = 0;
for my $line (@file_contents) {
my $col = 0;
for my $c ( split( //, $line ) ) {
$map->{$row}->{$col} = $c;
$col++;
}
$row++;
}
$patterns{ generate_pattern($map) }++;
my $tick = 0;
my $part1;
LOOP: while (1) {
my $newmap;
for my $r ( 0 .. 4 ) {
for my $c ( 0 .. 4 ) {
my $bugcount = 0;
for my $dir ( [ -1, 0 ], [ 0, 1 ], [ 1, 0 ], [ 0, -1 ] ) {
if ( exists $map->{ $r + $dir->[0] }->{ $c + $dir->[1] }
and $map->{ $r + $dir->[0] }->{ $c + $dir->[1] } eq '#' )
{
$bugcount++;
}
}
if ( $map->{$r}->{$c} eq '.'
and ( $bugcount == 1 or $bugcount == 2 ) )
{
$newmap->{$r}->{$c} = '#';
}
elsif ( $map->{$r}->{$c} eq '#'
and ( $bugcount == 0 or $bugcount > 1 ) )
{
$newmap->{$r}->{$c} = '.';
}
else {
$newmap->{$r}->{$c} = $map->{$r}->{$c};
}
}
}
$map = $newmap;
my $pattern = generate_pattern($map);
if ( exists $patterns{$pattern} ) {
$part1 = $pattern;
last LOOP;
}
$patterns{$pattern}++;
$tick++;
}
is( $part1, 7543003, "Part 1: found recurring pattern at tick $tick: $part1" );
done_testing();
sub generate_pattern {
my ($m) = @_;
my $p = '';
my $pow = 0;
my @bio;
for my $r ( 0 .. 4 ) {
for my $c ( 0 .. 4 ) {
$p .= $m->{$r}->{$c};
if ( $m->{$r}->{$c} eq '#' ) {
push @bio, 2**$pow;
}
$pow++;
}
}
return sum @bio;
# return $p;
}
sub print_map {
my ($m) = @_;
for my $r ( 0 .. 4 ) {
for my $c ( 0 .. 4 ) {
print $m->{$r}->{$c};
}
print "\n";
}
}
87 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#! /usr/bin/env perl
use Modern::Perl '2015';
# useful modules
use List::Util qw/sum/;
use Data::Dumper;
use Test::More;
use lib '/home/gustaf/prj/AdventOfCode/Intcode';
use Intcode qw/run_vm/;
#### INIT - load input data from file into array
my $testing = 0;
my @file_contents;
my $file = $testing ? 'test.txt' : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @file_contents, $_; }
### CODE
my $program = [ split( /,/, $file_contents[0] ) ];
my $input;
# the map has been explored manually
# gather the non-lethal items
my @ins = ( 'north', 'take mouse' );
push @ins, ( 'north', 'take pointer' );
push @ins, qw/south south west/;
push @ins, 'take monolith';
push @ins, qw/north west/;
push @ins, ( 'take food ration', 'south', 'take space law space brochure' );
push @ins, qw/north east south south/;
push @ins, ('take sand');
push @ins, qw/south west/;
push @ins, ( 'take asterisk', 'south', 'take mutex' );
push @ins, qw/north east north north east south south west south/;
# these found by brute forcing all combos
push @ins, 'drop pointer';
push @ins, 'drop monolith';
push @ins, 'drop mouse';
push @ins, 'drop sand';
push @ins, 'east';
for my $str (@ins) {
my @a = map { ord($_) } ( ( split( //, $str ) ) );
push @$input, ( @a, 10 );
}
my $res = run_vm(
{
state => [@$program],
positions => [ 0, 0 ],
input_ary => [@$input]
}
);
print_output( $res->{output_ary} );
sub print_output {
my ($out) = @_;
while (@$out) {
my $c = shift @$out;
print $c> 127 ? $c : chr($c);
}
}
48 lines [ Plain text ] [ ^Top ]
Generated on Thu Dec 26 14:16:40 2019 UTC.