Advent of Code 2018 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 2018 day 1 - Chronal Calibration

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

#### 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 @list = @input;
my $freq = 0;
while (@list) {
    my $next = shift @list;
    $freq = $freq + $next;
}

say "Part 1: ", $freq;

my %seen = ( 0 => 1 );
$freq = 0;
my $loopcount = 0;
LOOP:
while (1) {
    my @list = @input;

    #    warn "==> $loopcount";
    while (@list) {
        my $next = shift @list;
        $freq = $freq + $next;
        $seen{$freq}++;
        if ( $seen{$freq} > 1 ) {
            last LOOP;
        }
    }
    $loopcount++;
}
say "Part 2: ", $freq;

33 lines [ Plain text ] [ ^Top ]

Advent of Code 2018 day 2 - Inventory Management System

[ AoC problem link ] [ Discussion ].

Day 02 - complete solution


#! /usr/bin/env perl
use Modern::Perl '2015';

# useful modules
use List::Util qw/sum/;
use Data::Dumper;

#### 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 $count_2;
my $count_3;
foreach my $str (@input) {
    my %freq;
    foreach my $chr ( split( //, $str ) ) {
        $freq{$chr}++;
    }
    my $flag_2 = 0;
    my $flag_3 = 0;
    foreach my $k ( keys %freq ) {
        $flag_2++ if $freq{$k} == 2;
        $flag_3++ if $freq{$k} == 3;
    }
    $count_2++ if $flag_2;
    $count_3++ if $flag_3;
}

say "Part 1: ", $count_2 * $count_3;

LOOP:
foreach my $str1 (@input) {
    foreach my $str2 (@input) {
        next if ( $str1 eq $str2 );

        my @a1 = split( //, $str1 );
        my @a2 = split( //, $str2 );
        my @diffs;
        for ( my $i = 0 ; $i < scalar @a1 ; $i++ ) {
            if ( $a1[$i] ne $a2[$i] ) {
                push @diffs, $i;
            }
        }

        if ( scalar @diffs == 1 ) {
            my $res;
            my $same = $diffs[0];
            for ( my $i = 0 ; $i < scalar @a1 ; $i++ ) {
                $res .= $a1[$i] unless $i == $same;
            }
            say "Part 2: ", $res;
            last LOOP;
        }
    }
}

48 lines [ Plain text ] [ ^Top ]

Advent of Code 2018 day 3 - No Matter How You Slice It

[ AoC problem link ] [ Discussion ].

Day 03 - complete solution


#! /usr/bin/env perl
use Modern::Perl '2015';

# useful modules
use List::Util qw/sum/;
use Data::Dumper;

#### 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 %swatches;
foreach my $line (@input) {
    if ( $line =~ m/\#(\d+)\ \@\ (\d+)\,(\d+)\:\ (\d+)x(\d+)/ ) {
	$swatches{$1} = { col => $2, row => $3, w => $4, h => $5 };
    }
    else {
        die "can't parse: $line";
    }
}

# populate the grid
my %grid;
foreach my $id ( keys %swatches ) {
    my ( $col, $row, $w, $h ) = map { $swatches{$id}->{$_} } qw/col row w h/;
    for ( my $c = $col ; $c < $col + $w ; $c++ ) {
        for ( my $r = $row ; $r < $row + $h ; $r++ ) {
            push @{ $grid{$c}->{$r} }, $id;
        }
    }
}

# count populated
my $count;
my %candidates;
foreach ( my $c = 0 ; $c < 1000 ; $c++ ) {
    foreach ( my $r = 0 ; $r < 1000 ; $r++ ) {
        next unless exists $grid{$c}->{$r};
        $count++ if scalar @{ $grid{$c}->{$r} } > 1;

        # which swatches are only on one square?
        if ( scalar @{ $grid{$c}->{$r} } == 1 ) {
            push @{ $candidates{ $grid{$c}->{$r}->[0] } }, [ $c, $r ];
        }
    }
}

say "Part 1: ", $count;

# compare one-square candidates with known swatches
# it turns out there's only one!
foreach my $id ( keys %candidates ) {

    if ( $swatches{$id}->{w} * $swatches{$id}->{h} ==
        scalar @{ $candidates{$id} } )
    {
        say "Part 2: ", $id;
    }
}

46 lines [ Plain text ] [ ^Top ]

Advent of Code 2018 day 4 - Repose Record

[ AoC problem link ] [ Discussion ].

Day 04 - complete solution


#! /usr/bin/env perl
use Modern::Perl '2015';

# useful modules
use List::Util qw/sum minstr maxstr/;
use Data::Dumper;

#### 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 $debug = 0;
my $id    = undef;
my %stats;
my %minutes;
my $awake = undef;
my ( $start, $end ) = ( undef, undef );
foreach my $line ( sort @input ) {
    my ( $h, $m ) = $line =~ m/ (\d{2}):(\d{2})\]/;
    if ( $line =~ m/Guard \#(\d+)/ ) {
        $id    = $1;
        $awake = 1;
        ( $start, $end ) = ( undef, undef );
    }
    if ( $line =~ m/falls asleep/ and $awake ) {
        $awake = 0;
        $start = $m;
    }
    if ( $line =~ m/wakes up/ and !$awake ) {
        $awake = 1;
        $end   = $m;
    }
    if ( defined $start and defined $end ) {
        push @{ $stats{$id}->{spans} }, [ $start, $end ];
        for ( my $i = $start ; $i < $end ; $i++ ) {
            $stats{$id}->{freq}->{$i}++;
            $minutes{$i}->{$id}++;
        }
        ( $start, $end ) = ( undef, undef );
    }
}

# Part 1

# Find the guard that has the most minutes asleep. What minute does
# that guard spend asleep the most?

my $maxsum = { id => -1, val => 0 };
foreach my $id ( keys %stats ) {
    my $sum = 0;
    foreach my $span ( @{ $stats{$id}->{spans} } ) {
        $sum += $span->[1] - $span->[0];
    }
    if ( $sum > $maxsum->{val} ) {
        $maxsum->{val} = $sum;
        $maxsum->{id}  = $id;
    }
}
my $sought_id = $maxsum->{id};

my $most_m = (
    sort {
        $stats{$sought_id}->{freq}->{$b} <=> $stats{$sought_id}->{freq}->{$a}
    } keys %{ $stats{$sought_id}->{freq} }
)[0];

say "Part 1: ", $sought_id * $most_m;

# Part 2

# Of all guards, which guard is most frequently asleep on the same minute?

my $maxasleep = { val => 0, id => -1, sought => 0 };

foreach my $min ( sort { $a <=> $b } keys %minutes ) {
    my $most_asleep = ( sort { $minutes{$min}->{$b} <=> $minutes{$min}->{$a} }
          keys %{ $minutes{$min} } )[0];

    if ( $minutes{$min}->{$most_asleep} > $maxasleep->{val} ) {
        $maxasleep->{val}    = $minutes{$min}->{$most_asleep};
        $maxasleep->{id}     = $most_asleep;
        $maxasleep->{sought} = $min;
    }
}

say "Part 2: ", $maxasleep->{sought} * $maxasleep->{id};

67 lines [ Plain text ] [ ^Top ]

Advent of Code 2018 day 5 - Alchemical Reduction

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

#### INIT - load input data from file into array
my $testing = 0;
my $debug   = 0;
my @input;
my $file = $testing ? 'test.txt' : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }

### CODE

sub is_match {
    my ( $k, $m ) = @_;

    #my @in = split(//,$in);
    if ( abs( ord( $k ? $k : '' ) - ord($m) ) == 32 ) {
        return 1;
    }
    else {
        return 0;
    }
}

sub reduce {
    my ($str) = @_;
    my @in = split( //, $str );
    my @next;
    push @next, shift @in;
    while (@in) {
        my $unit = shift @in;
        if ( is_match( $next[-1], $unit ) ) {
            pop @next;
        }
        else {
            push @next, $unit;
        }
    }
    return scalar @next;
}

say "Part 1: ", reduce( $input[0] );

my $min = length( $input[0] );
foreach my $c ( 'a' .. 'z' ) {
    my $u         = uc $c;
    my $shortened = $input[0];
    $shortened =~ s/[$c,$u]//g;
    if ( $min > reduce($shortened) ) {
        $min = reduce($shortened);
    }
}
say "Part 2: $min";


46 lines [ Plain text ] [ ^Top ]

Advent of Code 2018 day 6 - Chronal Coordinates

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

#### INIT - load input data from file into array
my $testing = 0;
my $debug   = 0;
my @input;
my $file = $testing ? 'test.txt' : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }

### CODE

sub manhattan_distance {
    my ( $p, $q ) = (@_);
    return abs( $p->[0] - $q->[0] ) + abs( $p->[1] - $q->[1] );
}
my $LIMIT = $testing ? 32 : 10000;

my $index = 1;

my @labels = ( 'A' .. 'F' );    # for testing

my %points;
my ( $maxcol, $maxrow ) = ( 0,    0 );
my ( $mincol, $minrow ) = ( 10e6, 10e6 );
foreach my $line (@input) {
    my ( $c, $r ) = $line =~ /(\d+)\,\ (\d+)/;
    $maxcol = $c if $c > $maxcol;
    $maxrow = $r if $r > $maxrow;
    $mincol = $c if $c < $mincol;
    $minrow = $r if $r < $minrow;

    my $label = $testing ? shift @labels : $index;
    $points{$label} = { row => $r, col => $c };
    $index++;

}

my @sought;
my %areas;
my %on_edges;
foreach my $r ( $minrow .. $maxrow ) {
    foreach my $c ( $mincol .. $maxcol ) {

        my %dists;
        foreach my $label ( keys %points ) {
            next if $label eq '.';

            # calculate the manhattan_distance to each point from where we are
            # add to the tally of closest
            my $d =
              manhattan_distance( [ map { $points{$label}->{$_} } qw/col row/ ],
                [ $c, $r ] );
            push @{ $dists{$d} }, $label;

        }

        my $sum;
        my $count = 0;
        foreach my $d ( sort { $a <=> $b } keys %dists ) {
            if ( !$count ) {
                my @closest = @{ $dists{$d} };
                if ( scalar @closest == 1 ) {
                    $points{ $closest[0] }->{count}++;
                    $on_edges{ $closest[0] }++
                      if ( $c == $mincol
                        or $c == $maxcol
                        or $r == $minrow
                        or $r == $maxrow );
                }
                else {    # more than 2 coordinates closest
                    $points{'.'}->{count}++;
                }

            }
            $sum += $d * scalar @{ $dists{$d} };
            $count++;
        }
        if ( $sum < $LIMIT ) {
            push @sought, [ $r, $c ];
        }
    }
}

my $largest_id = (
    grep { !exists $on_edges{$_} }
    sort { $points{$b}->{count} <=> $points{$a}->{count} } keys %points
)[0];
say "Part 1: ", $points{$largest_id}->{count};
say "Part 2: ", scalar @sought;

75 lines [ Plain text ] [ ^Top ]

Advent of Code 2018 day 7 - The Sum of Its Parts

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

#### 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 %graph;
foreach my $line (@input) {
    my ( $input, $output ) = $line =~ /^Step (.) .*step (.) can begin.$/;
    $graph{$output}->{from}->{$input}++;
    $graph{$input}->{to}->{$output}++;
}
my @queue;

push @queue,
  sort grep { scalar keys %{ $graph{$_}->{from} } == 0 } keys %graph;

my @result;
my %processed;
while (@queue) {
    my $next = shift @queue;
    push @result, $next;
    $processed{$next}++;

    my @possible = keys %{ $graph{$next}->{to} };

    # can we add to queue?
    while (@possible) {
        my $candidate = shift @possible;
        my $ok        = 1;
        foreach my $r ( keys %{ $graph{$candidate}->{from} } ) {
            $ok = 0 unless exists $processed{$r};
        }
        push @queue, $candidate if $ok;
    }
    @queue = sort @queue;

}

say "Part 1: ", @result;

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

#### INIT - load input data from file into array
my $testing = 0;
my $debug = 0;
my @input;
my $file = $testing ? 'test.txt' : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }

