This are my solutions for this year's contest.
If you want to copy these files, use the GitHub link.
All files covered by the UNLICENSE.
[ AoC problem link ] [ Discussion ].
#!/usr/bin/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 ]
[ AoC problem link ] [ Discussion ].
#!/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 ]
[ AoC problem link ] [ Discussion ].
#!/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 ]
#!/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 ]
[ AoC problem link ] [ Discussion ].
#!/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 ]
[ AoC problem link ] [ Discussion ].
#!/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 ]
#!/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 ]
[ AoC problem link ] [ Discussion ].
#!/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 ]
#!/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 ]
[ AoC problem link ] [ Discussion ].
#!/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 ]
#!/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 ]
[ AoC problem link ] [ Discussion ].
#!/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 ]
[ AoC problem link ] [ Discussion ].
#!/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 ]
#!/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 ]
[ AoC problem link ] [ Discussion ].
#!/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 ]
#!/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 ]
[ AoC problem link ] [ Discussion ].
#!/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 ]
[ AoC problem link ] [ Discussion ].
#!/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 ]
[ AoC problem link ] [ Discussion ].
#!/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 ]
[ AoC problem link ] [ Discussion ].
#!/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 ]
#!/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 ]
[ AoC problem link ] [ Discussion ].
#!/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 ]
[ AoC problem link ] [ Discussion ].
#!/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 ]
[ AoC problem link ] [ Discussion ].
#!/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 ]
[ AoC problem link ] [ Discussion ].
#!/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 ]
[ AoC problem link ] [ Discussion ].
#!/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 ]
#!/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 ]
[ AoC problem link ] [ Discussion ].
#!/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 https://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 ]
[ AoC problem link ] [ Discussion ].
#!/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 ]
[ AoC problem link ] [ Discussion ].
#!/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 ]
[ AoC problem link ] [ Discussion ].
#!/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 ]
[ AoC problem link ] [ Discussion ].
#!/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 ]
[ AoC problem link ] [ Discussion ].
#!/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: https://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.