Advent of Code 2015 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 2015 day 1

[ AoC problem link ] [ Discussion ].

Day 1 - complete solution


#!/usr/bin/perl
use strict;
use warnings;
my $file = 'input.txt';
open F, "<$file" or die "couldn't open $file: $!\n";
my @array;
while () {
    chomp;
    s/\r//gm;
    my $line = $_;
    @array = split( '', $line );
}
close F;
my $floor     = 0;
my $count     = 1;
my $first_neg = 0;
my $ans2      = 0;
foreach my $c (@array) {
    if   ( $c =~ /\(/ ) { $floor++ }
    else                { $floor-- }
    if ( $floor == -1 and !$first_neg ) {
        $first_neg = 1;
        $ans2      = $count;
    }
    $count++;
}
print "Final floor: $floor\n";
print "First negative floor: $ans2\n";


27 lines [ Plain text ] [ ^Top ]

Advent of Code 2015 day 2

[ AoC problem link ] [ Discussion ].

Day 2 - complete solution


#!/usr/bin/perl
use strict;
use warnings;
use List::Util qw(sum);
my $file = 'input.txt';
open F, "<$file" or die "couldn't open $file: $!\n";

my $paper  = 0;
my $ribbon = 0;

while () {
    chomp;
    s/\r//gm;
    my $dim = $_;
    my ( $l, $w, $h );
    my @areas;
    my @perims;
    if ( $dim =~ m/(\d+)x(\d+)x(\d+)/ ) {
        ( $l, $w, $h ) = ( $1, $2, $3 );

        @areas = ( $l * $w, $w * $h, $h * $l );
        @perims = map { 2 * $_ } ( $l + $w, $w + $h, $h + $l );

        @areas  = sort { $a <=> $b } @areas;
        @perims = sort { $a <=> $b } @perims;

        my $slack = $areas[0];     # smallest side for slack
        my $round = $perims[0];    # smallest perimeter
        my $area = ( 2 * $areas[0] + 2 * $areas[1] + 2 * $areas[2] );
        my $bow  = $h * $l * $w;

        $paper  += $slack + $area;
        $ribbon += $round + $bow;
    } else {
        warn "can't parse $dim\n";
        next;
    }
}
close F;

print "Paper: $paper\n";
print "Ribbon: $ribbon\n";


34 lines [ Plain text ] [ ^Top ]

Advent of Code 2015 day 3

[ AoC problem link ] [ Discussion ].

Day 3 - part 1


#!/usr/bin/perl
use strict;
use warnings;

my %M; # matrix, first element x, second y, value: nr of visits;
my @start = (1,1);
$M{join(',',@start)}++;
my $file = 'input.txt';
open F, "<$file" or die "can't open $file: $!\n";
my @dirs;
while () {
    chomp;
    s/\r//gm;
    @dirs = split('',$_);
}
close F;
my @next=(0,0);
foreach my $dir (@dirs) {

    if ( $dir eq '^') {  # north
	$next[1] = $start[1]+1 
    } elsif ( $dir eq '>') { # east
	$next[0] = $start[0]+1
    } elsif ( $dir eq 'v' ) { # south
	$next[1] = $start[1]-1
    } elsif ( $dir eq '<') { #west
	$next[0] = $start[0]-1
    } else {
	die "can't recognise dir: $dir\n"
    }
    # leave a present
    $M{join(',',@next)}++;
    @start = @next;
}
# count the houses
my $houses = scalar keys %M;

print "1. houses with at least one present: $houses\n";

33 lines [ Plain text ] [ ^Top ]

Day 3 - part 2


#!/usr/bin/perl
use strict;
use warnings;

sub move {
    my ($x,$y,$d) = @_;

    if ( $d eq '^') {  # north
	$y++
    } elsif ( $d eq '>') { # east
	$x++
    } elsif ( $d eq 'v' ) { # south
	$y--
    } elsif ( $d eq '<') { #west
	$x--
    } else {
	die "can't recognise dir: $d\n"
    }
    return [$x,$y];
}

my %M; # keep track of houses
my @santa = (1,1);
my @robot = (1,1);
$M{join(',',@santa)}=2;
my $file = 'input.txt';
open F, "<$file" or die "can't open $file: $!\n";
my @dirs;
while () {
    chomp;
    s/\r//gm;
    @dirs = split('',$_);
}
close F;
while (@dirs) {
    my $sdir = shift @dirs;
    my $rdir = shift @dirs;

    my @snext = @{move(@santa, $sdir)};
    my @rnext = @{move(@robot, $rdir)};

    $M{join(',', @snext)}++;
    $M{join(',', @rnext)}++;

    @santa = @snext;
    @robot = @rnext;
}
# count the houses
my $houses = scalar keys %M;

print "2. houses with at least one present: $houses\n";


42 lines [ Plain text ] [ ^Top ]

Advent of Code 2015 day 4

[ AoC problem link ] [ Discussion ].

Day 4 - part 2


#!/usr/bin/perl
use strict;
use warnings;
use Digest::MD5 qw(md5_hex);

my $key = 'bgvyzdsv';
my $n=0;
my $md5;
my $part2 = shift || 0;

my $target = $part2 ? '000000' : '00000';
while (1) {
    $md5 = md5_hex($key,$n);
    # for part 1, decrease the number of zeroes below by 1
    if ($md5 =~ m/^$target/ ) {
	print $part2? '2. ':'1. ', "lowest number: $n\n";
	last;
    }
    $n++;
}

17 lines [ Plain text ] [ ^Top ]

Advent of Code 2015 day 5

[ AoC problem link ] [ Discussion ].

Day 5 - part 1


#!/usr/bin/perl
use strict;
use warnings;

my $file = 'input.txt';
open F, "<$file" or die "can't open $file: $!\n";
my @valids;
while () {
    chomp;
    s/\r//gm;
    next if $_ =~ m/ab|cd|pq|xy/; # forbidden combos 
    next unless $_ =~ m/[aeiou].*[aeiou].*[aeiou]/; # contains three vowels
    next unless $_ =~ m/(.)\1/; # at least one repeated letter
    push @valids, $_;
}
close F;

print "1. number of valid passwords: ", scalar @valids, "\n";

15 lines [ Plain text ] [ ^Top ]

Day 5 - part 2


#!/usr/bin/perl
use strict;
use warnings;

my $file = 'input.txt';
open F, "<$file" or die "can't open $file: $!\n";
my $count =0;
while () {
    chomp;
    s/\r//gm;
    # regex solution from https://www.reddit.com/r/adventofcode/comments/3viazx/day_5_solutions/cxo0y93
    if ( $_ =~ m/^(?=.*(.).\1.*)(?=.*(..).*\2).*/gm  ) { $count++ }
    else { next }
    
}
close F;
print "2. number of valid passwords: $count\n";
__DATA__
qjhvhtzxzqqjkmpb
xxyxx
uurcxstgmygtbstg
ieodomkazucvgmuy

19 lines [ Plain text ] [ ^Top ]

Advent of Code 2015 day 6

[ AoC problem link ] [ Discussion ].

Day 6 - part 1


#!/usr/bin/perl
use strict;
use warnings;

### get the input
my @states;
my $file = 'input.txt';
open F, "<$file" or die "couldn't open $file: $!\n";
while () {
    chomp;
    s/\r$//gm;
    my ( $state, $c1, $c2 );
    if ( $_ =~ m/(.*)\ (\d+\,\d+)\ through (\d+\,\d+)/ ) {
        my $word = $1;
        if    ( $word eq 'turn on' )  { $state = 'n' }
        elsif ( $word eq 'turn off' ) { $state = 'f' }
        elsif ( $word eq 'toggle' )   { $state = 't' }
        else                          { die "wtf is $word ?!" }
        $c1 = $2;
        $c2 = $3;
    }
    push @states, [ $state, $c1, $c2 ];
}
close F;

### store the lights in a big ole matrix
my $M;

sub act {
    my ( $state, $start, $end ) = @_;
    my @start = split( /\,/, $start );
    my @end   = split( /\,/, $end );

    # x-axis
    foreach my $x ( $start[0] .. $end[0] ) {
        foreach my $y ( $start[1] .. $end[1] ) {

            # lights can be undefined (starting state), off (0) or on (1)
            # might as well treat undefined as 0
            my $current = defined( $M->{$x}->{$y} ) ? $M->{$x}->{$y} : 0;
            if ( $current == 0 && $state eq 'n' ) {    # turn on
                $M->{$x}->{$y} = 1;
            } elsif ( $current == 1 && $state eq 'f' ) {    # turn off
                $M->{$x}->{$y} = 0;
            } elsif ( $current == 0 && $state eq 't' ) {    # toggle 0 to 1
                $M->{$x}->{$y} = 1;
            } elsif ( $current == 1 && $state eq 't' ) {    # toggle 1 to 0
                $M->{$x}->{$y} = 0;
            } else {
                $M->{$x}->{$y} = $current;
            }
        }
    }
}

### apply the states
my $idx = 0;
foreach my $s (@states) {
    act( @{$s} );
    $idx++;
}

### count the lights
my $count = 0;
foreach my $x ( keys %{$M} ) {
    foreach my $y ( keys %{ $M->{$x} } ) {
        $count++ if $M->{$x}->{$y} == 1;
    }
}
print "Lights: $count\n";

58 lines [ Plain text ] [ ^Top ]

Day 6 - part 2


#!/usr/bin/perl
use strict;
use warnings;

### get the input
my @states;
my $file = 'input.txt';
open F, "<$file" or die "couldn't open $file: $!";
while () {
    chomp;
    s/\r$//gm;
    my ( $state, $c1, $c2 );
    if ( $_ =~ m/(.*)\ (\d+\,\d+)\ through (\d+\,\d+)/ ) {
        my $word = $1;
        if    ( $word eq 'turn on' )  { $state = 'n' }
        elsif ( $word eq 'turn off' ) { $state = 'f' }
        elsif ( $word eq 'toggle' )   { $state = 't' }
        else                          { die "wtf is $word ?!" }
        $c1 = $2;
        $c2 = $3;
    }
    push @states, [ $state, $c1, $c2 ];
}
close F;

### store the lights in a big ole matrix
my $M;

sub act {
    my ( $state, $start, $end ) = @_;
    my @start = split( /\,/, $start );
    my @end   = split( /\,/, $end );

    # x-axis
    foreach my $x ( $start[0] .. $end[0] ) {
        foreach my $y ( $start[1] .. $end[1] ) {

            # lights can be undefined (starting state), off (0) or > 0
            # might as well treat undefined as 0
            my $current = defined( $M->{$x}->{$y} ) ? $M->{$x}->{$y} : 0;
            if ( $state eq 'n' ) {    # increase by 1
                $M->{$x}->{$y} += 1;
            } elsif ( $state eq 't' ) {    # increase by 2
                $M->{$x}->{$y} += 2;
            } elsif ( $state eq 'f' ) {  # decrease by 1, to a minimum of zero
                if ( $current <= 1 ) {
                    $M->{$x}->{$y} = 0;
                } else {
                    $M->{$x}->{$y} -= 1;
                }
            } else {
                $M->{$x}->{$y} = $current;
            }    # fallthrough, shouldn't happen
        }
    }
}

### apply the states
my $idx = 0;
foreach my $s (@states) {
    act( @{$s} );
    $idx++;
}

### count the brightness
my $count = 0;
foreach my $x ( keys %{$M} ) {
    foreach my $y ( keys %{ $M->{$x} } ) {
        $count += $M->{$x}->{$y};
    }
}
print "Brightness: $count\n";


60 lines [ Plain text ] [ ^Top ]

Advent of Code 2015 day 7

[ AoC problem link ] [ Discussion ].

Day 7 - complete solution


#!/usr/bin/perl
use strict;
use warnings;

my $file = 'input.txt';
open F, "<$file" or die "can't open $file: $!\n";

my @statements;
my %solutions;
while () {
    chomp;
    s/\r//gm;
    my ( $lhs, $res ) = ( $_ =~ m/^(.*) -> (\S+)$/ );
    push @statements, [ $res, $lhs ];
}

while ( !defined $solutions{'a'} ) {
    foreach my $stmt (@statements) {
        my $sought = $stmt->[0];
        if ( $stmt->[1] =~ m/^(\S+) (AND|OR|LSHIFT|RSHIFT) (\S+)$/ ) {
            my ( $a, $op, $b ) = ( $1, $2, $3 );

            if ( $a =~ m/\d+/ ) {
            } elsif ( $a =~ m/\S+/ ) {
                $a = $solutions{$a};
            } else {
                $a = undef;
            }

            if ( $b =~ m/\d+/ ) {
            } elsif ( $b =~ m/\S+/ ) {
                $b = $solutions{$b};
            } else {
                $b = undef;
            }
            if ( $op eq 'AND' ) {
                next unless ( defined $a and defined $b );
                $solutions{$sought} = $a & $b;
            } elsif ( $op eq 'OR' ) {
                next unless ( defined $a and defined $b );
                $solutions{$sought} = $a | $b;
            } elsif ( $op eq 'LSHIFT' ) {
                next unless ( defined $a and defined $b );
                $solutions{$sought} = $a << $b;
            } elsif ( $op eq 'RSHIFT' ) {
                next unless ( defined $a and defined $b );
                $solutions{$sought} = $a >> $b;
            }
        } elsif ( $stmt->[1] =~ m/^NOT (\S+)$/ ) {
            my $b = $1;
            if ( $b =~ m/\d+/ ) {
            } elsif ( $b =~ m/\S+/ ) {
                $b = $solutions{$b};
            } else {
                $b = undef;
            }
            $solutions{$sought} = ~$b if defined $b;
        } else {
            my $b = $stmt->[1];
            if ( $b =~ m/\d+/ ) {
            } elsif ( $b =~ m/\S+/ ) {
                $b = $solutions{$b};
            } else {
                $b = undef;
            }
            $solutions{$sought} = $b if defined $b;
        }
    }
}
print $solutions{'a'}, "\n";


64 lines [ Plain text ] [ ^Top ]

Day 7 - alternative 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, $_; }