### CODE

my $threshold = $testing? 0 : 60;

sub time_per_task {
    my ( $label ) = @_;
    return $threshold + ord( $label ) - 64;
}
my $no_of_workers = $testing ? 2 : 5;
my %graph;
foreach my $line (@input) {
    my ( $input, $output ) = $line =~ /^Step (.) .*step (.) can begin.$/;
    $graph{$output}->{from}->{$input}++;
    $graph{$input}->{to}->{$output}++;

}

my @queue;
push @queue, sort grep {scalar keys %{$graph{$_}->{from}}==0}  keys %graph;
my @result;
my @workers = (1..$no_of_workers);
my @processing;
my %processed;
my $time = 0;
my %pool;
# seed the pool
for (@queue ) {
    my $w = shift @workers;
    $pool{$_} = {worker=>$w, time=>time_per_task( $_ )} if defined $w;
}

sub dump_state {
    my $ws;
    foreach my $k(sort keys %pool) {
	$ws .= "$k w=$pool{$k}->{worker} t=$pool{$k}->{time} ";
    }
    printf("T=%4d Q=(%s) R=(%s) W=[ %s]\n",
	  $time, join('',@queue),join('',@result),$ws?$ws:'');
}
dump_state if $debug;
while (@queue) {
    # scan the pool, decrementing time
    my @finished;
    while (my ($task, $data) = each %pool)      {
	$data->{time}--;
	if ($data->{time}==0) {
	   push @finished,$task;
	    push @workers, $data->{worker};
	    delete $pool{$task}
	}
    }
    while (@finished) {
	my $done =shift @finished;
	push @result, $done;
	$processed{$done}++;
	# modify the queue
	my @newqueue;
	while (@queue) {
	    my $val = shift @queue;
	    push @newqueue, $val unless $val eq $done;
	}
	@queue = @newqueue;

	# we have processed stuff, so check for new entries
	my @possible = keys %{$graph{$done}->{to}};
	# can we add to queue?
	while (@possible) {
	    my $candidate = shift @possible;
	    my $ok =1;
	    foreach my $r (keys %{$graph{$candidate}->{from}}) {
		$ok = 0 unless exists $processed{$r};
	    }
	    push @queue, $candidate if $ok;
	}
	# assign new worker
	@queue = sort @queue;
	for (@queue) {
	    next if exists $pool{$_};
	    my $w = shift @workers;

	    $pool{$_} = {worker => $w, time=>time_per_task( $_ )}
	      if defined $w;

	}
    }
    $time++;
    dump_state if $debug;

}

