Advent of Code 2017 solutions

This 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 2017 day 1

[ AoC problem link ] [ Discussion ].

Day 1 - complete solution


#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;

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

### CODE
my @list   = split( //, shift @input );
my $length = scalar @list;
my $sum_1  = 0;
my $sum_2  = 0;

# circular list, just make a copy to avoid funky rollover arithmetic
my @check = ( @list, @list );
for ( my $i = 0 ; $i <= $length - 1 ; $i++ ) {
    my $j = $i + $length / 2;
    if ( $check[$i] == $check[ $i + 1 ] ) { $sum_1 += $check[$i] }

    if ( $check[$i] == $check[$j] ) { $sum_2 += $check[$i] }
}
say "Captcha 1: $sum_1";
say "Captcha 2: $sum_2";

22 lines [ Plain text ] [ ^Top ]

Advent of Code 2017 day 2

[ AoC problem link ] [ Discussion ].

Day 2 - complete solution


#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;
use List::Util qw/max min/;

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

### CODE
my $sum_1 = 0;
my $sum_2 = 0;
foreach my $line (@input) {

    # sort the values for easier division comparison down the line
    my @row = sort { $b <=> $a } split( /\s+/, $line );

    $sum_1 += $row[0] - $row[$#row];

    my $found = 0;
    while ( @row and !$found ) {
        my $a = shift @row;
	# using a reverse here slightly increases the chance of
	# finding a divisor faster
        foreach my $b ( reverse @row) {
            if ( $a % $b == 0 ) {
                $sum_2 += $a / $b;
                $found = 1;
            }
        }
    }
}
say "Checksum      : $sum_1";
say "Sum of results: $sum_2";

29 lines [ Plain text ] [ ^Top ]

Advent of Code 2017 day 3

[ AoC problem link ] [ Discussion ].

Day 3 - part 1


#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;
use List::Util qw/min/;

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

### CODE
my $target = $input[0];

sub diagonal_values {
    # from Project Euler 28, the values of numbers on diagonals
    my ($x) = @_;
    my $n = 2 * $x + 1;
    return [
        $n * $n - 3 * $n + 3,
        $n * $n - 2 * $n + 2,
        $n * $n - $n + 1,
        $n * $n
    ];
}

my $x        = 0;
my $distance = 0;
while (1) {
    my $diags = diagonal_values($x);

    # find the "ring" where the target value lies
    if ( $target >= $diags->[0] and $target <= $diags->[3] ) {

        # the diagonal values represent the largest Manhattan distance 2x
        # find the minimum distance to the diagonals
        my $min = min( map { abs( $target - $diags->[$_] ) } ( 0, 1, 2, 3 ) );
        $distance = 2 * $x - $min;
        last;
    }
    $x++;
}

say "Steps to take: $distance";

35 lines [ Plain text ] [ ^Top ]

Day 3 - part 2


#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;
use List::Util qw/sum/;

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

### CODE

#### subs

# these are from the chapter on iterators in HOP, but not in a
# separate module
sub NEXTVAL      { $_[0]->() }
sub Iterator (&) { return $_[0] }

# an iterator for steplengths
# we go 1,1,2,2,3,3,... steps before changing direction
sub steplengths {
    my ($m) = @_;
    my $flag = 0;
    return Iterator {
        if ( $flag % 2 == 0 ) {
            $m++;
        }
        $flag++;
        return $m;
    }
}

my $M;

sub adjacent_sum {
    my ( $x, $y ) = @_;
    my $sum = 0;
    foreach my $i ( $x - 1, $x, $x + 1 ) {
        foreach my $j ( $y - 1, $y, $y + 1 ) {
            if ( defined $M->{$i}->{$j} ) {
                $sum += $M->{$i}->{$j};
            }
        }
    }
    return $sum;
}

my $dirs = [ [ 1, 0 ], [ 0, 1 ], [ -1, 0 ], [ 0, -1 ] ];

#### init

my $target = $input[0];

my $current_val = 1;
my ( $x, $y ) = ( 0, 0 );

# store the values for each coordinate in a href of hrefs
# an arrayref of arrayrefs might be "cleaner" but needs to be pre-created
$M->{$x}->{$y} = $current_val;

my $dir_idx = 0;
my $iter    = steplengths(0);

#### main loop

LOOP: while ( my $step = NEXTVAL($iter) ) {

    if ( $dir_idx == 4 ) { $dir_idx = 0 }
    while ( $step > 0 ) {
        ( $x, $y ) =
          ( $x + $dirs->[$dir_idx]->[0], $y + $dirs->[$dir_idx]->[1] );
        $current_val = adjacent_sum( $x, $y );
        if ( $current_val >= $target ) {
            last LOOP;
        }
        $M->{$x}->{$y} = $current_val;
        $step--;
    }
    $dir_idx++;

}
say "First value larger than $target: $current_val";

56 lines [ Plain text ] [ ^Top ]

Advent of Code 2017 day 4

[ AoC problem link ] [ Discussion ].

Day 4 - complete solution


#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;

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

### CODE
my ( $count_1, $count_2 ) = ( 0, 0 );
foreach my $line (@input) {
    my @passphrase = split( /\s+/, $line );
    my %dupe_words;
    map { $dupe_words{$_}++ } @passphrase;
    my %anagrams;
    map { $anagrams{ join( '', sort( split( //, $_ ) ) ) }++ } @passphrase;
    $count_1++ if ( scalar @passphrase == scalar keys %dupe_words );
    $count_2++ if ( scalar @passphrase == scalar keys %anagrams );
}

say "1. Number of valid passphrases: $count_1";
say "2. Number of valid passwords  : $count_2";

19 lines [ Plain text ] [ ^Top ]

Advent of Code 2017 day 5

[ AoC problem link ] [ Discussion ].

Day 5 - complete solution


#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;

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

### CODE

sub debug {
    say join ' ', @input;
}
# pass a non-false argument to enable part 2
my $part2 = shift || 0;

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

while ( $pointer >= 0 and $pointer < scalar @input ) {
    my $jump = $input[$pointer];
    if ( $jump == 0 ) {
        $steps++;
        $input[$pointer]++;
        next;
    }
    else {
        my $pos  = $pointer;
        $pointer = $pointer + $jump;
        $steps++;
        if ( $jump >= 3 and $part2 ) {
            $input[$pos]--;
        }
        else {
            $input[$pos]++;
        }
    }
    debug if $testing;
}
print 'Part ' , $part2 ? '2' : '1' ,  '. ';
say "number of steps: $steps";

36 lines [ Plain text ] [ ^Top ]

Advent of Code 2017 day 6

[ AoC problem link ] [ Discussion ].

Day 6 - complete solution


#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;
use List::Util qw/max/;

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

### CODE

my @state = split( /\t/, $input[0] );
my %seen_states;

sub debug {
    say join( ',', @state );
}

my $count = 0;
$seen_states{ "@state" } = $count;

# let's loop!
while (1) {
    my $largest_el = max @state;
    my @positions  = grep { $state[$_] == $largest_el } (0 .. $#state);
    # we might have more than one position with the same number of elements
    # choose the first
    my $start      = shift @positions;
    my $blocks     = $state[$start];
    $state[$start] = 0;
    my $next = $start + 1;
    while ( $blocks > 0 ) {
	# do we need to wrap around?
        if ( $next >= scalar @state ) { $next = 0 }
        $state[$next]++;
        $blocks--;
        $next++;
    }
    $count++;
    if ( exists $seen_states{ "@state" } ) {
        last;
    }
    else {
        $seen_states{ "@state" } = $count;
    }
}
say "1. number of cycles: $count";
say "2. size of loop    : ", $count - $seen_states{ "@state" };


42 lines [ Plain text ] [ ^Top ]

Advent of Code 2017 day 7

[ AoC problem link ] [ Discussion ].

Day 7 - complete solution


#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;

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

### CODE
my %towers;

sub total_weight;
sub compare_levels;

# construct a hash holding values - weights and children
foreach my $line (@input) {
    if ( $line =~ m/^(?.*) \((?\d+)\) \-\> (?.*)$/ ) {
        my  $tower  = $+{tower};
        $towers{$tower}->{weight} = $+{weight};
        foreach my $el ( split( /\,/, $+{list} ) ) {
            $el =~ s/^\s+|\s+$//g;    # trim whitespace
            $towers{$el}->{held_by} = $tower;
            push @{ $towers{$tower}->{holding} }, $el;
        }
    }
    elsif ( $line =~ m/^(?.*) \((?\d+)\)$/ ) {
        $towers{$+{tower}}->{weight} = $+{weight};
    }
    else {
        die "can't parse input line: $line\n";
    }
}

# find the root (part 1)
my $root;
foreach my $tower ( keys %towers ) {
    if ( !exists $towers{$tower}->{held_by} ) {
        $root = $tower;
        last;
    }
}
say "1. name of root disk: $root";
say "2. adjusted weight  : ", compare_levels( $root, 0 );

########################################

# recursively calculate the weight of a tower, given a base
sub total_weight {
    my ($base) = @_;
    my $weight;

    if ( !exists $towers{$base}->{holding} ) {    # leaf
        $weight = $towers{$base}->{weight};
    }
    else {
        $weight = $towers{$base}->{weight};
        foreach my $child ( @{ $towers{$base}->{holding} } ) {
            $weight += total_weight($child);
        }
    }
    return $weight;
}

# compare the weights of a base tower's children, return corrected
# weight
sub compare_levels {
    my ( $base, $diff ) = @_;
    my %values;
    foreach my $child ( @{ $towers{$base}->{holding} } ) {
        push @{ $values{ total_weight($child) } }, $child;
    }

    # do we have any diffs?
    if ( scalar keys %values == 1 )
    {    # no diffs, return corrected weight of parent
        return $towers{$base}->{weight} - $diff;
    }
    else {    # calculate new diff (should be the same for each step
              # but we might as well have the latest value...
        my ( $lo, $hi ) = sort { $a <=> $b } keys %values;
        $diff = $hi - $lo;
    }

    # find the outlier to send on to the next level
    my $differing;
    foreach my $val ( keys %values ) {
        if ( scalar @{ $values{$val} } == 1 ) {
            $differing = $values{$val}->[0];
        }
    }
    compare_levels( $differing, $diff );
}

76 lines [ Plain text ] [ ^Top ]

Advent of Code 2017 day 8

[ AoC problem link ] [ Discussion ].

Day 8 - complete solution


#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;
use List::Util qw/max/;

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

### CODE
my %registers;
my $max_val = 0;

sub value_of;
sub compare;
foreach my $line (@input) {
    my @args = split( /\s+/, $line );

    my ( $target, $inc_dec, $val_1, $if, $source, $cmp, $val_2 ) = @args;

    my $curr = value_of($target);

    if ( compare( $source, $cmp, $val_2 ) ) {
        if ( $inc_dec eq 'inc' ) {
            $curr = $curr + $val_1;
        }
        else {
            $curr = $curr - $val_1;
        }
        $max_val = $curr if ( $curr > $max_val );
        $registers{$target} = $curr;
    }
}
say "1. largest value when done : ", max values %registers;
say "2. largest value during run: ", $max_val;

#################################################################

sub value_of {
    my ($v) = @_;
    my $ret;
    if ( exists $registers{$v} ) {
        $max_val = $registers{$v} if ( $registers{$v} > $max_val );
        $ret = $registers{$v};
    }
    else {
        $registers{$v} = 0;
        $ret = 0;
    }
    return $ret;
}

sub compare {
    my ( $src, $cmp, $arg_2 ) = @_;
    my $arg_1 = value_of($src);
    my $ret   = undef;

    # from stats, we have: != < <= == > >=
    if    ( $cmp eq '!=' ) { $ret = ( $arg_1 != $arg_2 ) }
    elsif ( $cmp eq '<'  ) { $ret = ( $arg_1 <  $arg_2 ) }
    elsif ( $cmp eq '<=' ) { $ret = ( $arg_1 <= $arg_2 ) }
    elsif ( $cmp eq '==' ) { $ret = ( $arg_1 == $arg_2 ) }
    elsif ( $cmp eq '>'  ) { $ret = ( $arg_1 >  $arg_2 ) }
    elsif ( $cmp eq '>=' ) { $ret = ( $arg_1 >= $arg_2 ) }
    die "can't set return value based on args" unless defined $ret;
    return $ret;
}

57 lines [ Plain text ] [ ^Top ]

Advent of Code 2017 day 9

[ AoC problem link ] [ Discussion ].

Day 9 - complete solution


#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;

#### 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 ( $score, $invalid_flag, $garbage_count ) = ( 0, 0, 0 );
my @groups;
my @garbage;

# dispatch table
my %act = (
    '{' => \&open_group,
    '}' => \&close_group,
    '<' => \&garbage_in,
    '>' => sub { pop @garbage },
    '!' => sub { $invalid_flag = 1 if @garbage },
);

# process the stream
my @stream = split( //, shift @input );
my $char;
while (@stream) {
    $char = shift @stream;

    if ($invalid_flag) {
        $invalid_flag = 0;
        next;
    }
    
    if ( defined $act{$char} ) {
        $act{$char}->();
    }
    else {
        $garbage_count++ if @garbage;
    }
}
say "1. total score              : $score";
say "2. characters within garbage: $garbage_count";

########################################

sub open_group {
    if ( !@garbage ) {
        push @groups, '{';
        $score += scalar @groups;
    }
    else {
        $garbage_count++;
    }
}

sub close_group {
    if ( !@garbage ) {
        pop @groups;
    }
    else {
        $garbage_count++;
    }
}

sub garbage_in {
    if ( !@garbage ) {
        push @garbage, '<';
    }
    else {
        $garbage_count++;
    }
}

60 lines [ Plain text ] [ ^Top ]

Advent of Code 2017 day 10

[ AoC problem link ] [ Discussion ].

Day 10 - part 1


#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;

#### 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 @array = $testing ? ( 0 .. 4 ) : ( 0 .. 255 );
my @lengths = split( /\,/, shift @input );
sub dump_state;
my $skip = 0;
my $pos  = 0;
my $len  = 0;

dump_state if $testing;
while (@lengths) {
    $len = shift @lengths;
    my $end     = $pos + $len - 1;
    my $overlap = $end % @array;

    # do we overlap?
    if ( $overlap == $end ) {    #no
        my @segment = @array[ $pos .. $end ];
        @array[ $pos .. $end ] = reverse @segment;
    }
    else {
        my @seg1 = @array[ $pos .. $#array ];
        my @seg2 = @array[ 0 .. $overlap ];
        say join( ' ', @seg1, @seg2 ) if $testing;
        my @replace = reverse( @seg1, @seg2 );
        say join( ' ', @replace ) if $testing;
        @array[ $pos .. $#array ] = @replace[ 0 .. ( $#array - $pos ) ];
        @array[ 0 .. $overlap ] =
          @replace[ ( $#replace - $overlap ) .. $#replace ];
    }

    $pos = ( $pos + $len + $skip ) % @array;
    $skip++;
    dump_state if $testing;
}
say "Product of first 2 elements: ",$array[0] * $array[1];

########################################

sub dump_state {
    printf( "curr length: %d curr skip: %d next pos: %d\n",
	    $len, $skip, $pos );
    my @copy = @array;
    if ($testing) {
        say join( ' ', map { sprintf( "%2d", $_ ) } @copy );
    }
    else {
        while (@copy) {
            my @row = splice( @copy, 0, 16 );
            say join( ' ', map { sprintf( "%3d", $_ ) } @row );
        }
    }
}

53 lines [ Plain text ] [ ^Top ]

Day 10 - part 2


#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;

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

### CODE
my @array = ( 0 .. 255 );
my @key;
my @salt = ( 17, 31, 73, 47, 23 );
my $teststring = '1,2,3';
if ($testing) {
    my @convert = map { ord($_) } split( //, $teststring );
    @key = ( @convert, @salt );
}
else {
    my @in = map { ord($_) } split( //, shift @input );
    @key = ( @in, @salt );
}
my $skip = 0;
my $pos  = 0;
my $len  = 0;
sub array_to_hex;

foreach my $round ( 1 .. 64 ) {
    my @lengths = @key;
    while (@lengths) {
        $len = shift @lengths;
        my $end     = $pos + $len - 1;
        my $overlap = $end % @array;

        # do we overlap?
        if ( $overlap == $end ) {    #no
            my @segment = @array[ $pos .. $end ];
            @array[ $pos .. $end ] = reverse @segment;
        }
        else {
            my @seg1    = @array[ $pos .. $#array ];
            my @seg2    = @array[ 0 .. $overlap ];
            my @replace = reverse( @seg1, @seg2 );
            @array[ $pos .. $#array ] = @replace[ 0 .. ( $#array - $pos ) ];
            @array[ 0 .. $overlap ] =
              @replace[ ( $#replace - $overlap ) .. $#replace ];
        }

        $pos = ( $pos + $len + $skip ) % @array;
        $skip++;
    }
}
say "Knot Hash of puzzle input: ", array_to_hex;

########################################

sub array_to_hex {
    my $string;
    while (@array) {
        my @row = splice( @array, 0, 16 );
        my $xor;
        my $el_1 = shift @row;
        while (@row) {
            my $el_2 = shift @row;
            $xor  = $el_1 ^ $el_2;
            $el_1 = $xor;
        }
        $string .= sprintf( "%02x", $xor );
    }
    return $string;
}

63 lines [ Plain text ] [ ^Top ]

Advent of Code 2017 day 11

[ AoC problem link ] [ Discussion ].

Day 11 - complete solution


#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;
use List::Util qw/max/;

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

### CODE
# x,y,z coordinates - see https://www.redblobgames.com/grids/hexagons/
my %move = (
    n  => sub { [ 0,  1,  -1 ] },
    ne => sub { [ 1,  0,  -1 ] },
    se => sub { [ 1,  -1, 0 ] },
    s  => sub { [ 0,  -1, 1 ] },
    sw => sub { [ -1, 0,  1 ] },
    nw => sub { [ -1, 1,  0 ] },
);

my @dirs = split( /,/, shift @input );
my @path;

#         x, y, z
my $position = [ 0, 0, 0 ];
my ( $dist, $max_dist ) = ( 0, 0 );
while (@dirs) {
    my $ins = shift @dirs;
    my $d   = $move{$ins}->();
    map { $position->[$_] += $d->[$_] } 0 .. 2;
    $dist = max( map { abs($_) } @$position );
    $max_dist = max( $max_dist, $dist );
}
say "1. steps to end point: ", $dist;
say "2. max distance      : ", $max_dist;

29 lines [ Plain text ] [ ^Top ]

Advent of Code 2017 day 12

[ AoC problem link ] [ Discussion ].

Day 12 - complete solution


#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;

#### 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 %pipes;
while (@input) {
    my $line = shift @input;
    if ( $line =~ /^(\d+)\ \<\-\>\ (.*)$/ ) {
        $pipes{$1} = [split( ', ', $2 )];
    }
    else {
        die "cannot parse input line: $line";
    }
}

my %seen;
my %groups;
foreach my $id ( sort keys %pipes ) {
    next if $seen{$id};
    my %connections = ( $id => 1 );
    my @list = @{ $pipes{$id} };
    while (@list) {
        my $p = shift @list;
        $seen{$p}++;
        next if exists $connections{$p};
        $connections{$p}++;
        push @list, @{ $pipes{$p} };
    }
    $groups{$id} = \%connections;
}
say "1. connections to '0': ", scalar keys %{ $groups{'0'} };
say "2. total groups      : ", scalar keys %groups;

35 lines [ Plain text ] [ ^Top ]

Advent of Code 2017 day 13

[ AoC problem link ] [ Discussion ].

Day 13 - part 1


#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;

# useful modules
use List::Util qw/max/;
#### 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
# parse input
my %depths;
my $max = 0;
while (@input) {
    my ( $pos, $depth ) = split( /: /, shift @input );
    $depths{$pos} = $depth;
    $max = max( $max, $pos );
}

# these are from the chapter on iterators in HOP, but not in a
# separate module
sub NEXTVAL      { $_[0]->() }
sub Iterator (&) { return $_[0] }

# an iterator for states
sub states {
    my ($m) = @_;
    return Iterator {
        for my $i ( 0 .. scalar @$m - 1 ) {
            if ( exists $depths{$i} ) {
                my $new = $m->[$i] + 1;
                $m->[$i] = $new % ( 2 * $depths{$i} - 2 );
            }
        }
        return $m;
    }
}

my $firewall = [ (0) x ( $max + 1 ) ];
my $iter     = states($firewall);
my $curr     = 0;
my $severity = 0;

while ( $curr <= $max ) {
    if ( exists $depths{$curr} and $firewall->[$curr] == 0 ) {
        $severity += $depths{$curr} * $curr;
    }
    $firewall = NEXTVAL($iter);
    $curr++;

}
say "Severity: ",$severity;

42 lines [ Plain text ] [ ^Top ]

Day 13 - part 2


#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;

# useful modules
use List::Util qw/max/;
use Storable qw/dclone/;
#### 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
# parse input

my %depths;
my $max = 0;
while (@input) {
    my ( $pos, $depth ) = split( /: /, shift @input );
    $depths{$pos} = $depth;
    $max = max( $max, $pos );
}

# these are from the chapter on iterators in HOP, but not in a
# separate module
sub NEXTVAL      { $_[0]->() }
sub Iterator (&) { return $_[0] }

# an iterator for states
sub states {
    my ($m) = @_;
    return Iterator {
        for my $i ( 0 .. scalar @$m - 1 ) {
            if ( exists $depths{$i} ) {
                my $new = $m->[$i] + 1;
                $m->[$i] = $new % ( 2 * $depths{$i} - 2 );
            }
        }
        return $m;
    }
}

my $initial = [ (0) x ( $max + 1 ) ];
my $iter1   = states($initial);
my $starter = NEXTVAL($iter1);

my $delay = 1;
while (1) {
    my $curr     = 0;
    my $hit      = 0;
    my $firewall = dclone $starter;
    my $iter2    = states($firewall);
  INNER: while ( $curr <= $max ) {
        if ( exists $depths{$curr} and $firewall->[$curr] == 0 ) {
            $hit = 1;
            last INNER;
        }
        $firewall = NEXTVAL($iter2);
        $curr++;
    }
    last if ( $hit == 0 );
    $delay++;
    $starter = NEXTVAL($iter1);
}

say "Delay: ",$delay;

53 lines [ Plain text ] [ ^Top ]

Advent of Code 2017 day 14

[ AoC problem link ] [ Discussion ].

Day 14 - complete solution


#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;

#### 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 $max_dim = 127;
my $group_count = 0;
sub knot_hash_bin;
sub fill_flood;

my $seed    = $input[0];

my $sum = 0;
my $Map;
foreach my $idx ( 0 .. $max_dim ) {
    my $binrow = knot_hash_bin( $seed . '-' . $idx );

    my @ones = grep { $_ == 1 } split( //, $binrow );
    $sum += scalar @ones;

    # populate map
    foreach my $el ( split( //, $binrow ) ) {
        push @{ $Map->[$idx] }, { val => $el, seen => 0 };
    }
}

# process the map

foreach my $row ( 0 .. scalar @$Map - 1 ) {
    foreach my $col ( 0 .. scalar @{ $Map->[$row] } - 1 ) {
        next if $Map->[$row]->[$col]->{val} == 0;
        next if $Map->[$row]->[$col]->{seen} > 0;
	# fill flood the ones
        $group_count++;
        fill_flood( $row, $col );
    }
}

say "1. number of used squares   : ", $sum;
say "2. number of distinct groups: ", $group_count;

###############################################################################

sub fill_flood {
    my ( $r, $c ) = @_;
    my @dirs = ( [ -1, 0 ], [ 1, 0 ], [ 0, -1 ], [ 0, 1 ] );
    foreach my $d (@dirs) {
        my $new_r = $r + $d->[0];
        my $new_c = $c + $d->[1];
        next
          if ( $new_r < 0
            or $new_r > $max_dim
            or $new_c < 0
            or $new_c > $max_dim );
        next
          if ( $Map->[$new_r]->[$new_c]->{val} == 0
            or $Map->[$new_r]->[$new_c]->{seen} > 0 );
        $Map->[$new_r]->[$new_c]->{seen} = $group_count;
        fill_flood( $new_r, $new_c );
    }
}

# code adapted from day 10, part 2
sub knot_hash_bin {
    my ($string) = @_;
    my @salt = ( 17, 31, 73, 47, 23 );
    my @convert = map { ord($_) } split( //, $string );
    my @key = ( @convert, @salt );

    my @array = ( 0 .. 255 );
    my $skip  = 0;
    my $pos   = 0;
    my $len   = 0;
    foreach my $round ( 1 .. 64 ) {
        my @lengths = @key;
        while (@lengths) {
            $len = shift @lengths;
            my $end     = $pos + $len - 1;
            my $overlap = $end % @array;

            # do we overlap?
            if ( $overlap == $end ) {    #no
                my @segment = @array[ $pos .. $end ];
                @array[ $pos .. $end ] = reverse @segment;
            }
            else {
                my @seg1    = @array[ $pos .. $#array ];
                my @seg2    = @array[ 0 .. $overlap ];
                my @replace = reverse( @seg1, @seg2 );
                @array[ $pos .. $#array ] = @replace[ 0 .. ( $#array - $pos ) ];
                @array[ 0 .. $overlap ] =
                  @replace[ ( $#replace - $overlap ) .. $#replace ];
            }

            $pos = ( $pos + $len + $skip ) % @array;
            $skip++;
        }
    }
    my $hexstring;
    while (@array) {
        my @row = splice( @array, 0, 16 );
        my $xor;
        my $el_1 = shift @row;
        while (@row) {
            my $el_2 = shift @row;
            $xor  = $el_1 ^ $el_2;
            $el_1 = $xor;
        }
        $hexstring .= sprintf( "%02x", $xor );
    }
    my @chars = split( //, $hexstring );
    my $out;
    while (@chars) {
        $out .= sprintf( "%04b", hex( shift @chars ) );
    }
    return $out;
}

104 lines [ Plain text ] [ ^Top ]

Advent of Code 2017 day 15

[ AoC problem link ] [ Discussion ].

Day 15 - complete solution


#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;

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

# pass a non-false value for part 2
my $part2 = shift || 0;

my @start;
my @factors = ( 16807, 48271 );
my @evendivs = $part2 ? ( 4, 8 ) : ( undef, undef );
my $divisor  = 2147483647;
my $mask     = 0xFFFF;

while (@input) {
    my $str = shift @input;
    if ( $str =~ m/(\d+)$/ ) {
        push @start, $1;
    }
    else {
        die "can't parse input: $str";
    }
}

# cribbed from HOP
sub NEXTVAL      { $_[0]->() }
sub Iterator (&) { return $_[0] }

sub generator {
    my ( $start, $factor, $divide_by ) = @_;
    return Iterator {
        my $nextval;
        if ( defined $divide_by ) {

            do {
                $nextval = ( $start * $factor ) % $divisor;
                $start   = $nextval;
            } until ( $nextval % $divide_by == 0 );
            return $start;
        }
        else {
            $nextval = ( $start * $factor ) % $divisor;
            $start   = $nextval;
            return $start;
        }
    }
}

my $count = 1;
my $match = 0;

my $gen_A = generator( $start[0], $factors[0], $evendivs[0] );
my $gen_B = generator( $start[1], $factors[1], $evendivs[1] );

my $LIMIT = 1_000_000 * ( $part2 ? 5 : 40 );

while ( $count <= $LIMIT ) {
    $match++ if ( ( NEXTVAL($gen_A) & $mask ) == ( NEXTVAL($gen_B) & $mask ) );
    $count++;
}
printf "No. of matches for part %d: %d\n", $part2 ? 2 : 1, $match;

53 lines [ Plain text ] [ ^Top ]

Advent of Code 2017 day 16

[ AoC problem link ] [ Discussion ].

Day 16 - complete solution


#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;

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

### CODE

my @list = 'a' .. 'p';

my %actions = (
    s => \&spin,
    x => \&exchange,
    p => \&partner,
);

my @seq;
for my $el ( split( /,/, $input[0] ) ) {
    if    ( $el =~ m/s(\d+)/ )        { push @seq, [ 's', $1, undef ] }
    elsif ( $el =~ m/x(\d+)\/(\d+)/ ) { push @seq, [ 'x', $1, $2 ] }
    elsif ( $el =~ m/p(\S+)\/(\S+)/ ) { push @seq, [ 'p', $1, $2 ] }
    else                              { die "can't parse: $el" }
}

my $count = 1;
my $period;
my $LIMIT = 1_000_000_000;

# find answer to part 1, and the recurrence period;
while ( $count <= $LIMIT ) {
    say "==> $count" if $count % 100 == 0;
    foreach my $el (@seq) {
        $actions{ $el->[0] }->( $el->[1], $el->[2] );
    }
    say "1. result after 1  round : ", join( '', @list ) if $count == 1;
    if ( join( '', @list ) eq join( '', 'a' .. 'p' ) ) {
        $period = $count;
        last;
    }
    $count++;
}

# find part 2;
$count = 1;
@list  = 'a' .. 'p';
while ( $count <= $LIMIT % $period ) {
    foreach my $el (@seq) {
        $actions{ $el->[0] }->( $el->[1], $el->[2] );
    }
    $count++;
}

say "2. result after 1B rounds: ", join( '', @list );

###############################################################################

sub spin {
    my ( $x, $_0 ) = @_;
    my @tail = @list[ -$x .. -1 ];
    my @head = @list[ 0 .. $#list - $x ];
    @list = ( @tail, @head );
}

sub exchange {
    my ( $p, $q ) = @_;
    my $newp = $list[$q];
    my $newq = $list[$p];
    $list[$p] = $newp;
    $list[$q] = $newq;
}

sub partner {
    my ( $r, $s ) = @_;
    my ($r_idx) = grep { $list[$_] eq $r } ( 0 .. $#list );
    my ($s_idx) = grep { $list[$_] eq $s } ( 0 .. $#list );
    $list[$s_idx] = $r;
    $list[$r_idx] = $s;
}

64 lines [ Plain text ] [ ^Top ]

Generated on Sat Dec 16 09:50:14 2017 UTC.