my @statements;
my %solutions;
my $part2 = shift || 0;
### CODE
while (@input) {
    my @line = split( /\s+/, shift @input );
    my $res = pop @line;
    pop @line;    # assignment arrow
    if ( $part2 and $res eq 'b' ) {
        @line = (956);
    }
    push @statements, [ $res, @line ];
}

sub value_of;

while ( !defined $solutions{'a'} ) {
    foreach my $item (@statements) {
        my @stmt   = @$item;
        my $sought = shift @stmt;

        if ( scalar @stmt == 1 ) {
            my $x = value_of( shift @stmt );
            $solutions{$sought} = $x if defined $x;
        }
        elsif ( scalar @stmt == 2 ) {
            my ( $op, $x ) = @stmt;
            die "unknown operator: $op " unless $op eq 'NOT';
            $x = value_of($x);
            $solutions{$sought} = ~$x if defined $x;
        }
        else {
            my ( $x, $op, $y ) = @stmt;
            die "unknown operator: $op"
              unless ( $op =~ m/AND|LSHIFT|RSHIFT|OR/ );
            $x = value_of($x);
            $y = value_of($y);
            next unless ( defined $x and defined $y );
            if ( $op eq 'AND' ) {
                $solutions{$sought} = $x & $y;
            }
            elsif ( $op eq 'OR' ) {
                $solutions{$sought} = $x | $y;
            }
            elsif ( $op eq 'LSHIFT' ) {
                $solutions{$sought} = $x << $y;
            }
            elsif ( $op eq 'RSHIFT' ) {
                $solutions{$sought} = $x >> $y;
            }
        }
    }
}

