Advent of Code 2019 solutions

These are my solutions for this year's contest.

Main page on my blog.

If you want to copy these files, use the GitHub link.

All files covered by the UNLICENSE.

Table of contents

Advent of Code 2019 day 1 - The Tyranny of the Rocket Equation

[ AoC problem link ] [ Discussion ].

Day 01 - complete solution


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

Advent of Code 2019 day 2 - 1202 Program Alarm

[ AoC problem link ] [ Discussion ].

Day 02 - complete solution


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

Advent of Code 2019 day 3 - Crossed Wires

[ AoC problem link ] [ Discussion ].

Day 03 - complete solution


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

Advent of Code 2019 day 4 - Secure Container

[ AoC problem link ] [ Discussion ].

Day 04 - complete solution


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

Advent of Code 2019 day 5 - Sunny with a Chance of Asteroids

[ AoC problem link ] [ Discussion ].

Day 05 - complete solution


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

Advent of Code 2019 day 6 - Universal Orbit Map

[ AoC problem link ] [ Discussion ].

Day 06 - complete solution


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

Advent of Code 2019 day 7 - Amplification Circuit

[ AoC problem link ] [ Discussion ].

Day 07 - part 1


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

Day 07 - part 2


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

Advent of Code 2019 day 8 - Space Image Format

[ AoC problem link ] [ Discussion ].

Day 08 - complete solution


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

Advent of Code 2019 day 9 - intcode test suite

[ AoC problem link ] [ Discussion ].

Day 09 - complete solution


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

Day 09 - complete solution


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

Advent of Code 2019 day 10 - Monitoring Station

[ AoC problem link ] [ Discussion ].

Day 10 - complete solution


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

Advent of Code 2019 day 11 - Space Police

[ AoC problem link ] [ Discussion ].

Day 11 - complete solution


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

Advent of Code 2019 day 12 - The N-Body Problem

[ AoC problem link ] [ Discussion ].

Day 12 - complete solution


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

Advent of Code 2019 day 13 - Care Package

[ AoC problem link ] [ Discussion ].

Day 13 - complete solution


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

Advent of Code 2019 day 14 - Space Stoichiometry

[ AoC problem link ] [ Discussion ].

Day 14 - complete solution


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

Advent of Code 2019 day 15 - Oxygen System

[ AoC problem link ] [ Discussion ].

Day 15 - complete solution


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

Advent of Code 2019 day 16 - Flawed Frequency Transmission

[ AoC problem link ] [ Discussion ].

Day 16 - part 1


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

Day 16 - part 2


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

Advent of Code 2019 day 17 - Set and Forget

[ AoC problem link ] [ Discussion ].

Day 17 - complete solution


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

Advent of Code 2019 day 19 - Tractor Beam

[ AoC problem link ] [ Discussion ].

Day 19 - complete solution


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

Advent of Code 2019 day 20 - Donut Maze

[ AoC problem link ] [ Discussion ].

Day 20 - part 1


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

Advent of Code 2019 day 21 - Springdroid Adventure

[ AoC problem link ] [ Discussion ].

Day 21 - complete solution


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

Advent of Code 2019 day 22 - Slam Shuffle

[ AoC problem link ] [ Discussion ].

Day 22 - part 1


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

Advent of Code 2019 day 23 - Category Six

[ AoC problem link ] [ Discussion ].

Day 23 - complete solution


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

Advent of Code 2019 day 24 - Planet of Discord

[ AoC problem link ] [ Discussion ].

Day 24 - part 1


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

Advent of Code 2019 day 25 - Cryostasis

[ AoC problem link ] [ Discussion ].

Day 25 - complete solution


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