say "Part 2: ",$time;

88 lines [ Plain text ] [ ^Top ]

Advent of Code 2018 day 8 - Memory Maneuver

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

#### 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 $data = [ split / /, $input[0] ];

sub parse_tree;
sub get_meta_sum;
sub get_node_values;

my $tree = parse_tree($data);

say "Part 1: ", get_meta_sum($tree);
say "Part 2: ", get_node_values($tree);

sub parse_tree {
    my ($in) = @_;
    my ( $nr_children, $nr_meta ) = splice @{$in}, 0, 2;
    my $node;
    foreach ( 1 .. $nr_children ) {
        push @{ $node->{C} }, parse_tree($in);
    }
    $node->{M} = [ splice @{$in}, 0, $nr_meta ];
    return $node;
}

sub get_meta_sum {
    my ($in) = @_;
    my $sum;
    foreach my $node ( @{ $in->{C} } ) {
        $sum += get_meta_sum($node);
    }
    $sum += sum @{ $in->{M} };
    return $sum;
}

sub get_node_values {
    my ($in) = @_;
    my $sum;
    if ( @{ $in->{C} } ) {
        foreach my $m ( @{ $in->{M} } ) {
            $sum += get_node_values( $in->{C}->[ $m - 1 ] )
              if defined $in->{C}->[ $m - 1 ];
        }
    }
    else {
        $sum += sum @{ $in->{M} };
    }

    return $sum;
}