say $part2? 2 : 1, ". value of 'a': ", $solutions{'a'};

sub value_of {
    my ($in) = @_;
    if ( defined $solutions{$in} ) {
        return $solutions{$in};
    }
    elsif ( $in =~ m/\d+/ ) {
        return $in;
    }
    else {
        return undef;
    }
}

sub apply_op {
    my ( $x, $op, $y ) = @_;
    $x = value_of($x);
    $y = value_of($y);
    return undef unless ( defined $x and defined $y );
}


76 lines [ Plain text ] [ ^Top ]

Advent of Code 2015 day 8

[ AoC problem link ] [ Discussion ].

Day 8 - part 2


#!/usr/bin/perl
use strict;
use warnings;

my $file = 'input.txt';
open F, "<$file" or die "can't open file: $!";

my $rep = 0;
my $act = 0;
while () {
    chomp;
    s/\r//gm;
    if ( $_ =~ m/^\"(.*)\"$/ ) {
        my @content = split( //, $1 );
        $act += scalar @content;   # add the actual lengh of the representaion
        $rep += scalar @content;   # start with original length
        $act += 2;                 # add the original quote;
        $rep += 2;                 # add the quotes
        $rep += 4;                 # add the encoded quotes
        while (@content) {
            my $c = shift @content;
            if ( $c !~ /\\/ ) {    # not a backslash
                                   # nop
            } else {
                $rep++;            # add the encoded backslash
                $c = shift @content;
                if ( $c eq 'x' ) {    # hex ascii
                                      # nop
                } elsif ( $c eq '"' ) {    #literal quote
                    $rep += 1;
                } elsif ( $c eq '\\' ) {    # literal backslash
                    $rep++;
                }
            }
        }
    } else {
        die "can't parse string: $_\n";
    }
}
close F;

print "Representation: $rep\n";
print "Actual: $act\n";
print "Difference: ", $rep - $act, "\n";


40 lines [ Plain text ] [ ^Top ]

Advent of Code 2015 day 9

[ AoC problem link ] [ Discussion ].

Day 9 - complete solution


#!/usr/bin/perl
use strict;
use warnings;
use Algorithm::Combinatorics qw(permutations);
my $map;
my %destinations;
my $file = 'input.txt';
open F, "<$file" or die "can't open $file: $!\n";
while () {
    chomp;
    s/\r//gm;
    if ( $_ =~ m/^(.*) to (.*) \= (\d+)$/ ) {
        $destinations{$1}++;
        $destinations{$2}++;
        $map->{$1}->{$2} = $3;
        $map->{$2}->{$1} = $3;
    }
}
close F;
my @data = keys %destinations;
my $iter = permutations( \@data );
while ( my $p = $iter->next ) {
    my $dist = 0;
    for ( my $i = 0 ; $i < scalar @{$p} - 1 ; $i++ ) {
        my $j = $i + 1;
        $dist += $map->{ $p->[$i] }->{ $p->[$j] };
    }
    print $dist, ' ', join( ' ', @{$p} ), "\n";
}

28 lines [ Plain text ] [ ^Top ]

Day 9 - alternative complete solution


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

# useful modules
use List::Util qw/max min/;
use Algorithm::Combinatorics qw(permutations);
#### 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 %locations;
my $map;
while (@input) {
    my $line = shift @input;
    if ( $line =~ m/^(\S+) to (\S+) \= (\d+)$/ ) {

        #	$locations{$1}++;
        #	$locations{$2}++;
        $map->{$1}->{$2} = $3;
        $map->{$2}->{$1} = $3;
    }
    else {
        die "cannot parse: $line";
    }
}
my ( $max, $min ) = ( 0, 1e6 );
my $iter = permutations( [ keys %$map ] );
while ( my $p = $iter->next ) {
    my $dist = 0;
    for ( my $i = 0 ; $i < scalar @$p - 1 ; $i++ ) {
        my $j = $i + 1;
        $dist += $map->{ $p->[$i] }->{ $p->[$j] };
    }
    $max = max( $max, $dist );
    $min = min( $min, $dist );
}

say "1. shortest route: $min";
say "2. longest route : $max";


37 lines [ Plain text ] [ ^Top ]

Advent of Code 2015 day 10

[ AoC problem link ] [ Discussion ].

Day 10 - complete solution


#!/usr/bin/perl
use strict;
use warnings;

sub lookandsay {
    my ($in) = @_;
    my @seq = split( //, $in );
    my $c1 = shift @seq;
    my @res;
    push @res, [ $c1, 1 ];
    while (@seq) {
        my $c2 = shift @seq;
        if ( $c1 eq $c2 ) {    # add a count to the character in the result
            $res[ scalar @res - 1 ]->[1]++;
        } else {
            push @res, [ $c2, 1 ];
            $c1 = $c2;
        }
    }
    my $res;
    foreach my $r (@res) {
        $res .= $r->[1] . $r->[0];
    }
    return $res;
}

my $in    = 1113122113;
my $count = 0;

# part 1: change limit to 40
while ( $count < 50 ) {
    my $res = lookandsay($in);
    $in = $res;
    $count++;
}
print length($in), "\n";

31 lines [ Plain text ] [ ^Top ]

Day 10 - alternative complete solution


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

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

### CODE
my $in = shift @input;

my $count = 0;
my $limit = $testing ? 5 : ( $part2 ? 50 : 40 );

# https://rosettacode.org/wiki/Look-and-say_sequence#Perl
while ( $count < $limit ) {
    $in =~ s/((.)\2*)/length($1) . $2/ge;
    $count++;
}

say $part2 ? '2' : '1', ". length of sequence after $limit iterations: ",
  length($in);


18 lines [ Plain text ] [ ^Top ]

Advent of Code 2015 day 11

[ AoC problem link ] [ Discussion ].

Day 11 - 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 $in = shift @input;

sub is_valid {    # used to fine-tune against example data
    my ($p) = @_;

    # we shouldn't generate these but might as well check
    return 0 if $p =~ m/[ilo]/;
    return 0 unless ( $p =~ m/(.)\1.*?(.)\2/g and $1 ne $2 );
    my $pwd = 0;
    my @p = split( //, $p );
    for ( my $i = 0 ; $i < scalar @p - 3 ; $i++ ) {
        if (    ord( $p[$i] ) + 1 == ord( $p[ $i + 1 ] )
            and ord( $p[$i] ) + 2 == ord( $p[ $i + 2 ] )
            and ord( $p[ $i + 1 ] ) + 1 == ord( $p[ $i + 2 ] ) )
        {
            $pwd = $p;
            next;
        }
    }
    return $pwd;
}

sub next_char {
    my ($c) = @_;
    my $next = ord($c) + 1;
    if ( $next == 105 or $next == 108 or $next == 111 ) { $next++ }
    if ( $next == ord('z') + 1 ) { $next = 97 }
    return chr($next);
}

my @pwd = split( //, $in );

# see this as an odometer where a wheel turns over when this is engaged
my $notch = 0;
my @valid = ();
while ( scalar @valid < 2 ) {
    my $next = next_char( $pwd[$#pwd] );
    $pwd[$#pwd] = $next;
    if ( $next eq 'a' ) { $notch = $#pwd - 1 }

    # have we tripped the other wheels?
    while ( $notch > 0 ) {
        my $next = next_char( $pwd[$notch] );
        $pwd[$notch] = $next;
        if   ( $next eq 'a' ) { $notch-- }
        else                  { $notch = 0 }
    }

    # is this a candidate for further checks?
    if ( join( '', @pwd ) =~ m/(.)\1.*?(.)\2/g and $1 ne $2 ) {
        my $v = is_valid( join( '', @pwd ) );
        push @valid, $v if $v;
    }
}
for my $i ( 0, 1 ) {
    say 'Valid password #', $i+1,': ', $valid[$i];
}

57 lines [ Plain text ] [ ^Top ]

Advent of Code 2015 day 12

[ AoC problem link ] [ Discussion ].

Day 12 - complete solution


#!/usr/bin/perl
use strict;
use warnings;
use JSON;
my $part2 = shift || 0;
my $sum = 0;

sub traverse {
    my ($in) = @_;
    if ( ref($in) eq 'ARRAY' ) {
        foreach my $el ( @{$in} ) {
            if ( ref($el) ) {
                traverse($el);
            }
            elsif ( $el =~ m/\d+/ ) {
                $sum += $el;
            }
        }
    }
    elsif ( ref($in) eq 'HASH' ) {

        # need to lookahead if we should even consider this hash
        my $redflag = 0;
        while ( my ( $k, $v ) = each %{$in} ) { $redflag = 1 if $v eq 'red' }

        # comment this next line for part 1 solution
        return if $redflag and $part2;
        foreach my $key ( keys %{$in} ) {
            if ( ref( $in->{$key} ) ) {
                traverse( $in->{$key} );
            }
            elsif ( $in->{$key} =~ m/\d+/ ) {
                $sum += $in->{$key};
            }
        }
    }
    else {    # should not occur according to problem text
        $sum += $in if ( $in =~ m/\d+/ );
    }
}

my $file = 'input.json';
open( my $fh, '<', "$file" ) or die "can't open $file: $!";
my $json_text = <$fh>;
my $data      = decode_json($json_text);

traverse($data);

print 'Part ', $part2 ? '2' : '1', " sum: $sum\n";


42 lines [ Plain text ] [ ^Top ]

Advent of Code 2015 day 13

[ AoC problem link ] [ Discussion ].

Day 13 - complete solution


#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;
use List::Util qw/max/;
use Algorithm::Combinatorics qw(permutations);
#### 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 $part2 = shift || 0;
my $people;
my $feels;
while (@input) {
    my $line = shift @input;
    my ($p1, $op, $val, $p2 ) = ( $line =~ m/^(\S+) would (\S+) (\d+) .* (\S+)\.$/);
    $val = -$val if $op eq 'lose';
    $feels->{$p1}->{$p2} = $val;
    $people->{$p1}++;
    $people->{$p2}++;
}

if ($part2) {
    foreach my $p (keys %{$people}) {
	$people->{Gustaf}++;
	$feels->{Gustaf}->{$p} = 0;
	$feels->{$p}->{Gustaf} = 0;
    }
}
# Generate all permutations
my @list = keys %{$people};

my $arrangement = permutations(\@list);
my $max=0;
while ( my $arr = $arrangement->next ) {
    my $happiness = 0;
    my @arr = @{$arr}; # makes following code a bit easier to write
    for ( my $idx = 0; $idx <= $#arr; $idx++ ) {
	if ( $idx == 0 ) { # start of the list
	    $happiness += ($feels->{$arr[$idx]}->{$arr[$idx+1]} +
			   $feels->{$arr[$idx]}->{$arr[$#arr]} )
	} elsif ( $idx == $#arr ) { # end of the list
	    $happiness += ($feels->{$arr[$idx]}->{$arr[0]} +
			   $feels->{$arr[$idx]}->{$arr[$idx-1]} )
	} else {
	    $happiness += ( $feels->{$arr[$idx]}->{$arr[$idx+1]} +
			    $feels->{$arr[$idx]}->{$arr[$idx-1]} )
	}
    }
    #    print $happiness, ' ', join(' ', @arr), "\n";
    $max = max($max, $happiness);
}

say $part2?'2':'1',". happiness change: $max";

50 lines [ Plain text ] [ ^Top ]

Advent of Code 2015 day 14

[ AoC problem link ] [ Discussion ].

Day 14 - 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 $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;
my %points;

while (@input) {
    my $line = shift @input;
    my ( $id, $speed, $fly, $rest ) =
      ( $line =~ m/^(\S+) can fly (\d+) km\/s for (\d+) .* (\d+) seconds\.$/ );
    $data{$id} = { speed => $speed, fly => $fly, rest => $rest };
    $points{$id} =
      { distance => 0, points => 0, status => 'fly', time => $fly };
}

my $limit = $testing ? 1_000 : 2_503;

my $time = 1;

while ( $time <= $limit ) {    #check each second
    foreach my $d ( keys %points ) {
        my ( $fly_t, $rest_t, $speed ) =
          map { $data{$d}->{$_} } qw/fly rest speed/;
        if ( $points{$d}->{status} eq 'fly' ) {
            $points{$d}->{distance} += $speed;
        }
        $points{$d}->{time}--;
        if ( $points{$d}->{time} == 0 ) {    # switch status
            if ( $points{$d}->{status} eq 'fly' ) {
                $points{$d}->{status} = 'rest';
                $points{$d}->{time}   = $rest_t;
            }
            else {
                $points{$d}->{status} = 'fly';
                $points{$d}->{time}   = $fly_t;
            }
        }
    }

    my $max = 0;
    foreach my $d ( sort { $points{$b}->{distance} <=> $points{$a}->{distance} }
        keys %points )
    {
        $max = max( $max, $points{$d}->{distance} );
        $points{$d}->{points}++ if $points{$d}->{distance} == $max;
    }
    $time++;
}

my $win_distance =
  ( sort { $points{$b}->{distance} <=> $points{$a}->{distance} } keys %points )
  [0];
say
"1. winning the distance: $win_distance, with $points{$win_distance}->{distance} km";
my $win_points =
  ( sort { $points{$b}->{points} <=> $points{$a}->{points} } keys %points )[0];
say
  "2. winning the points: $win_points, with $points{$win_points}->{points} pts";


58 lines [ Plain text ] [ ^Top ]

Day 14 - complete solution with fancy scoreboard


#!/usr/bin/perl
use strict;
use warnings;

my $file = 'input.txt';
open F, "<$file" or die "can't open file: $!\n";

my %data; my %points;
while (  ) {
    chomp;
    s/\r//gm;
    my ( $reindeer, $speed, $fly, $rest ) =
      ( $_ =~ m/^(\S+) can fly (\d+) km\/s for (\d+) .* (\d+) seconds\.$/ );
    $data{$reindeer} = { speed => $speed, fly => $fly, rest => $rest };
    # starting values
    $points{$reindeer} = { distance => 0, points => 0,
			   status => 'fly', time => $fly };
}

my $limit = ($file eq 'test.txt') ? 1_000 : 2_503;

my $time = 1;

while ( $time <= $limit ) { # check each second
    foreach my $deer ( keys %points ) {
	my ( $fly_time, $rest_time, $speed ) =
	  map { $data{$deer}->{$_} } qw/fly rest speed/;
	if ( $points{$deer}->{status} eq 'fly'  ) {
	    $points{$deer}->{distance} += $speed;
	}
	$points{$deer}->{time}--;
	if ( $points{$deer}->{time} == 0 ) { # switch status
	    if ( $points{$deer}->{status} eq 'fly' ) {
		$points{$deer}->{status} = 'rest';
		$points{$deer}->{time} = $rest_time;
	    } else {
		$points{$deer}->{status} = 'fly';
		$points{$deer}->{time} = $fly_time;
	    }
	}
    }

    # check distance, award points
    my $max = 0;
    foreach my $deer ( sort {$points{$b}->{distance}
			       <=> $points{$a}->{distance} } keys %points ) {
	$max = $points{$deer}->{distance} if $points{$deer}->{distance} > $max;
	$points{$deer}->{points}++ if $points{$deer}->{distance} == $max;
    }
    $time++;
}

# present results for 1 and 2  in a fancy way
my %categories = ( points => { desc => 'Points' },
		   distance => { desc => 'Distance' } );

foreach my $category ( sort keys %categories ) {
    my $rank = 1;
    printf("%s\n", $categories{$category}->{desc});
    print join('', '=' x length($categories{$category}->{desc})),"\n";
    foreach my $deer ( sort {$points{$b}->{$category}
			   <=> $points{$a}->{$category}} keys %points ) {
	printf("\#%d   %4s%s%s\n",
	       $rank,
	       $deer,
	       join('', ' ' x (14 - length($deer) - length($points{$deer}->{$category}))),
		   $points{$deer}->{$category});
	$rank++;
    }
    
    print "\n";
}


61 lines [ Plain text ] [ ^Top ]

Advent of Code 2015 day 15

[ AoC problem link ] [ Discussion ].

Day 15 - complete solution


#!/usr/bin/perl
use strict;
use warnings;

my %data;
my $part2 = shift || 0;
my $file = 'input.txt';
open F, "<$file" or die "can't open file: $!\n";
while () {
    chomp;
    s/\r//gm;
    my ( $ingr, $cap, $dur, $flv, $tex, $cal ) =
      ( $_ =~
          m/^(\S+): .* (-?\d+),.* (-?\d+),.* (-?\d+),.* (-?\d+),.* (-?\d+)$/ );

    # each property gets an arrayref representing the ingredients
    push @{ $data{'cap'} }, $cap;
    push @{ $data{'dur'} }, $dur;
    push @{ $data{'flv'} }, $flv;
    push @{ $data{'tex'} }, $tex;
    push @{ $data{'cal'} }, $cal;
}

my @proportions;
foreach my $a ( 1 .. 100 ) {
    foreach my $b ( 1 .. ( 100 - $a ) ) {
        foreach my $c ( 1 .. ( 100 - ( $a + $b ) ) ) {
            foreach my $d ( 1 .. ( 100 - ( $a + $b + $c ) ) ) {
                next unless ( $a + $b + $c + $d ) == 100;
                push @proportions, [ $a, $b, $c, $d ];
            }
        }
    }
}
my %scores;
foreach my $proportion (@proportions) {
    my $cookie_score  = 1;
    my $calorie_count = 0;
    foreach my $property ( keys %data ) {
        my $property_score = 0;
        for ( my $idx = 0 ; $idx <= $#{$proportion} ; $idx++ ) {
            my $val = $proportion->[$idx] * ( $data{$property}->[$idx] );
            if ( $property eq 'cal' ) {
                $calorie_count += $val;
            }
            else {
                $property_score += $val;
            }
        }
        if ( $property_score < 1 ) { $property_score = 0 }
        $cookie_score *= $property_score unless $property eq 'cal';
    }
    if ($part2) {
        next unless $calorie_count == 500;
    }
    $scores{ join( ',', @$proportion ) } =
      { score => $cookie_score, cals => $calorie_count };
}

my $win =
  ( sort { $scores{$b}->{score} <=> $scores{$a}->{score} } keys %scores )[0];
print $part2? '2' : '1', ". winning score: ", $scores{$win}->{score}, "\n";


57 lines [ Plain text ] [ ^Top ]

Advent of Code 2015 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 $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 $part2 = shift || 0;
my %aunts;

while (@input) {
    my $line = shift @input;
    my ( $aunt, $props ) = ( $line =~ m/^Sue (\d+): (.*)$/ );
    foreach my $p ( split( /,/, $props ) ) {
        my ( $k, $v ) = ( $p =~ m/(\S+)\: (\d+)/ );
        $aunts{$aunt}->{$k} = $v;
    }
}

my %clues;
while () {
    chomp;
    my ( $key, $val ) = ( $_ =~ /^(\S+)\: (\d+)$/ );
    $clues{$key} = $val;
}
my %scores;
foreach my $aunt ( keys %aunts ) {
    my $score      = 0;
    my %properties = %{ $aunts{$aunt} };
    foreach my $clue ( keys %clues ) {
        if ( exists $properties{$clue} ) {
            if ( $part2 and ( $clue eq 'cats' or $clue eq 'trees' ) ) {
                $score++ if $properties{$clue} > $clues{$clue};
            }
            elsif ( $part2
                and ( $clue eq 'goldfish' or $clue eq 'pomeranians' ) )
            {
                $score++ if $properties{$clue} < $clues{$clue};
            }
            else {
                $score++ if $properties{$clue} == $clues{$clue};
            }
        }
    }
    $scores{$aunt} = $score;

    #    print "$score $aunt\n";
}

my $winner = ( sort { $scores{$b} <=> $scores{$a} } keys %scores )[0];

say $part2? '2' : '1', ". ", $part2 ? 'real' : '',
  " Aunt Sue is nr $winner with score $scores{$winner}";

__DATA__
children: 3
cats: 7
samoyeds: 2
pomeranians: 3
akitas: 0
vizslas: 0
goldfish: 5
trees: 3
cars: 2
perfumes: 1

60 lines [ Plain text ] [ ^Top ]

Advent of Code 2015 day 17

[ AoC problem link ] [ Discussion ].

Day 17 - complete solution


#!/usr/bin/perl
use strict;
use warnings;
use feature qw(say);
use Algorithm::Combinatorics qw(combinations);
use List::Util qw(sum minstr);

my $testing = 0;
my $file = $testing ? 'test.txt' : 'input.txt' ;
open F, "<$file" or die "can't open file: $!\n";

my $containers;
while (  ) {
    chomp;
    s/\r//gm;
    push @{$containers}, $_;
}
close F;

my $target = $testing ? 25 : 150;
my $count = 0;
my %number_of_containers;

foreach my $k ( 4 .. 8 ) { # why these values?
    # Inspecting the input, not even the 3 largest elements will sum
    # to the target, and even the first 9 smallest elements will
    # exceed it
    my $iter = combinations($containers, $k);
    while ( my $comb = $iter->next ) {
        if ( sum(@{$comb}) == $target ) {
            $count++;
            $number_of_containers{scalar @{$comb}}++;
        }
    }
}
say "Part 1: $count";
say "Part 2: ", $number_of_containers{ minstr( keys %number_of_containers ) };

32 lines [ Plain text ] [ ^Top ]

Advent of Code 2015 day 18

[ AoC problem link ] [ Discussion ].

Day 18 - complete solution


#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;
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

my $part2 = shift || 0;
my $row=0;
my $curr;
my $next;
while (@input) {
    my @line = split(//,shift @input);
    my $col = 0;
    foreach my $el (@line) {
	if ($el eq '#') {
	    $curr->{$row}->{$col} = 1
	} else {
	    $curr->{$row}->{$col} =0 
	}
	$col++;
    }
    $row++;
}

if ($part2) {
    $curr->{0}->{0} = 1;
    $curr->{0}->{$row-1} = 1;
    $curr->{$row-1}->{0} = 1;
    $curr->{$row-1}->{$row-1}=1;
}

sub dump_grid;
my $max_steps = $testing ? ( $part2?5:4 ) : 100;
my $step = 0;
while ( $step < $max_steps ) {
    foreach my $r (  keys %{$curr} ) { 
        foreach my $c (  keys %{$curr->{$r}} ) {
            # check surrounding lights
            my $lit = 0;
            foreach my $i ( -1, 0, 1 ) {
                foreach my $j ( -1, 0, 1 ) {
                    next if ( $c+$j == $c and $r+$i == $r ); # skip current
                    if ( !defined( $curr->{$r+$i}->{$c+$j} ) or
                         $curr->{$r+$i}->{$c+$j} == 0 ) { #nop
                    } else {
                        $lit++
                    }
                }
            }

            # decide what to do
            if ( $curr->{$r}->{$c} == 0 and $lit == 3 ) {
                $next->{$r}->{$c} = 1
            } elsif ( $curr->{$r}->{$c} == 1 and !( $lit == 2 or $lit == 3 ) ){
                $next->{$r}->{$c} = 0
            } else {
                $next->{$r}->{$c} = $curr->{$r}->{$c}
            }
            if ( $part2 ) { # ensure corners lit
                $next->{0}->{0} = 1;
                $next->{0}->{$row-1} = 1;
                $next->{$row-1}->{0} = 1;
                $next->{$row-1}->{$row-1} = 1;
            }
        }
    }
    if ( $testing ) { say "Step $step:"; dump_grid($next);     say ''; }

    $curr = dclone($next);
    $step++;
}

# count lit lights
my $count =0;
foreach my $r ( keys %{$curr} ) {
    foreach my $c ( keys %{$curr->{$r}} ) {
        $count++ if $curr->{$r}->{$c} == 1
    }
}
printf("Result part %d: %d\n", $part2?2:1, $count);

###############################################################################
sub dump_grid { # used for debugging
    my ( $matrix ) = @_;
    foreach my $r ( sort {$a<=>$b} keys %{$matrix} ) {
        foreach my $c ( sort {$a<=>$b} keys %{$matrix->{$r}} ) {
            print $matrix->{$r}->{$c}
        }
        say '';
    }
}

86 lines [ Plain text ] [ ^Top ]

Advent of Code 2015 day 19

[ AoC problem link ] [ Discussion ].

Day 19 - part 1


#!/usr/bin/perl
use strict;
use warnings;
use feature qw/say/;

my $testing = 0;
my $file = $testing ? 'test.txt' : 'input.txt';
open F, "<$file" or die "can't open file: $!\n";
my %replacements;
my $source;

while () {
    chomp;
    s/\r//gm;
    next unless $_ =~ m/^\S+/;
    if ( $_ =~ m/^(\S+) => (\S+)$/ ) {
        push @{ $replacements{$1}->{vals} }, $2;
    }
    $source = $_;    # will be last
}
close F;

# split the source
foreach my $repl ( keys %replacements ) {
    while ( $source =~ m/$repl/g ) {
        push @{ $replacements{$repl}->{pos} }, [ $-[0], $+[0] ];
    }
}

foreach my $key ( sort keys %replacements ) {
    foreach my $rep ( @{ $replacements{$key}->{vals} } ) {
        foreach my $pos ( @{ $replacements{$key}->{pos} } ) {
            my $head = substr( $source, 0, $pos->[0] );
            my $tail = substr( $source, $pos->[1] );
            say $head. $rep . $tail;
        }
    }
}

32 lines [ Plain text ] [ ^Top ]

Day 19 - part 2 alternative solution


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

# 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
# adapted from https://www.reddit.com/r/adventofcode/comments/3xflz8/day_19_solutions/cy4k8ca/ by Reddit user /u/askalski
my %rules;
my $string = reverse pop @input;
pop @input;

while (@input) {
    my $line = shift @input;
    if ( $line =~ m/^(\S+) \=\> (\S+)$/ ) {
        $rules{ reverse $2 } = reverse $1;
    }
}

my $count = 0;
while ( $string =~ s/(@{[ join "|", keys %rules ]})/$rules{$1}/ ) {
    $count++;
}

say "2. shortest number of steps: $count";

24 lines [ Plain text ] [ ^Top ]

Advent of Code 2015 day 20

[ AoC problem link ] [ Discussion ].

Day 20 - complete solution


#!/usr/bin/perl
use strict;
use warnings;
use feature qw/say/;
use List::Util qw/sum/;

my $part    = 2;
my $testing = 0;
my $target  = $testing ? 1_000 : 36_000_000;

sub divisors {

    # algo from http://www.perlmonks.org/?node_id=371578
    my ($n) = @_;
    my @divisors = grep { $n % $_ == 0 } ( 1 .. sqrt($n) );
    push @divisors, map { $n == $_ * $_ ? () : $n / $_ } reverse @divisors;

    return \@divisors;
}

sub divisors2 {

# method from https://www.reddit.com/r/adventofcode/comments/3xjpp2/day_20_solutions/cy5dias
    my ($n) = @_;
    my $x = 1;
    my @divisors;
    while ( $x**2 <= $n and $x <= 50 ) {
        if ( $n % $x == 0 ) {
            push @divisors, $n / $x;
        }
        $x++;
    }
    return \@divisors;
}

my $elf = 1;
if ( $part != 2 ) {
    while ( 10 * sum( @{ divisors($elf) } ) < $target ) {
        warn "==> $elf\n" if $elf % 1_000 == 0;
        $elf++;
    }
} else {
    while ( 11 * sum( @{ divisors2($elf) } ) < $target ) {
        warn "==> $elf\n" if $elf % 1_000 == 0;
        $elf++;
    }
}
say $elf;

39 lines [ Plain text ] [ ^Top ]

Advent of Code 2015 day 21

[ AoC problem link ] [ Discussion ].

Day 21 - complete solution


#!/usr/bin/perl
use strict;
use warnings;
use feature qw/say/;
use List::Util qw/sum/;

my %boss = ( HP => 109, damage => 8, armor => 2 );

my %weapons = ( Dagger     => { cost => 8,  damage => 4, defense => 0 },
                Shortsword => { cost => 10, damage => 5, defense => 0 },
                Warhammer  => { cost => 25, damage => 6, defense => 0 },
                Longsword  => { cost => 40, damage => 7, defense => 0 },
                Greataxe   => { cost => 74, damage => 8, defense => 0 } );
my %armors = ( Leather    => { cost => 13,  defense => 1, damage => 0 },
               Chainmail  => { cost => 31,  defense => 2, damage => 0 },
               Splintmail => { cost => 53,  defense => 3, damage => 0 },
               Bandedmail => { cost => 75,  defense => 4, damage => 0 },
               Platemail  => { cost => 102, defense => 5, damage => 0 },
               None       => { cost => 0,   defense => 0, damage => 0 } );
my %rings = ( 'Damage +1'  => { cost => 25,  damage  => 1, defense => 0 },
              'Damage +2'  => { cost => 50,  damage  => 2, defense => 0 },
              'Damage +3'  => { cost => 100, damage  => 3, defense => 0 },
              'Defense +1' => { cost => 20,  defense => 1, damage  => 0 },
              'Defense +2' => { cost => 40,  defense => 2, damage  => 0 },
              'Defense +3' => { cost => 80,  defense => 3, damage  => 0 },
              None         => { cost => 0,   defense => 0, damage  => 0 } );

my @loadouts;
my %combo;
foreach my $weapon ( sort keys %weapons ) {
    $combo{weapon} = $weapon;

    # add armor
    foreach my $armor ( sort ( keys %armors ) ) {
        $combo{armor} = $armor;

        # right hand
        foreach my $ring_rh ( sort ( keys %rings ) ) {
            $combo{RH} = $ring_rh;

            # left hand
            foreach my $ring_lh ( sort ( keys %rings ) ) {
                next if ( ( $ring_lh eq $ring_rh ) and $ring_lh ne 'None' );
                $combo{LH} = $ring_lh;

                $combo{cost} = sum( $weapons{ $combo{weapon} }->{cost},
                                    $armors{ $combo{armor} }->{cost},
                                    $rings{ $combo{RH} }->{cost},
                                    $rings{ $combo{LH} }->{cost} );
                $combo{defense} = sum( $weapons{ $combo{weapon} }->{defense},
                                       $armors{ $combo{armor} }->{defense},
                                       $rings{ $combo{RH} }->{defense},
                                       $rings{ $combo{LH} }->{defense} );
                $combo{damage} = sum( $weapons{ $combo{weapon} }->{damage},
                                      $armors{ $combo{armor} }->{damage},
                                      $rings{ $combo{RH} }->{damage},
                                      $rings{ $combo{LH} }->{damage} );
                push @loadouts,
                    { items => join( ',',
                                     map { $combo{$_} } qw/weapon armor RH LH/
                      ),
                      cost    => $combo{cost},
                      defense => $combo{defense},
                      damage  => $combo{damage} };
            }
        }
    }
}
foreach my $l (@loadouts) {

    # simulate a battle!
    my $player = 100;
    my $boss   = $boss{HP};
    while ( $player >= 0 and $boss >= 0 ) {

        # player attacks
        my $attack
            = $l->{damage} - $boss{armor} <= 0
            ? 1
            : $l->{damage} - $boss{armor};
        $boss -= $attack;

        # boss attacks
        my $defend
            = $boss{damage} - $l->{defense} <= 0
            ? 1
            : $boss{damage} - $l->{defense};
        $player -= $defend;
    }
    say join( ' ', $l->{cost}, $player < $boss ? 'Loss' : 'Win' );
}

80 lines [ Plain text ] [ ^Top ]

Advent of Code 2015 day 22

[ AoC problem link ] [ Discussion ].

Day 22 - complete solution


#!/usr/bin/perl
use strict;
use warnings;
use feature qw/say/;
use List::Util qw/sum/;
use Data::Dumper;

my $testing = 0;
my $debug   = 0;
my $part    = 2;
my %spells = ( 'Magic Missile' => { cost => 53,  damage => 4 },
               Drain           => { cost => 73,  damage => 2, heal => 2 },
               Shield          => { cost => 113, effect => 6, armor => 7 },
               Poison          => { cost => 173, effect => 6, damage => 3 },
               Recharge        => { cost => 229, effect => 5, mana => 101 } );

my %player;
my %boss;
my %active;

sub apply_effect {
    my ($sp) = @_;
    say "  --> applying effect for spell: $sp" if $debug;
    if ( $sp eq 'Poison' ) {
        $boss{HP} -= $spells{$sp}->{damage};
        $active{$sp}--;
    } elsif ( $sp eq 'Shield' ) {
        $player{armor} = $spells{$sp}->{armor};
        $active{$sp}--;
    } elsif ( $sp eq 'Recharge' ) {
        $player{mana} += $spells{$sp}->{mana};
        $active{$sp}--;
    } else {
        die "what sorcery is this?! $sp\n";
    }
    say "  --> $sp has timer $active{$sp}" if $debug;
}

foreach my $run ( 1 .. 500_000 ) {    # may not be enough to find
                                      # solution in hard mode
    %player
        = $testing
        ? ( mana => 250, HP => 10, armor => 0 )
        : ( mana => 500, HP => 50, armor => 0 );
    %boss
        = $testing
        ? ( HP => 14, damage => 8 )
        : ( HP => 71, damage => 10 );
    %active = ( Recharge => 0, Shield => 0, Poison => 0 );
    my $cost = 0;
    my @seq  = ();
    my $turn = 1;

    say "RUN: $run" if $debug;
    while ( ( $player{HP} > 0 and $player{mana} > 0 ) and $boss{HP} > 0 ) {
        say "==> $turn" if $debug;

        # player always goes first

        say "-- Player turn --" if $debug;
        $player{HP}-- if $part == 2;    # hard mode
        say
"- Player has $player{HP} HP, $player{armor} armor, $player{mana} mana\n- Boss has $boss{HP} HP"
            if $debug;

        # are effects in play?
        foreach my $act ( keys %active ) {
            apply_effect($act) if $active{$act} > 0;
            $player{armor} = 0 if $active{Shield} <= 0;
        }

        # choose a random spell
        my $spell;
        do {
            $spell = ( keys %spells )[ rand keys %spells ];
        } until ( !exists $active{$spell} or $active{$spell} <= 0 );

        # all spells cost something
        $cost += $spells{$spell}->{cost};
        $player{mana} -= $spells{$spell}->{cost};
        push @seq, $spell;

        say "Player casts $spell for $spells{$spell}->{cost} mana" if $debug;
        if ( $spell eq 'Magic Missile' ) {
            $boss{HP} -= $spells{$spell}->{damage};
        } elsif ( $spell eq 'Drain' ) {
            $player{HP} += $spells{$spell}->{heal};
            $boss{HP} -= $spells{$spell}->{damage};
        } elsif ( $spell eq 'Shield' ) {
            $active{$spell} = $spells{$spell}->{effect};
            say "$spell activated, timer: $active{$spell}" if $debug;
            $player{armor} = 7;    # should not be cumulative
        } elsif ( $spell eq 'Poison' ) {
            $active{$spell} = $spells{$spell}->{effect};
            say "$spell activated, timer: $active{$spell}" if $debug;
        } elsif ( $spell eq 'Recharge' ) {
            $active{$spell} = $spells{$spell}->{effect};
            say "$spell activated, timer: $active{$spell}" if $debug;
        } else {
            die "what sorcery is this?! $spell\n";
        }
        last if ( $boss{HP} <= 0 );
        if ( $player{mana} < 0 ) { $player{HP} = -100; last; }

        # boss turn
        say "-- Boss turn --" if $debug;
        say
"- Player had $player{HP} HP, $player{armor} armor, $player{mana} mana\n- Boss has $boss{HP} HP"
            if $debug;

        foreach my $act ( keys %active ) {
            apply_effect($act) if $active{$act} > 0;
            $player{armor} = 0 if $active{Shield} <= 0;
        }
        last if ( $boss{HP} <= 0 );
        say "Boss attacks for $boss{damage}" if $debug;
        if ( $boss{damage} - $player{armor} < 0 ) {
            $player{HP}--;
        } else {
            $player{HP} -= ( $boss{damage} - $player{armor} );
        }

        # exit conditions
        last if ( $player{HP} <= 0 or $boss{HP} <= 0 );
        last if ( $player{mana} <= 0 );
        $turn++;
    }
    warn "==> $run\n" if $run % 10_000 == 0;
    say $cost, ' ', $player{HP} > $boss{HP} ? 'Win ' : 'Loss ',
        join( ', ', @seq ), ' ', sum( map { $spells{$_}->{cost} } @seq );
}

116 lines [ Plain text ] [ ^Top ]

Advent of Code 2015 day 23

[ AoC problem link ] [ Discussion ].

Day 23 - complete solution


#!/usr/bin/perl
use strict;
use warnings;
use feature qw/say/;

my $debug   = 0;
my $testing = 0;
my $file    = $testing ? 'test.txt' : 'input.txt';

my @tape;

open F, "<$file" or die "can't open file: $!\n";
while () {
    chomp;
    s/\r//gm;
    my ( $cmd, $reg, $arg ) = ( undef, undef, undef );
    if ( $_ =~ m/^(...) (.)$/ ) {
        ( $cmd, $reg ) = ( $1, $2 );
        push @tape, [ $cmd, $reg, undef ];
    } elsif ( $_ =~ m/^(...) (.), ([-+]\d+)$/ ) {
        ( $cmd, $reg, $arg ) = ( $1, $2, $3 );
        push @tape, [ $cmd, $reg, $arg ];
    } elsif ( $_ =~ m/^(...) ([-+]\d+)$/ ) {
        ( $cmd, $arg ) = ( $1, $2 );
        push @tape, [ $cmd, undef, $arg ];
    } else {
        die "cannot parse: $_ \n";
    }
}
close F;

my $pos = 0;
my %reg = ( a => 0, b => 0 );

while ( $pos >= 0 and $pos <= $#tape ) {
    my @input = @{ $tape[$pos] };
    say "$pos: a=$reg{a} b=$reg{b} : ",
        join( ' ', map { $_ ? $_ : ' ' } @input )
        if $debug;
    my ( $cmd, $var, $offset ) = @input;
    if ( $cmd eq 'inc' ) {
        $reg{$var}++;
        $pos++;
    } elsif ( $cmd eq 'tpl' ) {
        $reg{$var} = $reg{$var} * 3;
        $pos++;
    } elsif ( $cmd eq 'hlf' ) {
        $reg{$var} = $reg{$var} / 2;
        $pos++;
    } elsif ( $cmd eq 'jmp' ) {
        $pos += $offset;
    } elsif ( $cmd eq 'jie' ) {
        if ( $reg{$var} % 2 == 0 ) {
            $pos += $offset;
        } else {
            $pos++;
        }
    } elsif ( $cmd eq 'jio' ) {
        if ( $reg{$var} == 1 ) {
            $pos += $offset;
        } else {
            $pos++;
        }
    } else {
        die "can't recognise cmd: $cmd\n";
    }
}

say "a=$reg{a}, b=$reg{b}";

62 lines [ Plain text ] [ ^Top ]

Advent of Code 2015 day 24

[ AoC problem link ] [ Discussion ].

Day 24 - complete solution


#!/usr/bin/perl
use strict;
use warnings;
use feature qw/say/;
use Algorithm::Combinatorics qw/combinations/;
use List::Util qw/sum/;

my $part    = 2;
my $testing = 0;
my $debug   = 0;
my $file    = $testing ? 'test.txt' : 'input.txt';

sub product {    # my version of List::Util doesn't include a 'product'
    my @list = @_;
    return undef if scalar @list == 0;
    my $product = 1;
    foreach my $el (@list) {
        $product *= $el;
    }
    return $product;
}

my $sum = 0;
my @pkgs;
open F, "<$file" or die "can't open file: $!\n";
while () {
    chomp;
    s/\r//gm;
    push @pkgs, $_;
    $sum += $_;
}
close F;

my $target;
if ( $part == 2 ) {
    $target = $sum / 4;
} else {
    $target = $sum / 3;
}

@pkgs = sort { $b <=> $a } @pkgs;

# iterate over combinations until we get the desired sum
my $ans = 'Inf';
foreach my $n ( 1 .. 6 ) {    # hardcoded limit
    my $iter = combinations( \@pkgs, $n );
    while ( my $c = $iter->next ) {
        next unless $target == sum @{$c};

        # As a first approximation, assume we don't have to check the
        # rest of the packages -- just go with the first one we find.
        my $prod = product @{$c};
        say $prod, ' ', join( ' ', @{$c} ) if $debug;
        $ans = $prod if $prod < $ans;
    }
}
say $ans if ( $ans ne 'Inf' );

48 lines [ Plain text ] [ ^Top ]

Advent of Code 2015 day 25

[ AoC problem link ] [ Discussion ].

Day 25 - complete solution


#!/usr/bin/perl
use strict;
use warnings;
use feature qw/say/;
use List::Util qw/sum/;
use Data::Dumper;

sub intdiv {    # divide a / b, return quotient and remainder
                # source: http://www.perlmonks.org/index.pl?node_id=981275
    use integer;
    my ( $a, $b ) = @_;
    my $q = $a / $b;
    my $r = $a % $b;
    return ( $q, $r );
}

my $debug   = 0;
my $testing = 0;
my ( $target_row, $target_col );
my $file = 'input.txt';
open F, "<$file" or die "can't open file: $!\n";
while () {
    chomp;
    s/\r//gm;
    ( $target_row, $target_col ) = ( $_ =~ /^.*row (\d+), column (\d+)\.$/ );
}
close F;

my $start   = 20151125;
my $factor  = 252533;
my $divisor = 33554393;

sub new_code {
    my ($input) = @_;
    my ( $p, $q ) = intdiv( $input * $factor, $divisor );
    return $q;
}
if ($testing) {
    ( $target_row, $target_col ) = ( 6, 6 );
}

say "Target values: row=$target_row, col=$target_col" if $debug;
my @testdata;
while () {
    chomp;
    my @row = split( /\s+/, $_ );
    push @testdata, \@row;
}

my $prev = $start;
my $next;
my $row = 2;
while ( $row <= $target_row + $target_col - 1 ) {
    say "$row" if $debug;
    my $cur_r = $row;
    my $col   = 1;
    while ( $cur_r >= 1 ) {
        $next = new_code($prev);
        if ( $cur_r <= $target_row and $col <= $target_col and $testing ) {
            die
"$cur_r,$col: $next not equal to testing data $testdata[$cur_r][$col]\n"
                unless ( $next == $testdata[$cur_r][$col] );
        }
        say "Answer = $next"
            if ( $cur_r == $target_row and $col == $target_col );
        $col++;
        $cur_r--;
        $prev = $next;
    }
    $row++;
}

__DATA__
0     1         2         3         4         5         6
1  20151125  18749137  17289845  30943339  10071777  33511524
2  31916031  21629792  16929656   7726640  15514188   4041754
3  16080970   8057251   1601130   7981243  11661866  16474243
4  24592653  32451966  21345942   9380097  10600672  31527494
5     77061  17552253  28094349   6899651   9250759  31663883
6  33071741   6796745  25397450  24659492   1534922  27995004

72 lines [ Plain text ] [ ^Top ]

Generated on Tue Jan 2 08:19:55 2018 UTC.