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 5.016;
use warnings;
use autodie;
#### INIT - load input data into array
my $testing = 0;
my @input;
my $file = $testing ? 'test.txt' : 'input.txt';
{
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }
}
### CODE
my @list = split( //, shift @input );
my $length = scalar @list;
my $sum_1 = 0;
my $sum_2 = 0;
# circular list, just make a copy to avoid funky rollover arithmetic
my @check = ( @list, @list );
for ( my $i = 0 ; $i <= $length - 1 ; $i++ ) {
my $j = $i + $length / 2;
if ( $check[$i] == $check[ $i + 1 ] ) { $sum_1 += $check[$i] }
if ( $check[$i] == $check[$j] ) { $sum_2 += $check[$i] }
}
say "Captcha 1: $sum_1";
say "Captcha 2: $sum_2";
22 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;
use List::Util qw/max min/;
#### INIT - load input data into array
my @input;
my $file = 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }
### CODE
my $sum_1 = 0;
my $sum_2 = 0;
foreach my $line (@input) {
# sort the values for easier division comparison down the line
my @row = sort { $b <=> $a } split( /\s+/, $line );
$sum_1 += $row[0] - $row[$#row];
my $found = 0;
while ( @row and !$found ) {
my $a = shift @row;
# using a reverse here slightly increases the chance of
# finding a divisor faster
foreach my $b ( reverse @row) {
if ( $a % $b == 0 ) {
$sum_2 += $a / $b;
$found = 1;
}
}
}
}
say "Checksum : $sum_1";
say "Sum of results: $sum_2";
29 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;
use List::Util qw/min/;
#### INIT - load input data into array
my @input;
my $file = 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }
### CODE
my $target = $input[0];
sub diagonal_values {
# from Project Euler 28, the values of numbers on diagonals
my ($x) = @_;
my $n = 2 * $x + 1;
return [
$n * $n - 3 * $n + 3,
$n * $n - 2 * $n + 2,
$n * $n - $n + 1,
$n * $n
];
}
my $x = 0;
my $distance = 0;
while (1) {
my $diags = diagonal_values($x);
# find the "ring" where the target value lies
if ( $target >= $diags->[0] and $target <= $diags->[3] ) {
# the diagonal values represent the largest Manhattan distance 2x
# find the minimum distance to the diagonals
my $min = min( map { abs( $target - $diags->[$_] ) } ( 0, 1, 2, 3 ) );
$distance = 2 * $x - $min;
last;
}
$x++;
}
say "Steps to take: $distance";
35 lines [ Plain text ] [ ^Top ]
#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;
use List::Util qw/sum/;
#### INIT - load input data into array
my @input;
my $file = 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }
### CODE
#### subs
# these are from the chapter on iterators in HOP, but not in a
# separate module
sub NEXTVAL { $_[0]->() }
sub Iterator (&) { return $_[0] }
# an iterator for steplengths
# we go 1,1,2,2,3,3,... steps before changing direction
sub steplengths {
my ($m) = @_;
my $flag = 0;
return Iterator {
if ( $flag % 2 == 0 ) {
$m++;
}
$flag++;
return $m;
}
}
my $M;
sub adjacent_sum {
my ( $x, $y ) = @_;
my $sum = 0;
foreach my $i ( $x - 1, $x, $x + 1 ) {
foreach my $j ( $y - 1, $y, $y + 1 ) {
if ( defined $M->{$i}->{$j} ) {
$sum += $M->{$i}->{$j};
}
}
}
return $sum;
}
my $dirs = [ [ 1, 0 ], [ 0, 1 ], [ -1, 0 ], [ 0, -1 ] ];
#### init
my $target = $input[0];
my $current_val = 1;
my ( $x, $y ) = ( 0, 0 );
# store the values for each coordinate in a href of hrefs
# an arrayref of arrayrefs might be "cleaner" but needs to be pre-created
$M->{$x}->{$y} = $current_val;
my $dir_idx = 0;
my $iter = steplengths(0);
#### main loop
LOOP: while ( my $step = NEXTVAL($iter) ) {
if ( $dir_idx == 4 ) { $dir_idx = 0 }
while ( $step > 0 ) {
( $x, $y ) =
( $x + $dirs->[$dir_idx]->[0], $y + $dirs->[$dir_idx]->[1] );
$current_val = adjacent_sum( $x, $y );
if ( $current_val >= $target ) {
last LOOP;
}
$M->{$x}->{$y} = $current_val;
$step--;
}
$dir_idx++;
}
say "First value larger than $target: $current_val";
56 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;
#### INIT - load input data into array
my @input;
my $file = 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }
### CODE
my ( $count_1, $count_2 ) = ( 0, 0 );
foreach my $line (@input) {
my @passphrase = split( /\s+/, $line );
my %dupe_words;
map { $dupe_words{$_}++ } @passphrase;
my %anagrams;
map { $anagrams{ join( '', sort( split( //, $_ ) ) ) }++ } @passphrase;
$count_1++ if ( scalar @passphrase == scalar keys %dupe_words );
$count_2++ if ( scalar @passphrase == scalar keys %anagrams );
}
say "1. Number of valid passphrases: $count_1";
say "2. Number of valid passwords : $count_2";
19 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;
#### INIT - load input data into array
my $testing = 0;
my @input;
my $file = $testing ? 'test.txt' : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }
### CODE
sub debug {
say join ' ', @input;
}
# pass a non-false argument to enable part 2
my $part2 = shift || 0;
my $steps = 0;
my $pointer = 0;
while ( $pointer >= 0 and $pointer < scalar @input ) {
my $jump = $input[$pointer];
if ( $jump == 0 ) {
$steps++;
$input[$pointer]++;
next;
}
else {
my $pos = $pointer;
$pointer = $pointer + $jump;
$steps++;
if ( $jump >= 3 and $part2 ) {
$input[$pos]--;
}
else {
$input[$pos]++;
}
}
debug if $testing;
}
print 'Part ' , $part2 ? '2' : '1' , '. ';
say "number of steps: $steps";
36 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;
use List::Util qw/max/;
#### INIT - load input data into array
my $testing = 0;
my @input;
my $file = $testing ? 'test.txt' : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }
### CODE
my @state = split( /\t/, $input[0] );
my %seen_states;
sub debug {
say join( ',', @state );
}
my $count = 0;
$seen_states{ "@state" } = $count;
# let's loop!
while (1) {
my $largest_el = max @state;
my @positions = grep { $state[$_] == $largest_el } (0 .. $#state);
# we might have more than one position with the same number of elements
# choose the first
my $start = shift @positions;
my $blocks = $state[$start];
$state[$start] = 0;
my $next = $start + 1;
while ( $blocks > 0 ) {
# do we need to wrap around?
if ( $next >= scalar @state ) { $next = 0 }
$state[$next]++;
$blocks--;
$next++;
}
$count++;
if ( exists $seen_states{ "@state" } ) {
last;
}
else {
$seen_states{ "@state" } = $count;
}
}
say "1. number of cycles: $count";
say "2. size of loop : ", $count - $seen_states{ "@state" };
42 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;
#### INIT - load input data into array
my $testing = 0;
my @input;
my $file = $testing ? 'test.txt' : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }
### CODE
my %towers;
sub total_weight;
sub compare_levels;
# construct a hash holding values - weights and children
foreach my $line (@input) {
if ( $line =~ m/^(?.*) \((?\d+)\) \-\> (?.*)$/ ) {
my $tower = $+{tower};
$towers{$tower}->{weight} = $+{weight};
foreach my $el ( split( /\,/, $+{list} ) ) {
$el =~ s/^\s+|\s+$//g; # trim whitespace
$towers{$el}->{held_by} = $tower;
push @{ $towers{$tower}->{holding} }, $el;
}
}
elsif ( $line =~ m/^(?.*) \((?\d+)\)$/ ) {
$towers{$+{tower}}->{weight} = $+{weight};
}
else {
die "can't parse input line: $line\n";
}
}
# find the root (part 1)
my $root;
foreach my $tower ( keys %towers ) {
if ( !exists $towers{$tower}->{held_by} ) {
$root = $tower;
last;
}
}
say "1. name of root disk: $root";
say "2. adjusted weight : ", compare_levels( $root, 0 );
########################################
# recursively calculate the weight of a tower, given a base
sub total_weight {
my ($base) = @_;
my $weight;
if ( !exists $towers{$base}->{holding} ) { # leaf
$weight = $towers{$base}->{weight};
}
else {
$weight = $towers{$base}->{weight};
foreach my $child ( @{ $towers{$base}->{holding} } ) {
$weight += total_weight($child);
}
}
return $weight;
}
# compare the weights of a base tower's children, return corrected
# weight
sub compare_levels {
my ( $base, $diff ) = @_;
my %values;
foreach my $child ( @{ $towers{$base}->{holding} } ) {
push @{ $values{ total_weight($child) } }, $child;
}
# do we have any diffs?
if ( scalar keys %values == 1 )
{ # no diffs, return corrected weight of parent
return $towers{$base}->{weight} - $diff;
}
else { # calculate new diff (should be the same for each step
# but we might as well have the latest value...
my ( $lo, $hi ) = sort { $a <=> $b } keys %values;
$diff = $hi - $lo;
}
# find the outlier to send on to the next level
my $differing;
foreach my $val ( keys %values ) {
if ( scalar @{ $values{$val} } == 1 ) {
$differing = $values{$val}->[0];
}
}
compare_levels( $differing, $diff );
}
76 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;
use List::Util qw/max/;
#### INIT - load input data into array
my $testing = 0;
my @input;
my $file = $testing ? 'test.txt' : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }
### CODE
my %registers;
my $max_val = 0;
sub value_of;
sub compare;
foreach my $line (@input) {
my @args = split( /\s+/, $line );
my ( $target, $inc_dec, $val_1, $if, $source, $cmp, $val_2 ) = @args;
my $curr = value_of($target);
if ( compare( $source, $cmp, $val_2 ) ) {
if ( $inc_dec eq 'inc' ) {
$curr = $curr + $val_1;
}
else {
$curr = $curr - $val_1;
}
$max_val = $curr if ( $curr > $max_val );
$registers{$target} = $curr;
}
}
say "1. largest value when done : ", max values %registers;
say "2. largest value during run: ", $max_val;
#################################################################
sub value_of {
my ($v) = @_;
my $ret;
if ( exists $registers{$v} ) {
$max_val = $registers{$v} if ( $registers{$v} > $max_val );
$ret = $registers{$v};
}
else {
$registers{$v} = 0;
$ret = 0;
}
return $ret;
}
sub compare {
my ( $src, $cmp, $arg_2 ) = @_;
my $arg_1 = value_of($src);
my $ret = undef;
# from stats, we have: != < <= == > >=
if ( $cmp eq '!=' ) { $ret = ( $arg_1 != $arg_2 ) }
elsif ( $cmp eq '<' ) { $ret = ( $arg_1 < $arg_2 ) }
elsif ( $cmp eq '<=' ) { $ret = ( $arg_1 <= $arg_2 ) }
elsif ( $cmp eq '==' ) { $ret = ( $arg_1 == $arg_2 ) }
elsif ( $cmp eq '>' ) { $ret = ( $arg_1 > $arg_2 ) }
elsif ( $cmp eq '>=' ) { $ret = ( $arg_1 >= $arg_2 ) }
die "can't set return value based on args" unless defined $ret;
return $ret;
}
57 lines [ Plain text ] [ ^Top ]
[ 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 ( $score, $invalid_flag, $garbage_count ) = ( 0, 0, 0 );
my @groups;
my @garbage;
# dispatch table
my %act = (
'{' => \&open_group,
'}' => \&close_group,
'<' => \&garbage_in,
'>' => sub { pop @garbage },
'!' => sub { $invalid_flag = 1 if @garbage },
);
# process the stream
my @stream = split( //, shift @input );
my $char;
while (@stream) {
$char = shift @stream;
if ($invalid_flag) {
$invalid_flag = 0;
next;
}
if ( defined $act{$char} ) {
$act{$char}->();
}
else {
$garbage_count++ if @garbage;
}
}
say "1. total score : $score";
say "2. characters within garbage: $garbage_count";
########################################
sub open_group {
if ( !@garbage ) {
push @groups, '{';
$score += scalar @groups;
}
else {
$garbage_count++;
}
}
sub close_group {
if ( !@garbage ) {
pop @groups;
}
else {
$garbage_count++;
}
}
sub garbage_in {
if ( !@garbage ) {
push @garbage, '<';
}
else {
$garbage_count++;
}
}
60 lines [ Plain text ] [ ^Top ]
[ 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 @array = $testing ? ( 0 .. 4 ) : ( 0 .. 255 );
my @lengths = split( /\,/, shift @input );
sub dump_state;
my $skip = 0;
my $pos = 0;
my $len = 0;
dump_state if $testing;
while (@lengths) {
$len = shift @lengths;
my $end = $pos + $len - 1;
my $overlap = $end % @array;
# do we overlap?
if ( $overlap == $end ) { #no
my @segment = @array[ $pos .. $end ];
@array[ $pos .. $end ] = reverse @segment;
}
else {
my @seg1 = @array[ $pos .. $#array ];
my @seg2 = @array[ 0 .. $overlap ];
say join( ' ', @seg1, @seg2 ) if $testing;
my @replace = reverse( @seg1, @seg2 );
say join( ' ', @replace ) if $testing;
@array[ $pos .. $#array ] = @replace[ 0 .. ( $#array - $pos ) ];
@array[ 0 .. $overlap ] =
@replace[ ( $#replace - $overlap ) .. $#replace ];
}
$pos = ( $pos + $len + $skip ) % @array;
$skip++;
dump_state if $testing;
}
say "Product of first 2 elements: ",$array[0] * $array[1];
########################################
sub dump_state {
printf( "curr length: %d curr skip: %d next pos: %d\n",
$len, $skip, $pos );
my @copy = @array;
if ($testing) {
say join( ' ', map { sprintf( "%2d", $_ ) } @copy );
}
else {
while (@copy) {
my @row = splice( @copy, 0, 16 );
say join( ' ', map { sprintf( "%3d", $_ ) } @row );
}
}
}
53 lines [ Plain text ] [ ^Top ]
#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;
#### INIT - load input data from file into array
my $testing = 0;
my @input;
my $file = 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }
### CODE
my @array = ( 0 .. 255 );
my @key;
my @salt = ( 17, 31, 73, 47, 23 );
my $teststring = '1,2,3';
if ($testing) {
my @convert = map { ord($_) } split( //, $teststring );
@key = ( @convert, @salt );
}
else {
my @in = map { ord($_) } split( //, shift @input );
@key = ( @in, @salt );
}
my $skip = 0;
my $pos = 0;
my $len = 0;
sub array_to_hex;
foreach my $round ( 1 .. 64 ) {
my @lengths = @key;
while (@lengths) {
$len = shift @lengths;
my $end = $pos + $len - 1;
my $overlap = $end % @array;
# do we overlap?
if ( $overlap == $end ) { #no
my @segment = @array[ $pos .. $end ];
@array[ $pos .. $end ] = reverse @segment;
}
else {
my @seg1 = @array[ $pos .. $#array ];
my @seg2 = @array[ 0 .. $overlap ];
my @replace = reverse( @seg1, @seg2 );
@array[ $pos .. $#array ] = @replace[ 0 .. ( $#array - $pos ) ];
@array[ 0 .. $overlap ] =
@replace[ ( $#replace - $overlap ) .. $#replace ];
}
$pos = ( $pos + $len + $skip ) % @array;
$skip++;
}
}
say "Knot Hash of puzzle input: ", array_to_hex;
########################################
sub array_to_hex {
my $string;
while (@array) {
my @row = splice( @array, 0, 16 );
my $xor;
my $el_1 = shift @row;
while (@row) {
my $el_2 = shift @row;
$xor = $el_1 ^ $el_2;
$el_1 = $xor;
}
$string .= sprintf( "%02x", $xor );
}
return $string;
}
63 lines [ Plain text ] [ ^Top ]
[ 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 @input;
my $file = 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }
### CODE
# x,y,z coordinates - see https://www.redblobgames.com/grids/hexagons/
my %move = (
n => sub { [ 0, 1, -1 ] },
ne => sub { [ 1, 0, -1 ] },
se => sub { [ 1, -1, 0 ] },
s => sub { [ 0, -1, 1 ] },
sw => sub { [ -1, 0, 1 ] },
nw => sub { [ -1, 1, 0 ] },
);
my @dirs = split( /,/, shift @input );
my @path;
# x, y, z
my $position = [ 0, 0, 0 ];
my ( $dist, $max_dist ) = ( 0, 0 );
while (@dirs) {
my $ins = shift @dirs;
my $d = $move{$ins}->();
map { $position->[$_] += $d->[$_] } 0 .. 2;
$dist = max( map { abs($_) } @$position );
$max_dist = max( $max_dist, $dist );
}
say "1. steps to end point: ", $dist;
say "2. max distance : ", $max_dist;
29 lines [ Plain text ] [ ^Top ]
[ 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 %pipes;
while (@input) {
my $line = shift @input;
if ( $line =~ /^(\d+)\ \<\-\>\ (.*)$/ ) {
$pipes{$1} = [split( ', ', $2 )];
}
else {
die "cannot parse input line: $line";
}
}
my %seen;
my %groups;
foreach my $id ( sort keys %pipes ) {
next if $seen{$id};
my %connections = ( $id => 1 );
my @list = @{ $pipes{$id} };
while (@list) {
my $p = shift @list;
$seen{$p}++;
next if exists $connections{$p};
$connections{$p}++;
push @list, @{ $pipes{$p} };
}
$groups{$id} = \%connections;
}
say "1. connections to '0': ", scalar keys %{ $groups{'0'} };
say "2. total groups : ", scalar keys %groups;
35 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;
# useful modules
use List::Util qw/max/;
#### INIT - load input data from file into array
my $testing = 0;
my @input;
my $file = $testing ? 'test.txt' : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }
### CODE
# parse input
my %depths;
my $max = 0;
while (@input) {
my ( $pos, $depth ) = split( /: /, shift @input );
$depths{$pos} = $depth;
$max = max( $max, $pos );
}
# these are from the chapter on iterators in HOP, but not in a
# separate module
sub NEXTVAL { $_[0]->() }
sub Iterator (&) { return $_[0] }
# an iterator for states
sub states {
my ($m) = @_;
return Iterator {
for my $i ( 0 .. scalar @$m - 1 ) {
if ( exists $depths{$i} ) {
my $new = $m->[$i] + 1;
$m->[$i] = $new % ( 2 * $depths{$i} - 2 );
}
}
return $m;
}
}
my $firewall = [ (0) x ( $max + 1 ) ];
my $iter = states($firewall);
my $curr = 0;
my $severity = 0;
while ( $curr <= $max ) {
if ( exists $depths{$curr} and $firewall->[$curr] == 0 ) {
$severity += $depths{$curr} * $curr;
}
$firewall = NEXTVAL($iter);
$curr++;
}
say "Severity: ",$severity;
42 lines [ Plain text ] [ ^Top ]
#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;
# useful modules
use List::Util qw/max/;
use Storable qw/dclone/;
#### INIT - load input data from file into array
my $testing = 0;
my @input;
my $file = $testing ? 'test.txt' : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }
### CODE
# parse input
my %depths;
my $max = 0;
while (@input) {
my ( $pos, $depth ) = split( /: /, shift @input );
$depths{$pos} = $depth;
$max = max( $max, $pos );
}
# these are from the chapter on iterators in HOP, but not in a
# separate module
sub NEXTVAL { $_[0]->() }
sub Iterator (&) { return $_[0] }
# an iterator for states
sub states {
my ($m) = @_;
return Iterator {
for my $i ( 0 .. scalar @$m - 1 ) {
if ( exists $depths{$i} ) {
my $new = $m->[$i] + 1;
$m->[$i] = $new % ( 2 * $depths{$i} - 2 );
}
}
return $m;
}
}
my $initial = [ (0) x ( $max + 1 ) ];
my $iter1 = states($initial);
my $starter = NEXTVAL($iter1);
my $delay = 1;
while (1) {
my $curr = 0;
my $hit = 0;
my $firewall = dclone $starter;
my $iter2 = states($firewall);
INNER: while ( $curr <= $max ) {
if ( exists $depths{$curr} and $firewall->[$curr] == 0 ) {
$hit = 1;
last INNER;
}
$firewall = NEXTVAL($iter2);
$curr++;
}
last if ( $hit == 0 );
$delay++;
$starter = NEXTVAL($iter1);
}
say "Delay: ",$delay;
53 lines [ Plain text ] [ ^Top ]
[ 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 $max_dim = 127;
my $group_count = 0;
sub knot_hash_bin;
sub fill_flood;
my $seed = $input[0];
my $sum = 0;
my $Map;
foreach my $idx ( 0 .. $max_dim ) {
my $binrow = knot_hash_bin( $seed . '-' . $idx );
my @ones = grep { $_ == 1 } split( //, $binrow );
$sum += scalar @ones;
# populate map
foreach my $el ( split( //, $binrow ) ) {
push @{ $Map->[$idx] }, { val => $el, seen => 0 };
}
}
# process the map
foreach my $row ( 0 .. scalar @$Map - 1 ) {
foreach my $col ( 0 .. scalar @{ $Map->[$row] } - 1 ) {
next if $Map->[$row]->[$col]->{val} == 0;
next if $Map->[$row]->[$col]->{seen} > 0;
# fill flood the ones
$group_count++;
fill_flood( $row, $col );
}
}
say "1. number of used squares : ", $sum;
say "2. number of distinct groups: ", $group_count;
###############################################################################
sub fill_flood {
my ( $r, $c ) = @_;
my @dirs = ( [ -1, 0 ], [ 1, 0 ], [ 0, -1 ], [ 0, 1 ] );
foreach my $d (@dirs) {
my $new_r = $r + $d->[0];
my $new_c = $c + $d->[1];
next
if ( $new_r < 0
or $new_r > $max_dim
or $new_c < 0
or $new_c > $max_dim );
next
if ( $Map->[$new_r]->[$new_c]->{val} == 0
or $Map->[$new_r]->[$new_c]->{seen} > 0 );
$Map->[$new_r]->[$new_c]->{seen} = $group_count;
fill_flood( $new_r, $new_c );
}
}
# code adapted from day 10, part 2
sub knot_hash_bin {
my ($string) = @_;
my @salt = ( 17, 31, 73, 47, 23 );
my @convert = map { ord($_) } split( //, $string );
my @key = ( @convert, @salt );
my @array = ( 0 .. 255 );
my $skip = 0;
my $pos = 0;
my $len = 0;
foreach my $round ( 1 .. 64 ) {
my @lengths = @key;
while (@lengths) {
$len = shift @lengths;
my $end = $pos + $len - 1;
my $overlap = $end % @array;
# do we overlap?
if ( $overlap == $end ) { #no
my @segment = @array[ $pos .. $end ];
@array[ $pos .. $end ] = reverse @segment;
}
else {
my @seg1 = @array[ $pos .. $#array ];
my @seg2 = @array[ 0 .. $overlap ];
my @replace = reverse( @seg1, @seg2 );
@array[ $pos .. $#array ] = @replace[ 0 .. ( $#array - $pos ) ];
@array[ 0 .. $overlap ] =
@replace[ ( $#replace - $overlap ) .. $#replace ];
}
$pos = ( $pos + $len + $skip ) % @array;
$skip++;
}
}
my $hexstring;
while (@array) {
my @row = splice( @array, 0, 16 );
my $xor;
my $el_1 = shift @row;
while (@row) {
my $el_2 = shift @row;
$xor = $el_1 ^ $el_2;
$el_1 = $xor;
}
$hexstring .= sprintf( "%02x", $xor );
}
my @chars = split( //, $hexstring );
my $out;
while (@chars) {
$out .= sprintf( "%04b", hex( shift @chars ) );
}
return $out;
}
104 lines [ Plain text ] [ ^Top ]
[ 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
# pass a non-false value for part 2
my $part2 = shift || 0;
my @start;
my @factors = ( 16807, 48271 );
my @evendivs = $part2 ? ( 4, 8 ) : ( undef, undef );
my $divisor = 2147483647;
my $mask = 0xFFFF;
while (@input) {
my $str = shift @input;
if ( $str =~ m/(\d+)$/ ) {
push @start, $1;
}
else {
die "can't parse input: $str";
}
}
# cribbed from HOP
sub NEXTVAL { $_[0]->() }
sub Iterator (&) { return $_[0] }
sub generator {
my ( $start, $factor, $divide_by ) = @_;
return Iterator {
my $nextval;
if ( defined $divide_by ) {
do {
$nextval = ( $start * $factor ) % $divisor;
$start = $nextval;
} until ( $nextval % $divide_by == 0 );
return $start;
}
else {
$nextval = ( $start * $factor ) % $divisor;
$start = $nextval;
return $start;
}
}
}
my $count = 1;
my $match = 0;
my $gen_A = generator( $start[0], $factors[0], $evendivs[0] );
my $gen_B = generator( $start[1], $factors[1], $evendivs[1] );
my $LIMIT = 1_000_000 * ( $part2 ? 5 : 40 );
while ( $count <= $LIMIT ) {
$match++ if ( ( NEXTVAL($gen_A) & $mask ) == ( NEXTVAL($gen_B) & $mask ) );
$count++;
}
printf "No. of matches for part %d: %d\n", $part2 ? 2 : 1, $match;
53 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;
#### INIT - load input data from file into array
my @input;
my $file = 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }
### CODE
my @list = 'a' .. 'p';
my %actions = (
s => \&spin,
x => \&exchange,
p => \&partner,
);
my @seq;
for my $el ( split( /,/, $input[0] ) ) {
if ( $el =~ m/s(\d+)/ ) { push @seq, [ 's', $1, undef ] }
elsif ( $el =~ m/x(\d+)\/(\d+)/ ) { push @seq, [ 'x', $1, $2 ] }
elsif ( $el =~ m/p(\S+)\/(\S+)/ ) { push @seq, [ 'p', $1, $2 ] }
else { die "can't parse: $el" }
}
my $count = 1;
my $period;
my $LIMIT = 1_000_000_000;
# find answer to part 1, and the recurrence period;
while ( $count <= $LIMIT ) {
say "==> $count" if $count % 100 == 0;
foreach my $el (@seq) {
$actions{ $el->[0] }->( $el->[1], $el->[2] );
}
say "1. result after 1 round : ", join( '', @list ) if $count == 1;
if ( join( '', @list ) eq join( '', 'a' .. 'p' ) ) {
$period = $count;
last;
}
$count++;
}
# find part 2;
$count = 1;
@list = 'a' .. 'p';
while ( $count <= $LIMIT % $period ) {
foreach my $el (@seq) {
$actions{ $el->[0] }->( $el->[1], $el->[2] );
}
$count++;
}
say "2. result after 1B rounds: ", join( '', @list );
###############################################################################
sub spin {
my ( $x, $_0 ) = @_;
my @tail = @list[ -$x .. -1 ];
my @head = @list[ 0 .. $#list - $x ];
@list = ( @tail, @head );
}
sub exchange {
my ( $p, $q ) = @_;
my $newp = $list[$q];
my $newq = $list[$p];
$list[$p] = $newp;
$list[$q] = $newq;
}
sub partner {
my ( $r, $s ) = @_;
my ($r_idx) = grep { $list[$_] eq $r } ( 0 .. $#list );
my ($s_idx) = grep { $list[$_] eq $s } ( 0 .. $#list );
$list[$s_idx] = $r;
$list[$r_idx] = $s;
}
64 lines [ Plain text ] [ ^Top ]
[ 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 $steps = $input[0];
my @buffer = (0);
my $pos = 0;
my $val = 1;
while ( $val <= 2017 ) {
my $count = 0;
my $newpos;
while ( $count < $steps ) {
$newpos = $pos + 1;
if ( $newpos > $#buffer ) {
$newpos = 0;
}
$pos = $newpos;
$count++;
}
my @head = splice( @buffer, 0, $pos + 1 );
@buffer = ( @head, $val, @buffer );
$pos = scalar @head;
$val++;
}
my ($last_pos) = grep { $buffer[$_] == 2017 } ( 0 .. $#buffer );
say "1. value after 2017 is: ", $buffer[ $last_pos + 1 ];
30 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, $_; }
### CODE
my $steps = $input[0];
my $val = 1;
my $size = 1;
my $pos = 1;
my $index_1;
while ( $val <= 50_000_000 ) {
$pos = ( ( $pos + $steps ) % $size ) + 1;
$size++;
if ( $pos == 1 ) {
$index_1 = $val;
}
$val++;
}
say "2. value after 0 is: $index_1";
22 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 $debug = 1;
my %registers;
my @sounds;
my @ins;
while (@input) {
my @atoms = split( /\s+/, shift @input );
push @ins, \@atoms;
}
sub value_of;
sub dump_registers;
my %action = (
set => \&set_register,
snd => \&play_sound,
add => \&add_to_register,
mul => \&multiply_register,
mod => \&divmod_register,
rcv => \&recover_freq,
jgz => \&jump_gt_zero,
);
my $pos = 0;
while ( $pos >= 0 and $pos <= $#ins ) {
my ( $cmd, $arg1, $arg2 ) = @{ $ins[$pos] };
my $ret = $action{$cmd}->( $arg1, $arg2 );
if ( $cmd eq 'rcv' and scalar @sounds and $ret > 1 ) {
last;
}
$pos = $pos + $ret;
}
say "1. last sound played: $sounds[-1]";
###############################################################################
sub dump_registers {
for my $k (sort {$a cmp $b} keys %registers) {
print "$k => $registers{$k} ";
}
print "\n";
}
sub value_of {
my ($x) = @_;
my $val;
if ( exists $registers{$x} ) {
$val = $registers{$x};
}
else {
$val = $x;
}
return $val;
}
sub play_sound {
my ( $x, $dummy ) = @_;
push @sounds, value_of($x);
return 1;
}
sub set_register {
my ( $x, $y ) = @_;
$registers{$x} = value_of($y);
return 1;
}
sub add_to_register {
my ( $x, $y ) = @_;
$registers{$x} += value_of($y);
return 1;
}
sub multiply_register {
my ( $x, $y ) = @_;
my $factor = $registers{$x} // 0;
my $res = $factor * value_of($y);
$registers{$x} = $res;
return 1;
}
sub divmod_register {
my ( $x, $y ) = @_;
my $num = $registers{$x} // 0;
my $den = value_of($y);
my $res = $num % $den;
$registers{$x} = $res;
return 1;
}
sub recover_freq {
my ( $x, $dummy ) = @_;
my $val = value_of($x);
my $ret = 1;
if ( $val != 0 ) {
$ret = 2;
}
return $ret;
}
sub jump_gt_zero {
my ( $x, $y ) = @_;
my $flag = value_of($x);
my $jump = 1;
if ( $flag > 0 ) {
$jump = value_of($y);
}
return $jump;
}
102 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 ? 'test2.txt' : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }
### CODE
my $debug = 0;
my @program = (
{
registers => { p => 0 },
queue => [],
},
{
registers => { p => 1 },
queue => [],
},
);
while (@input) {
my @atoms = split( /\s+/, shift @input );
for ( 0, 1 ) {
push @{ $program[$_]->{ins} }, \@atoms;
}
}
sub value_of;
sub dump_registers;
my %action = (
set => \&set_register,
snd => \&send_value,
add => \&add_to_register,
mul => \&multiply_register,
mod => \&divmod_register,
rcv => \&receive_value,
jgz => \&jump_gt_zero,
);
my @pos = ( 0, 0 );
while ( ( $pos[0] >= 0 and $pos[1] >= 0 )
and ( $pos[0] <= scalar @{ $program[0]->{ins} } - 1 )
and ( $pos[1] <= scalar @{ $program[1]->{ins} } - 1 ) )
{
my @compare = @pos;
for my $p ( 0, 1 ) {
my ( $cmd, $arg1, $arg2 ) = @{ $program[$p]->{ins}->[ $pos[$p] ] };
my $ret = $action{$cmd}->( $arg1, $arg2, $p );
$pos[$p] = $pos[$p] + $ret;
if ($debug) {
print " $p: ";
dump_registers($p);
}
}
if ( $compare[0] == $pos[0] and $compare[1] == $pos[1] ) {
last;
}
}
say "2. number of messages sent by program 1: ",$program[1]->{sends};
###############################################################################
sub dump_registers {
my ($p) = @_;
for my $k ( sort { $a cmp $b } keys %{ $program[$p]->{registers} } ) {
print "$k => $program[$p]->{registers}->{$k} ";
}
print "\n";
}
sub value_of {
my ( $x, $p ) = @_;
my $val;
if ( exists $program[$p]->{registers}->{$x} ) {
$val = $program[$p]->{registers}->{$x};
}
else {
$val = $x;
}
return $val;
}
sub send_value {
my ( $x, $dummy, $p ) = @_;
my $rec = ( $p == 1 ? 0 : 1 );
my $msg = value_of( $x, $p );
push @{ $program[$rec]->{queue} }, $msg;
say "==> $p sends $msg to $rec" if $debug;
$program[$p]->{sends}++;
return 1;
}
sub set_register {
my ( $x, $y, $p ) = @_;
$program[$p]->{registers}->{$x} = value_of( $y, $p );
return 1;
}
sub add_to_register {
my ( $x, $y, $p ) = @_;
$program[$p]->{registers}->{$x} += value_of( $y, $p );
return 1;
}
sub multiply_register {
my ( $x, $y, $p ) = @_;
my $factor = $program[$p]->{registers}->{$x} // 0;
my $res = $factor * value_of( $y, $p );
$program[$p]->{registers}->{$x} = $res;
return 1;
}
sub divmod_register {
my ( $x, $y, $p ) = @_;
my $num = $program[$p]->{registers}->{$x} // 0;
my $den = value_of( $y, $p );
my $res = $num % $den;
$program[$p]->{registers}->{$x} = $res;
return 1;
}
sub receive_value {
my ( $x, $dummy, $p ) = @_;
my $ret = 0;
if ( @{ $program[$p]->{queue} } ) {
my $val = shift @{ $program[$p]->{queue} };
set_register( $x, $val, $p );
$ret = 1;
}
return $ret;
}
sub jump_gt_zero {
my ( $x, $y, $p ) = @_;
my $flag = value_of( $x, $p );
my $jump = 1;
if ( $flag > 0 ) {
$jump = value_of( $y, $p );
}
return $jump;
}
127 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 $map;
my ( $maxrow, $maxcol ) = ( 0, 0 );
while (@input) {
my @line = split( //, shift @input );
$maxcol = max( $maxcol, scalar @line );
push @{$map}, \@line;
$maxrow++;
}
# add buffer row
push @{$map}, [ ' ' x $maxcol ];
my %dirs = (
up => [ -1, 0 ],
down => [ 1, 0 ],
left => [ 0, -1 ],
right => [ 0, 1 ]
);
my @sequence;
# sensible dependence on initial starting condition
my $row = 0;
my ($col) =
grep { $map->[$row]->[$_] eq '|' } ( 0 .. scalar @{ $map->[$row] } - 1 );
my $dir = 'down';
push @sequence, '|';
# traverse the tubes!
while ( $row >= 0 and $row < $maxrow and $col >= 0 and $col < $maxcol ) {
my $nextr = $row + $dirs{$dir}->[0];
my $nextc = $col + $dirs{$dir}->[1];
my $nextdir;
my $char = $map->[$nextr]->[$nextc] // ' ';
if ( $char =~ m/\-|\||[A-Z]/ ) {
# grab them all, let grep sort 'em out
push @sequence, $char;
$nextdir = $dir;
}
elsif ( $char eq '+' ) { # change dir
push @sequence, $char;
foreach my $d ( sort keys %dirs ) {
next if ( $d eq $dir );
next
if ( $dirs{$d}->[0] + $dirs{$dir}->[0] == 0
or $dirs{$d}->[1] + $dirs{$dir}->[1] == 0 );
my $neighbor =
$map->[ $nextr + $dirs{$d}->[0] ]->[ $nextc + $dirs{$d}->[1] ]
// ' ';
next if ( $neighbor eq ' ' );
$nextdir = $d;
}
}
elsif ( $char eq ' ' ) {
last;
}
$row = $nextr;
$col = $nextc;
$dir = $nextdir;
}
say '1. string: ', join '', grep { $_ =~ m/[A-Z]/ } @sequence;
say '2. count : ', scalar @sequence;
63 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;
# useful modules
use List::Util qw/sum/;
#### 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 $id = 0;
my %positions;
while (@input) {
my $line = shift @input;
if ( $line =~ m/^p\=\<(.*)\>, v=\<(.*)\>, a=\<(.*)\>/ ) {
my @p = split( /,/, $1 );
my @v = split( /,/, $2 );
my @a = split( /,/, $3 );
my $d = sum map { abs $_ } @p;
$positions{$id} = { p => \@p, v => \@v, a => \@a, d => $d };
}
else {
die "cannot parse input line: $line";
}
$id++;
}
my $closest =
( sort { $positions{$a}->{d} <=> $positions{$b}->{d} } keys %positions )[0];
my $compare = -1;
for my $count ( 0 .. 391 ) { # limit found by inspection
$compare = $closest;
foreach my $id ( keys %positions ) {
foreach my $m ( 0, 1, 2 ) {
$positions{$id}->{v}->[$m] += $positions{$id}->{a}->[$m];
$positions{$id}->{p}->[$m] += $positions{$id}->{v}->[$m];
}
$positions{$id}->{d} = sum map { abs $_ } @{ $positions{$id}->{p} };
}
$closest =
( sort { $positions{$a}->{d} <=> $positions{$b}->{d} } keys %positions )
[0]
}
say "1. closest particle: ", $closest;
42 lines [ Plain text ] [ ^Top ]
#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;
# useful modules
use List::Util qw/sum/;
#### 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 $id = 0;
my %positions;
while (@input) {
my $line = shift @input;
if ( $line =~ m/^p\=\<(.*)\>, v=\<(.*)\>, a=\<(.*)\>/ ) {
my @p = split( /,/, $1 );
my @v = split( /,/, $2 );
my @a = split( /,/, $3 );
$positions{$id} = { p => \@p, v => \@v, a => \@a, };
}
else {
die "cannot parse input line: $line";
}
$id++;
}
for my $count ( 0 .. 50 ) { # value found from inspection
my %collisions;
# update positions, find collisions
foreach my $id ( keys %positions ) {
foreach my $m ( 0, 1, 2 ) {
$positions{$id}->{v}->[$m] += $positions{$id}->{a}->[$m];
$positions{$id}->{p}->[$m] += $positions{$id}->{v}->[$m];
}
push @{ $collisions{ join( ',', @{ $positions{$id}->{p} } ) } }, $id;
}
my @same;
foreach my $key ( keys %collisions ) {
push @same, @{ $collisions{$key} } if scalar @{ $collisions{$key} } > 1;
}
if (@same) {
foreach my $el (@same) {
delete $positions{$el};
}
}
}
say "2. particles remaining after collisions: ", scalar keys %positions;
45 lines [ Plain text ] [ ^Top ]
#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;
use List::Util qw/sum/;
#### 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 $id = 0;
my %positions;
while (@input) {
my $line = shift @input;
if ( $line =~ m/^p\=\<(.*)\>, v=\<(.*)\>, a=\<(.*)\>/ ) {
my $p = sum map { abs $_ } split( /,/, $1 );
my $v = sum map { abs $_ } split( /,/, $2 );
my $a = sum map { abs $_ } split( /,/, $3 );
$positions{$id} = { p => $p, v => $v, a => $a };
}
else {
die "cannot parse input line: $line";
}
$id++;
}
# Select the particle with the lowest absolute acceleration. This
# works for my input, but maybe not for all. In that case the tie
# needs to be broken by absolute velocity.
say "1. closest particle: ",
( sort { $positions{$a}->{a} <=> $positions{$b}->{a} } keys %positions )[0];
26 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;
# useful modules
use List::Util qw/sum max/;
use Storable qw/dclone/;
#### INIT - load input data from file into array
my $testing = 0;
my $debug = 0;
my @input;
my $file = $testing ? 'test.txt' : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }
### CODE
sub string_to_pattern;
sub pattern_to_string;
sub pretty_print;
sub transform_2;
sub transform_3;
my %patterns;
my $id = 1;
foreach my $line (@input) {
my ( $in, $out ) = $line =~ m/^(.*)\ \=\>\ (.*)$/;
my $keys;
if ( length $in == 5 ) {
$keys = transform_2($in);
}
else {
$keys = transform_3($in);
}
foreach my $k (@$keys) {
if ( exists $patterns{$k} ) {
say "==> already seen key $k, skipping";
next;
}
$patterns{$k} = { id => $id, pat => $out };
}
$id++;
}
my $part2 = shift || 0;
my $grid = [ '.#.', '..#', '###' ];
my $iter = 0;
my $limit = $part2 ? 18 : 5;
while ( $iter < $limit ) {
my $subgrids;
my $div;
if ( scalar @$grid % 2 == 0 ) { $div = 2 }
elsif ( scalar @$grid % 3 == 0 ) { $div = 3 }
else { die "weird grid size: scalar @$grid" }
printf(
"==> Gridsize: %d | size / 2 = %.3f | size / 3 = %.3f | div = %d\n",
scalar @$grid,
( scalar @$grid / 2 ),
( scalar @$grid / 3 ), $div
) if $debug;
my ( $mrow, $mcol ) = ( 0, 0 );
for ( my $i = 0 ; $i < scalar @$grid ; $i += $div ) {
$mcol = 0;
for ( my $j = 0 ; $j < length $grid->[$i] ; $j += $div ) {
for my $offset ( 0 .. $div - 1 ) {
push @{ $subgrids->[$mrow]->[$mcol]->{array} },
substr $grid->[ $i + $offset ], $j, $div;
}
$mcol++;
}
$mrow++;
}
if ($debug) {
say "grid: ";
foreach my $r (@$grid) {
say $r;
}
}
my $newgrid;
for my $r ( 0 .. $mrow - 1 ) {
for my $c ( 0 .. $mcol - 1 ) {
my $count = 0;
my $string = join( '/', @{ $subgrids->[$r]->[$c]->{array} } );
say "$r $c $string -> $patterns{$string}->{pat}" if $debug;
my @repl = split( /\//, $patterns{$string}->{pat} );
my $size = max map { length $_ } @repl;
# say join( ' ', $size, @repl);
for my $idx ( 0 .. $size - 1 ) {
$newgrid->[ $r * $size + $count ] .= shift @repl;
$count++;
}
}
}
$grid = dclone $newgrid;
$iter++;
}
my $count;
foreach my $r (@$grid) {
$count += grep { $_ eq '#' } split( //, $r );
}
if ($part2) {
say "2. number of lit pixels: $count"
} else {
say "1. number of lit pixels: $count"
}
###############################################################################
sub pretty_print {
my ($str) = @_;
$str =~ s/\//\n/g;
say $str;
print "\n";
}
sub string_to_pattern {
my ($str) = @_;
my @rows = split( /\//, $str );
my $out;
foreach my $r (@rows) {
foreach my $el ( split( //, $r ) ) {
push @{$out}, $el;
}
}
return $out;
}
sub pattern_to_string {
my ($pat) = @_;
my $out;
my $group;
# we can have 2x2 or 3x3 patterns
if ( scalar @$pat == 4 ) {
$group = 2;
}
elsif ( scalar @$pat == 9 ) {
$group = 3;
}
else {
die "can't parse pattern: ", join( '', @{$pat} );
}
# my $group = scalar @$pat ;
my $idx = 0;
foreach my $el ( @{$pat} ) {
if ( !defined $el ) {
die "bad value";
}
$out .= $el;
$idx++;
if ( $idx % $group == 0 ) {
$out .= '/';
}
}
$out =~ s/\/$//gm;
return $out;
}
sub transform_2 {
my ($str) = @_;
my $p = string_to_pattern($str);
my $transforms;
$transforms->{ pattern_to_string( [ $p->[0], $p->[1], $p->[2], $p->[3], ] )
}++;
$transforms->{ pattern_to_string( [ $p->[0], $p->[2], $p->[1], $p->[3], ] )
}++;
$transforms->{ pattern_to_string( [ $p->[1], $p->[0], $p->[3], $p->[2], ] )
}++;
$transforms->{ pattern_to_string( [ $p->[1], $p->[3], $p->[0], $p->[2], ] )
}++;
$transforms->{ pattern_to_string( [ $p->[2], $p->[0], $p->[3], $p->[1], ] )
}++;
$transforms->{ pattern_to_string( [ $p->[2], $p->[3], $p->[0], $p->[1], ] )
}++;
$transforms->{ pattern_to_string( [ $p->[3], $p->[1], $p->[2], $p->[0], ] )
}++;
$transforms->{ pattern_to_string( [ $p->[3], $p->[2], $p->[1], $p->[0], ] )
}++;
return [ keys %{$transforms} ];
}
sub transform_3 {
my ($str) = @_;
my $p = string_to_pattern($str);
my $transforms;
$transforms->{
pattern_to_string(
[
$p->[0], $p->[1], $p->[2], $p->[3], $p->[4],
$p->[5], $p->[6], $p->[7], $p->[8],
]
)
}++;
$transforms->{
pattern_to_string(
[
$p->[0], $p->[3], $p->[6], $p->[1], $p->[4],
$p->[7], $p->[2], $p->[5], $p->[8],
]
)
}++;
$transforms->{
pattern_to_string(
[
$p->[2], $p->[1], $p->[0], $p->[5], $p->[4],
$p->[3], $p->[8], $p->[7], $p->[6],
]
)
}++;
$transforms->{
pattern_to_string(
[
$p->[2], $p->[5], $p->[8], $p->[1], $p->[4],
$p->[7], $p->[0], $p->[3], $p->[6],
]
)
}++;
$transforms->{
pattern_to_string(
[
$p->[6], $p->[3], $p->[0], $p->[7], $p->[4],
$p->[1], $p->[8], $p->[5], $p->[2],
]
)
}++;
$transforms->{
pattern_to_string(
[
$p->[6], $p->[7], $p->[8], $p->[3], $p->[4],
$p->[5], $p->[0], $p->[1], $p->[2],
]
)
}++;
$transforms->{
pattern_to_string(
[
$p->[8], $p->[5], $p->[2], $p->[7], $p->[4],
$p->[1], $p->[6], $p->[3], $p->[0],
]
)
}++;
$transforms->{
pattern_to_string(
[
$p->[8], $p->[7], $p->[6], $p->[5], $p->[4],
$p->[3], $p->[2], $p->[1], $p->[0],
]
)
}++;
return [ keys %{$transforms} ];
}
235 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 $map;
sub pretty_print;
my $row = 0;
my $lastc = 0;
while (@input) {
my @line = split( //, shift @input );
foreach my $c ( 0 .. $#line ) {
$map->{$row}->{$c} = $line[$c];
}
$row++;
$lastc = scalar @line;
}
# inspection show midpoint
my $pos = $testing ? [ 1, 1 ] : [ 12, 12 ];
# our coordinate system is row/cols: "up" is negative 1st coord
my $dir = [ -1, 0 ];
my $limit = 10_000;
my $moves = 0;
my $infected = 0;
while ( $moves < $limit ) {
# does node exist? if not create it
my $state;
if ( exists $map->{ $pos->[0] }->{ $pos->[1] } ) {
$state = $map->{ $pos->[0] }->{ $pos->[1] };
}
else {
$map->{ $pos->[0] }->{ $pos->[1] } = '.';
$state = '.';
}
# inspect current node, turn, and act on node
if ( $state eq '#' ) {
$dir = turn_right($dir);
$map->{ $pos->[0] }->{ $pos->[1] } = '.';
}
else {
$dir = turn_left($dir);
$map->{ $pos->[0] }->{ $pos->[1] } = '#';
$infected++;
}
# move
$pos = [ $pos->[0] + $dir->[0], $pos->[1] + $dir->[1] ];
$moves++;
}
say $infected;
###############################################################################
sub turn_left {
my ($in) = @_;
my $out;
if ( $in->[0] == -1 and $in->[1] == 0 ) { #up
$out = [ 0, -1 ];
}
elsif ( $in->[0] == 0 and $in->[1] == -1 ) { #left
$out = [ 1, 0 ];
}
elsif ( $in->[0] == 1 and $in->[1] == 0 ) { #down
$out = [ 0, 1 ];
}
elsif ( $in->[0] == 0 and $in->[1] == 1 ) { #right
$out = [ -1, 0 ];
}
else {
die "can't parse direction: [ $in->[0], $in->[1] ]";
}
return $out;
}
sub turn_right {
my ($in) = @_;
my $out;
if ( $in->[0] == -1 and $in->[1] == 0 ) { #up
$out = [ 0, 1 ];
}
elsif ( $in->[0] == 0 and $in->[1] == -1 ) { #left
$out = [ -1, 0 ];
}
elsif ( $in->[0] == 1 and $in->[1] == 0 ) { #down
$out = [ 0, -1 ];
}
elsif ( $in->[0] == 0 and $in->[1] == 1 ) { #right
$out = [ 1, 0 ];
}
else {
die "can't parse direction: [ $in->[0], $in->[1] ]";
}
return $out;
}
sub pretty_print {
foreach my $r ( sort { $a <=> $b } keys %{$map} ) {
foreach my $c ( sort { $a <= $b } keys %{ $map->{$r} } ) {
if ( exists $map->{$r}->{$c} ) {
print $map->{$r}->{$c};
}
else {
print '.';
}
}
print "\n";
}
print "\n";
}
104 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, $_; }
### CODE
my $map;
sub pretty_print;
my $row = 0;
my $lastc = 0;
while (@input) {
my @line = split( //, shift @input );
foreach my $c ( 0 .. $#line ) {
$map->{$row}->{$c} = $line[$c];
}
$row++;
$lastc = scalar @line;
}
# inspection show midpoint
my $pos = $testing ? [ 1, 1 ] : [ 12, 12 ];
# our coordinate system is row/cols: "up" is negative 1st coord
my $dir = [ -1, 0 ];
my $limit = 10000000;
my $moves = 0;
my $infected = 0;
while ( $moves < $limit ) {
# does node exist? if not create it
my $state;
if ( exists $map->{ $pos->[0] }->{ $pos->[1] } ) {
$state = $map->{ $pos->[0] }->{ $pos->[1] };
}
else {
$map->{ $pos->[0] }->{ $pos->[1] } = '.';
$state = '.';
}
# inspect current node, turn, and act on node
if ( $state eq '#' ) {
$dir = turn_right($dir);
$map->{ $pos->[0] }->{ $pos->[1] } = 'F';
}
elsif ( $state eq 'W' ) {
# dir does not change
$map->{ $pos->[0] }->{ $pos->[1] } = '#';
$infected++;
}
elsif ( $state eq 'F' ) {
$dir = my_reverse($dir);
$map->{ $pos->[0] }->{ $pos->[1] } = '.';
}
else { # clean
$dir = turn_left($dir);
$map->{ $pos->[0] }->{ $pos->[1] } = 'W';
}
# move
$pos = [ $pos->[0] + $dir->[0], $pos->[1] + $dir->[1] ];
$moves++;
}
say $infected;
###############################################################################
sub turn_left {
my ($in) = @_;
my $out;
if ( $in->[0] == -1 and $in->[1] == 0 ) { #up
$out = [ 0, -1 ];
}
elsif ( $in->[0] == 0 and $in->[1] == -1 ) { #left
$out = [ 1, 0 ];
}
elsif ( $in->[0] == 1 and $in->[1] == 0 ) { #down
$out = [ 0, 1 ];
}
elsif ( $in->[0] == 0 and $in->[1] == 1 ) { #right
$out = [ -1, 0 ];
}
else {
die "can't parse direction: [ $in->[0], $in->[1] ]";
}
return $out;
}
sub turn_right {
my ($in) = @_;
my $out;
if ( $in->[0] == -1 and $in->[1] == 0 ) { #up
$out = [ 0, 1 ];
}
elsif ( $in->[0] == 0 and $in->[1] == -1 ) { #left
$out = [ -1, 0 ];
}
elsif ( $in->[0] == 1 and $in->[1] == 0 ) { #down
$out = [ 0, -1 ];
}
elsif ( $in->[0] == 0 and $in->[1] == 1 ) { #right
$out = [ 1, 0 ];
}
else {
die "can't parse direction: [ $in->[0], $in->[1] ]";
}
return $out;
}
sub my_reverse {
my ($in) = @_;
my $out;
for my $i ( 0, 1 ) {
$out->[$i] = $in->[$i] == 0 ? 0 : -1 * $in->[$i];
}
return $out;
}
sub pretty_print {
foreach my $r ( sort { $a <=> $b } keys %{$map} ) {
foreach my $c ( sort { $a <= $b } keys %{ $map->{$r} } ) {
if ( exists $map->{$r}->{$c} ) {
print $map->{$r}->{$c};
}
else {
print '.';
}
}
print "\n";
}
print "\n";
}
120 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 %registers;
my @ins;
my $line = 0;
while (@input) {
my @atoms = split( /\s+/, shift @input );
push @ins, \@atoms;
$line++;
}
sub value_of;
my %action = (
set => \&set_register,
sub => \&decrease_register,
mul => \&multiply_register,
jnz => \&jump_not_zero,
);
map { $registers{$_} = 0 } ( 'a' .. 'h' );
#$registers{a} = 0;
my $pos = 0;
my $multiplies;
while ( $pos >= 0 and $pos <= $#ins ) {
my ( $cmd, $arg1, $arg2 ) = @{ $ins[$pos] };
my $ret = $action{$cmd}->( $arg1, $arg2 );
$multiplies++ if $cmd eq 'mul';
$pos = $pos + $ret;
}
say "1. number of multiplications: ", $multiplies;
###############################################################################
sub value_of {
my ($x) = @_;
my $val;
if ( exists $registers{$x} ) {
$val = $registers{$x};
}
else {
$val = $x;
}
return $val;
}
sub set_register {
my ( $x, $y ) = @_;
$registers{$x} = value_of($y);
return 1;
}
sub add_to_register {
my ( $x, $y ) = @_;
$registers{$x} += value_of($y);
return 1;
}
sub decrease_register {
my ( $x, $y ) = @_;
$registers{$x} -= value_of($y);
return 1;
}
sub multiply_register {
my ( $x, $y ) = @_;
my $factor = $registers{$x} // 0;
my $res = $factor * value_of($y);
$registers{$x} = $res;
return 1;
}
sub jump_not_zero {
my ( $x, $y ) = @_;
my $flag = value_of($x);
my $jump = 1;
if ( $flag != 0 ) {
$jump = value_of($y);
}
return $jump;
}
75 lines [ Plain text ] [ ^Top ]
#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;
use ntheory qw/is_prime/;
###
# credit: Reddit /u/dario_p1
# https://www.reddit.com/r/adventofcode/comments/7lms6p/2017_day_23_solutions/drnmlbk/
my $input = 67; # from the first line of the input
my $lower = $input * 100 + 100_000;
my $upper = $lower + 17_000;
my $h = 0;
for ( my $i = $lower ; $i <= $upper ; $i += 17 ) {
if ( !is_prime($i) ) {
$h++;
}
}
say "2. value of register 'h': ", $h;
14 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;
use List::Util qw/sum/;
#### 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
# credit: reddit user /u/tobiasvl
# https://www.reddit.com/r/adventofcode/comments/7lte5z/2017_day_24_solutions/drpug3v/
my @connections;
while (@input) {
my $el = shift @input;
my @ar = split( '/', $el );
push @connections, \@ar;
}
sub build {
my ( $path, $components, $connection ) = @_;
my $strongest = $path;
my $longest = $path;
for my $c (@$components) {
next unless ( $c->[0] == $connection or $c->[1] == $connection );
my @npath = ( @$path, $c );
my @excl = grep { !( $_ ~~ $c ) } @$components;
my $next = $c->[0] == $connection ? $c->[1] : $c->[0];
my ( $strong, $long ) = build( \@npath, \@excl, $next );
if ( sum( map { sum @$_ } @$strong ) >
( sum( map { sum @$_ } @$strongest ) ) )
{
$strongest = $strong;
}
if ( scalar @$long > scalar @$longest ) {
$longest = $long;
}
elsif ( scalar @$long == scalar @$longest ) {
$longest = $long
if ( sum( map { sum @$_ } @$long ) >
sum( map { sum @$_ } @$longest ) );
}
}
return ( $strongest, $longest );
}
my ( $p1, $p2 ) = build( [], \@connections, 0 );
say "1. strongest bridge has strength: ", sum( map { sum @$_ } @$p1 );
say "2. longest bridge has strength: ", sum( map { sum @$_ } @$p2 );
44 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#!/usr/bin/perl
use 5.016;
use warnings;
use autodie;
### CODE
my $tape;
my %actions = (
A => \&stateA,
B => \&stateB,
C => \&stateC,
D => \&stateD,
E => \&stateE,
F => \&stateF,
tA => \&testA,
tB => \&testB,
);
my $limit = $testing ? 6 : 12794428;
my $steps = 0;
my $pos = 0;
my $state = $testing ? 'tA' : 'A';
while ( $steps < $limit ) {
( $pos, $state ) = @{ $actions{$state}->($pos) };
$steps++;
}
my $checksum = 0;
foreach my $h ( keys %$tape ) {
$checksum++ if $tape->{$h} == 1;
}
say $checksum;
###############################################################################
sub value_of {
my ($p) = @_;
if ( exists $tape->{$p} ) {
return $tape->{$p};
}
else {
$tape->{$p} = 0;
return 0;
}
}
sub stateA {
my ($p) = @_;
my $v = value_of($p);
if ( $v == 0 ) {
$tape->{$p} = 1;
$p = $p - 1;
return [ $p, 'B' ];
}
else {
$tape->{$p} = 0;
$p = $p + 1;
return [ $p, 'F' ];
}
}
sub stateB {
my ($p) = @_;
my $v = value_of($p);
if ( $v == 0 ) {
$tape->{$p} = 0;
$p = $p - 1;
return [ $p, 'C' ];
}
else {
$tape->{$p} = 0;
$p = $p - 1;
return [ $p, 'D' ];
}
}
sub stateC {
my ($p) = @_;
my $v = value_of($p);
if ( $v == 0 ) {
$tape->{$p} = 1;
$p = $p + 1;
return [ $p, 'D' ];
}
else {
$tape->{$p} = 1;
$p = $p - 1;
return [ $p, 'E' ];
}
}
sub stateD {
my ($p) = @_;
my $v = value_of($p);
if ( $v == 0 ) {
$tape->{$p} = 0;
$p = $p + 1;
return [ $p, 'E' ];
}
else {
$tape->{$p} = 0;
$p = $p + 1;
return [ $p, 'D' ];
}
}
sub stateE {
my ($p) = @_;
my $v = value_of($p);
if ( $v == 0 ) {
$tape->{$p} = 0;
$p = $p - 1;
return [ $p, 'A' ];
}
else {
$tape->{$p} = 1;
$p = $p - 1;
return [ $p, 'C' ];
}
}
sub stateF {
my ($p) = @_;
my $v = value_of($p);
if ( $v == 0 ) {
$tape->{$p} = 1;
$p = $p + 1;
return [ $p, 'A' ];
}
else {
$tape->{$p} = 1;
$p = $p - 1;
return [ $p, 'A' ];
}
}
sub testA {
my ($p) = @_;
my $v = value_of($p);
if ( $v == 0 ) {
$tape->{$p} = 1;
$p = $p - 1;
return [ $p, 'tB' ];
}
else {
$tape->{$p} = 0;
$p = $p + 1;
return [ $p, 'tB' ];
}
}
sub testB {
my ($p) = @_;
my $v = value_of($p);
if ( $v == 0 ) {
$tape->{$p} = 1;
$p = $p - 1;
return [ $p, 'tA' ];
}
else {
$tape->{$p} = 1;
$p = $p + 1;
return [ $p, 'tA' ];
}
}
149 lines [ Plain text ] [ ^Top ]
Generated on Wed Dec 27 07:50:13 2017 UTC.