48 lines [ Plain text ] [ ^Top ]

Advent of Code 2018 day 9 - Marble Mania

[ AoC problem link ] [ Discussion ].

Day 09 - complete solution


#! /usr/bin/env perl
use Modern::Perl '2015';

# useful modules
use List::Util qw/sum max/;

#### INIT - load input data from file into array
my $testing = 0;
my $debug   = 0;
my @input;
my $file = $testing ? 'test.txt' : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }

### CODE
my ( $no_of_players, $last_marble ) =
  $input[0] =~ /^(\d+).* worth (\d+) points/;

# give an argument, any argument, for part 2
my $part2 = shift @ARGV // undef;

my @players = ( 1 .. $no_of_players );
my %score;
sub add_to_circle;
sub remove_from_circle;
sub print_circle;

# initialize our data structure (circular double-linked list
my $circle->{0} = { next => 0, prev => 0 };
my $current = 0;
$last_marble = 100 * $last_marble if $part2;
my @marbles = ( 1 .. $last_marble );
while (@marbles) {

    my @list = @players;

    # play
    while (@list) {
        my $current_player = shift @list;
        my $marble         = shift @marbles;
        last unless defined $marble;    # don't overrun the number of marbles!
        if ( $marble % 23 == 0 ) {
            my $removed = remove_from_circle;
            $score{$current_player} += ( $marble + $removed );
        }
        else {
            $current = add_to_circle($marble);
        }
    }
}

say 'Part ', $part2 ? '2: ' : '1: ', max values %score;

sub add_to_circle {
    my ($new_val) = @_;
    my $one       = $circle->{$current}->{next};
    my $two       = $circle->{$one}->{next};

    # insert between one and two
    $circle->{$new_val}->{prev} = $one;
    $circle->{$new_val}->{next} = $two;

    $circle->{$one}->{next} = $new_val;
    $circle->{$two}->{prev} = $new_val;
    return $new_val;
}

sub remove_from_circle {

    my $steps   = 0;
    my $pointer = $current;

    # hardcoded 7 steps
    while ( $steps < 7 ) {
        $pointer = $circle->{$pointer}->{prev};
        $steps++;
    }

    my $prev = $circle->{$pointer}->{prev};
    my $next = $circle->{$pointer}->{next};

    $circle->{$prev}->{next} = $next;
    $circle->{$next}->{prev} = $prev;
    $current                 = $next;
    delete $circle->{$pointer};
    return $pointer;
}

sub print_circle {
    my $start = 0;
    my @list;
    push @list, $start;
    my $next = $circle->{$start}->{next};
    while ($next) {
        $next = $circle->{$start}->{next};
        push @list, $next;
        $start = $next;
    }
    pop @list;
    say join( ' ', @list );
}

77 lines [ Plain text ] [ ^Top ]

Advent of Code 2018 day 10 - The Stars Align

[ AoC problem link ] [ Discussion ].

Day 10 - complete solution


#! /usr/bin/env perl
use Modern::Perl '2015';

# useful modules
use List::Util qw/sum/;
use Data::Dumper;

#### 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

# load into an array of positions and velocities, keep track of
# initial size
my ( $X, $Y ) = ( 0, 1 );
my $state;
my $velocity;
my $bounds = { map { $_ => 0 } qw(xmax xmin ymax ymin) };
while (@input) {
    my $line = shift @input;
    my ( $pos, $vel ) = $line =~ m/<(.*)>.*<(.*)>$/;
    my ( $x,   $y )   = split /\,/, $pos;
    my ( $vx,  $vy )  = split /\,/, $vel;

    push @{$velocity}, [ $vx, $vy ];
    push @{$state},    [ $x,  $y ];

    $bounds->{xmax} = $x if $x > $bounds->{xmax};
    $bounds->{ymax} = $y if $y > $bounds->{ymax};
    $bounds->{xmin} = $x if $x < $bounds->{xmin};
    $bounds->{ymin} = $y if $y < $bounds->{ymin};
}
my $count = 0;
# assuming we converge to a minimal state space... print that!
while (1) {
    my $new_bounds = { map { $_ => 0 } qw(xmax xmin ymax ymin) };
    my $new_state;
    for ( my $idx = 0 ; $idx < scalar @{$state} ; $idx++ ) {
        my $x = $state->[$idx]->[$X] + $velocity->[$idx]->[$X];
        my $y = $state->[$idx]->[$Y] + $velocity->[$idx]->[$Y];

        $new_state->[$idx]->[$X] = $x;
        $new_state->[$idx]->[$Y] = $y;

        $new_bounds->{xmax} = $x if $x > $new_bounds->{xmax};
        $new_bounds->{ymax} = $y if $y > $new_bounds->{ymax};
        $new_bounds->{xmin} = $x if $x < $new_bounds->{xmin};
        $new_bounds->{ymin} = $y if $y < $new_bounds->{ymax};
    }

    # area expanding?

    if ( ( $new_bounds->{xmax} - $new_bounds->{xmin} ) >
            ( $bounds->{xmax} - $bounds->{xmin} )
        and ( $new_bounds->{ymax} - $new_bounds->{ymin} ) >
        ( $bounds->{ymax} - $bounds->{ymin} ) )
    {
        # keep the last known state, break out of loop
        last;
    }
    $state  = $new_state;
    $bounds = $new_bounds;
    $count++;
}

# print results!

my $grid;
foreach my $p ( @{$state} ) {
    $grid->{ $p->[$Y] }->{ $p->[$X] }++;
}

say "Part 1:";
foreach my $y ( 0 .. ( $bounds->{ymax} ) ) {
    my $line;
    foreach my $x ( 0 .. ( $bounds->{xmax} ) ) {
        if ( exists $grid->{$y}->{$x} ) {
            $line .= '#';
        }
        else {
            $line .= ' ';
        }
    }

    # some whitespace munging to clean up the output
    $line =~ s/^\s+//;
    next if length($line) == 0;
    say $line;
}

say "Part 2: ", $count;

72 lines [ Plain text ] [ ^Top ]

Advent of Code 2018 day 11 - Chronal Charge

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

#### INIT - load input data from file into array
my $testing = 0;

my (@in) = @ARGV;
my ( $test_x, $test_y, $serial );
if ( scalar @in > 0 ) {    # testing input
    ( $test_x, $test_y, $serial ) = @in;
}
else {
    $serial = 3628;
}

### CODE
my $MAX = 300;
sub power_level;
sub subsquare_sum;

# precalculate subsquares
# https://en.wikipedia.org/wiki/Summed-area_table
my $grid;
my $SA;

# some pre-init to prevent warnings later
map { $SA->[0]->[$_] = 0 } ( 0 .. $MAX );
map { $SA->[$_]->[0] = 0 } ( 0 .. $MAX );

foreach my $x ( 1 .. $MAX ) {
    foreach my $y ( 1 .. $MAX ) {
        my $val = power_level( $x, $y, $serial );
        $grid->[$x]->[$y] = $val;
        my $sum = $grid->[$x]->[$y];
        $sum += $SA->[$x]->[ $y - 1 ];
        $sum += $SA->[ $x - 1 ]->[$y];
        $sum -= $SA->[ $x - 1 ]->[ $y - 1 ];

        $SA->[$x]->[$y] = $sum;
    }
}

my $global_max = { x => 0, y => 0, val => 0, grid => 0 };
my $gridsize;
foreach $gridsize ( 1 .. 20 ) {   # cutoff found by inspection

    my $local_max = { x => 0, y => 0, val => 0 };

    foreach my $x ( 1 .. $MAX - $gridsize ) {
        foreach my $y ( 1 .. $MAX - $gridsize ) {
            my $sum = subsquare_sum( [ $x - 1, $y - 1 ],
                [ $x + $gridsize, $y + $gridsize ] );

            $global_max = { x => $x, y => $y, val => $sum, grid => $gridsize }
              if $sum > $global_max->{val};

	    $local_max = { x => $x, y => $y, val => $sum }
              if $sum > $local_max->{val} and $gridsize==2;
        }
    }
    if ( $gridsize == 2 ) {
        say "Part 1: ", join( ',', map { $global_max->{$_} } qw/x y/ );
    }
}
say "Part 2: ",
  join( ',', ( map { $global_max->{$_} } qw/x y/ ), $global_max->{grid} + 1 );

### SUBS

sub power_level {
    my ( $x, $y, $s ) = @_;
    my $rack_id     = $x + 10;
    my $power_level = $rack_id * $y;
    $power_level = $power_level + $s;
    $power_level = $power_level * $rack_id;
    if ( $power_level < 100 ) {
        $power_level = 0;
    }
    else {
        $power_level = int( $power_level / 100 );
        $power_level = $power_level % 10;
    }
    return $power_level - 5;
}

sub subsquare_sum {
    my ( $top_left, $bottom_right ) = @_;
    my ( $x_0,      $y_0 )          = @{$top_left};
    my ( $x_1,      $y_1 )          = @{$bottom_right};

    return $SA->[$x_1]->[$y_1] +
      $SA->[$x_0]->[$y_0] -
      $SA->[$x_1]->[$y_0] -
      $SA->[$x_0]->[$y_1];
}


74 lines [ Plain text ] [ ^Top ]

Advent of Code 2018 day 12 - Subterranean Sustainability

[ AoC problem link ] [ Discussion ].

Day 12 - part 1


#! /usr/bin/env perl
use Modern::Perl '2015';

# useful modules
use List::Util qw/min  max sum first/;
use List::MoreUtils qw/first_index/;
use Data::Dumper;
use Clone 'clone';
#### 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 $iterations = shift @ARGV || 20;

my $state;
my %patterns;

foreach my $line (@input) {
    if ( $line =~ m/^initial state: (.*)$/ ) {

        my @in = split //, $1;
        my $id = 0;
        while (@in) {
            my $pot = shift @in;
            push @{$state}, { id => $id, status => $pot };
            $id++

        }
    }
    elsif ( $line =~ m/^(\S{5}) \=\> (.$)/ ) {

        $patterns{$1} = $2;
    }
}

my $round = 0;
while ( $round < $iterations ) {

    # add pots to the beginning and the end
    my $first_id = $state->[0]->{id};
    my $last_id  = $state->[-1]->{id};

    unshift @{$state},
      map { { id => $first_id - $_, status => '.' } } ( -4, -3, -2, -1 );
    push @{$state},
      map { { id => $last_id + $_, status => '.' } } ( 1, 2, 3, 4 );

    if ($testing) {
        my $str;
        foreach my $pot ( @{$state} ) {
            $str .= $pot->{status} if $pot->{id} >= -5;
        }
        printf "%2d %s\n", $round, $str;
    }
    my $new_state = clone $state;

    for ( my $idx = 2 ; $idx <= $#{$state} - 2 ; $idx++ ) {
        my $pattern;
        foreach my $offset ( -2, -1, 0, 1, 2 ) {
            $pattern .= $state->[ $idx + $offset ]->{status};
        }

        if ( exists $patterns{$pattern} ) {

            $new_state->[$idx]->{status} = $patterns{$pattern};
        }
        else {

            if ($testing) {
                $new_state->[$idx]->{status} = '.';
            }
            else {

                die "can't find $pattern in list!";
            }

        }

    }
    $state = clone $new_state;

    $round++;
}

my $sum;

my $count;
my $first = 0;

foreach my $pot ( @{$state} ) {

    if ( $pot->{status} eq '#' ) {
        $first = $pot->{id} unless $first;
        $count++;

        $sum += $pot->{id};
    }

}

my $str = join '', map { $_->{status} } @{$state};
$str =~ s/^\.+//;
$str =~ s/\.+$//;

if ($iterations == 20) {
    say "Part 1: ", $sum;
} else {
    # output to research part 2
    say join( ' ', $iterations, $count, $first, $sum, $str );
}

83 lines [ Plain text ] [ ^Top ]

Day 12 - part 2


#! /usr/bin/env perl
use Modern::Perl '2015';

### CODE
my $in = shift @ARGV || 50_000_000_000;
die "input must be >= 129" unless $in>=129;

# these patterns and constants found by inspecting output of part 1
my $pattern = '##...##...##...##...##...##...##...##...##...##...##...##...##...##...##...##...##...##...##...##...##...##...##...##...##...##';
my $offset = 26;
my $sum = -52;

my $index = $in-$offset;

my @list = split //,$pattern;
while (@list) {
    my $token =shift @list;
    if ($token eq '#') {
	$sum += $index;
    }
    $index++;
}
say "Part 2: ", $sum;


16 lines [ Plain text ] [ ^Top ]

Advent of Code 2018 day 13 - Mine Cart Madness

[ 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 Clone qw/clone/;
#### INIT - load input data from file into array
my $testing = 0;
my $debug   = 0;
my @input;
my $file = $testing ? 'test.txt' : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }

### CODE
my ( $X, $Y ) = ( 0, 1 );

my $Track;
my $Cars;

my %rail_types = map { $_ => 1 } qw {/ \ | - +  };
my %car_types  = map { $_ => 1 } qw {> < ^ v};

my $row = 0;
my $col;
my $car_id = 1;

while (@input) {
    my $curr = shift @input;
    $col = 0;
    foreach my $el ( split //, $curr ) {
        if ( defined $rail_types{$el} ) {
            $Track->[$col]->[$row] = $el;
        }
        elsif ( defined $car_types{$el} ) {

            # mark position on Track, but rail type currently unknown
            # it's given it's always on straight track

            if ( $el eq '>' or $el eq '<' ) {
                $Track->[$col]->[$row] = '-';
            }
            elsif ( $el eq '^' or $el eq 'v' ) {
                $Track->[$col]->[$row] = '|';
            }
            $Cars->{$car_id} =
              { x => $col, y => $row, dir => $el, turns => [qw/L S R/] };
            $car_id++;

        }
        $col++;
    }
    $row++;
}

my %turn_left  = ( '>' => '^', '^' => '<', '<' => 'v', 'v' => '>' );
my %turn_right = ( '>' => 'v', 'v' => '<', '<' => '^', '^' => '>' );

my %move = (
    '>' => sub { my ($p) = @_; return [ $p->[$X] + 1, $p->[$Y] ] },
    '<' => sub { my ($p) = @_; return [ $p->[$X] - 1, $p->[$Y] ] },
    '^' => sub { my ($p) = @_; return [ $p->[$X], $p->[$Y] - 1 ] },
    'v' => sub { my ($p) = @_; return [ $p->[$X], $p->[$Y] + 1 ] },
);

my %turn = (
    '-'  => sub { return $_[0] },
    '|'  => sub { return $_[0] },
    '/'  => \&turn_1,
    '\\' => \&turn_2,
    '+'  => \&crossroads
);

### MAIN LOOP

my $tick             = 0;
my $no_of_collisions = 0;
while (1) {
    my @removed;
    foreach my $id (
        sort {
                 $Cars->{$a}->{y} <=> $Cars->{$b}->{y}
              || $Cars->{$a}->{x} <=> $Cars->{$b}->{x}
        }
        keys %{$Cars}
      )
    {

        my ( $dir, $x, $y, $next_turn ) =
          map { $Cars->{$id}->{$_} } qw/dir x y turns/;

        my $newpos = $move{$dir}->( [ $x, $y ] );

        # collision?

        my @crash = grep {
            $Cars->{$_}->{x} == $newpos->[$X]
              and $Cars->{$_}->{y} == $newpos->[$Y]
        } keys %{$Cars};
        if (@crash) {
            if ( $no_of_collisions == 0 ) {
                say "Part 1: ", join( ',', @{$newpos} );
                $no_of_collisions++;
            }
            push @removed, ( @crash, $id );
        }

        # what's under the new position, do we have to change direction?

        my $type = $Track->[ $newpos->[$X] ]->[ $newpos->[$Y] ];

        die "off the rails at ", join( ',', @{$newpos} ) unless defined $type;

        my $newdir;

        if ( $type eq '+' ) {    # need to check which direction to choose
            my $choice = shift @{$next_turn};
            push @{$next_turn}, $choice;
            $newdir = $turn{$type}->( $dir, $choice );
        }
        else {
            $newdir = $turn{$type}->($dir);
        }

        # update this car with new info

        $Cars->{$id} = {
            x     => $newpos->[$X],
            y     => $newpos->[$Y],
            dir   => $newdir,
            turns => $next_turn
        };

    }
    if (@removed) {
        foreach my $car (@removed) {
            delete $Cars->{$car};
        }
    }
    if ( keys %{$Cars} == 1 ) {    # last one!

        #		print Dumper $Cars;
        say "Part 2: ", join ',',
          map { $Cars->{ ( keys %{$Cars} )[0] }->{$_} } qw/x y/;
        last;
    }

    $tick++;
}

### SUBS

sub turn_1 {    # denoted by /
    my %newdirs = ( '>' => '^', '<' => 'v', '^' => '>', 'v' => '<' );
    return $newdirs{ $_[0] };
}

sub turn_2 {    # denoted by \
    my %newdirs = ( '>' => 'v', '<' => '^', '^' => '<', 'v' => '>' );
    return $newdirs{ $_[0] };
}

sub crossroads {
    my ( $dir, $choice ) = @_;
    return $dir              if $choice eq 'S';
    return $turn_left{$dir}  if $choice eq 'L';
    return $turn_right{$dir} if $choice eq 'R';
}

130 lines [ Plain text ] [ ^Top ]

Advent of Code 2018 day 14 - Chocolate Charts

[ AoC problem link ] [ Discussion ].

Day 14 - part 1


#! /usr/bin/env perl
use Modern::Perl '2015';
# useful modules
use List::Util qw/sum/;

### CODE

my $target = shift @ARGV || 890691;

my $debug = 0;
my @recipes = (3,7);
my %elves= (e1 => 0, e2=>1 );

my $rounds = 0;

# we need 10 more entries than our target
while (scalar @recipes <= $target+10 ) {

    # create new recipes
    my @newrec = split(//, sum (map {$recipes[$elves{$_}] } qw/e1 e2/  ));
    push @recipes, @newrec;

    # move the elves
    foreach my $e (keys %elves) {
	my $newpos = $elves{$e} + 1 + $recipes[$elves{$e}];
	if ($newpos > $#recipes) {
	    $newpos %= @recipes;
	}
	say $newpos if $debug;
	$elves{$e} = $newpos;
    }
    $rounds++;
}

my @sought = @recipes[$target..$target+9];
say "Part 1: ",join('', @sought);

24 lines [ Plain text ] [ ^Top ]

Day 14 - part 2


#! /usr/bin/env perl
use Modern::Perl '2015';

# useful modules

use List::Util qw/sum/;

### CODE

my $target = shift @ARGV || 890691;

my $debug   = 0;
my @recipes = ( 3, 7 );
my %elves   = ( e1 => 0, e2 => 1 );

my $rounds = 0;
my $len    = length($target);

while (1) {
    no warnings qw/uninitialized/;
    say "> $rounds" if $rounds % 100_000 == 0;

    # create new recipes
    my @newrec = split( //, sum( map { $recipes[ $elves{$_} ] } qw/e1 e2/ ) );
    say join ' ', @newrec if $debug;

    push @recipes, @newrec;

    # move the elves
    foreach my $e ( keys %elves ) {

        my $newpos = $elves{$e} + 1 + $recipes[ $elves{$e} ];

        if ( $newpos > $#recipes ) {

            $newpos %= @recipes;
        }
        say $newpos if $debug;
        $elves{$e} = $newpos;
    }

    if ( join( '', @recipes[ -8 .. -1 ] ) =~ /$target/ ) {
        say "Part 2: ", index( join( '', @recipes ), $target );

        last;
    }
    $rounds++;
}

30 lines [ Plain text ] [ ^Top ]

Generated on Fri Dec 14 14:47:07 2018 UTC.