These 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/env perl
use Modern::Perl '2015';
# useful modules
use List::Util qw/reduce/;
use Test::More;
use Time::HiRes qw/gettimeofday tv_interval/;
sub sec_to_hms;
my $start_time = [gettimeofday];
#### 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 %ans;
# Part 1: use `reduce` here just because we can
# $a and $b are set to the initial entries in the list, then $a is set
# to the result. So we return $b last
my $res = reduce {
if ( $b > $a ) { $ans{1}++ }
$b
} @input;
# Part 2: our requirement: d[i]+d[i+1]+d[i+2] < d[i+1]+d[i+2]+d[i+3]
# this reduces to: d[i+3] > d[i]
for my $idx ( 0 .. $#input - 3 ) {
$ans{2}++ if ( $input[ $idx + 3 ] > $input[ $idx ] );
}
### FINALIZE - tests and run time
is( $ans{1}, 1655, "Part 1: $ans{1}" );
is( $ans{2}, 1683, "Part 2: $ans{2}" );
done_testing();
say sec_to_hms( tv_interval($start_time) );
### SUBS
sub sec_to_hms { my ($s) = @_;
return sprintf("Duration: %02dh%02dm%02ds (%.3f ms)",
int($s/(60*60)),($s/60)%60,$s%60,$s*1000);
}
27 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#! /usr/bin/env perl
use Modern::Perl '2015';
# useful modules
use Test::More;
use Time::HiRes qw/gettimeofday tv_interval/;
sub sec_to_hms;
my $start_time = [gettimeofday];
#### INIT - load input data from file into array
my $testing = 0;
my $file = $testing ? 'test.txt' : 'input.txt';
### CODE
my %pos = (
1 => { x => 0, y => 0 },
2 => { x => 0, y => 0, aim => 0 }
);
my %actions = (
forward => sub {
$pos{1}->{x} += $_[0];
$pos{2}->{x} += $_[0];
$pos{2}->{y} += $_[0] * $pos{2}->{aim};
},
down => sub { $pos{1}->{y} += $_[0]; $pos{2}->{aim} += $_[0] },
up => sub { $pos{1}->{y} -= $_[0]; $pos{2}->{aim} -= $_[0] }
);
open( my $fh, '<', "$file" );
while (<$fh>) {
chomp;
s/\r//gm;
my ( $cmd, $amt ) = split( / /, $_ );
if ( exists $actions{$cmd} ) {
$actions{$cmd}->($amt);
}
else {
warn "unknown command: $cmd";
}
}
my $part1 = $pos{1}->{x} * $pos{1}->{y};
my $part2 = $pos{2}->{x} * $pos{2}->{y};
### FINALIZE - tests and run time
is( $part1, 1714680, "Part 1: $part1" );
is( $part2, 1963088820, "Part 2: $part2" );
done_testing();
say sec_to_hms( tv_interval($start_time) );
### SUBS
sub sec_to_hms {
my ($s) = @_;
return sprintf("Duration: %02dh%02dm%02ds (%.3f ms)",
int( $s / ( 60 * 60 ) ), ( $s / 60 ) % 60, $s % 60, $s * 1000 );
}
43 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#! /usr/bin/env perl
use Modern::Perl '2015';
# useful modules
use Test::More;
use Time::HiRes qw/gettimeofday tv_interval/;
use utf8;
sub sec_to_hms;
my $start_time = [gettimeofday];
#### INIT - load input data from file into array
my $testing = 0;
my @input;
my $file = $testing ? 'test.txt' : 'input.txt';
open( my $fh, '<', "$file" );
my @data;
my %freq;
while (<$fh>) {
chomp; s/\r//gm;
my @values = split(//, $_);
push @data, \@values;
map { $freq{$_}->{ $values[$_] }++ } ( 0 .. $#values );
}
### CODE
sub filter_by_index_and_type;
## Part 1
my ( $𝛾, $ε );
for my $i ( 0 .. ( scalar keys %freq ) - 1 ) {
if ( $freq{$i}->{0} > $freq{$i}->{1} ) {
$𝛾 .= 0;
$ε .= 1;
}
elsif ( $freq{$i}->{1} > $freq{$i}->{0} ) {
$𝛾 .= 1;
$ε .= 0;
}
}
my $part1 = oct( "0b" . $𝛾 ) * oct( "0b" . $ε );
## Part 2
# initial setup, mark all rows as valid
my $oxy = { map { $_ => 1 } ( 0 .. $#data ) };
my $cdx = { map { $_ => 1 } ( 0 .. $#data ) };
# for each column, filter those entries that match the condition
for my $idx ( 0 .. scalar @{ $data[0] } - 1 ) {
$oxy = filter_by_index_and_type( $idx, 'oxy', $oxy );
$cdx = filter_by_index_and_type( $idx, 'cdx', $cdx );
}
my $part2 = oct( "0b" . join( '', @{ $data[ ( keys %$oxy )[0] ] } ) ) *
oct( "0b" . join( '', @{ $data[ ( keys %$cdx )[0] ] } ) );
### FINALIZE - tests and run time
is( $part1, 2003336, "Part 1: $part1" );
is( $part2, 1877139, "Part 2: $part2" );
done_testing();
say sec_to_hms( tv_interval($start_time) );
### SUBS
sub filter_by_index_and_type {
my ( $idx, $type, $filter ) = @_;
my $new_filter;
my @col;
# select those rows that match the incoming filter
for my $i ( keys %$filter ) {
push @col, $data[$i]->[$idx];
}
# select number of 1s and 0s
my @vals;
$vals[0] = grep { $_ == 0 } @col;
$vals[1] = grep { $_ == 1 } @col;
my $common;
if ( $type eq 'oxy' ) {
$common = $vals[1] >= $vals[0] ? 1 : 0;
}
elsif ( $type eq 'cdx' ) {
$common = $vals[0] <= $vals[1] ? 0 : 1;
}
else {
die "unknown type: $type";
}
if ( scalar keys %$filter == 1 ) {
return $filter;
}
else { # construct a new filter based on common values
map { $new_filter->{$_}++ if $data[$_][$idx] == $common }
keys %$filter;
}
return $new_filter;
}
sub sec_to_hms {
my ($s) = @_;
return sprintf("Duration: %02dh%02dm%02ds (%.3f ms)",
int( $s / ( 60 * 60 ) ), ( $s / 60 ) % 60, $s % 60, $s * 1000 );
}
79 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#! /usr/bin/env perl
use Modern::Perl '2015';
# useful modules
use Test::More;
use Time::HiRes qw/gettimeofday tv_interval/;
sub sec_to_hms;
my $start_time = [gettimeofday];
#### INIT - load input data from file into array
my $testing = 0;
my @input;
my $file = $testing ? 'test.txt' : 'input.txt';
open( my $fh, '<', "$file" );
{
local $/ = "";
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }
}
### CODE
my @draws;
my %boards;
my %positions;
my %ans;
my $count = 0;
for my $chunk (@input) {
if ( $count == 0 ) { # first line is draws
@draws = split( /,/, $chunk );
}
else {
my @rows = split( /\n/, $chunk );
my $row = 1;
for my $r (@rows) {
my @cols = split( " ", $r );
my $col = 1;
for my $number (@cols) {
$boards{$count}{$row}{$col} = { number => $number };
$positions{$number}{$count}{$row}{$col} = 1;
$col++;
}
$row++;
}
}
$count++;
}
sub calculate_board;
sub dump_board;
# initialize the %has_won hash with zeros
my %has_won = map { $_ => 0 } keys %boards;
my %visited= ();
while (@draws) {
my $draw = shift @draws;
for my $board ( keys %{ $positions{$draw} } ) {
$visited{$board}++;
for my $row ( keys %{ $positions{$draw}{$board} } ) {
for my $col ( keys %{ $positions{$draw}{$board}{$row} } ) {
$boards{$board}{$row}{$col}{marked}++;
}
}
}
# use the %visited hash to only scan those boards that have had a
#number marked
# this was implemented as an optimization but it does not seem to
# do much
for my $board (keys %visited ) {
# check rows
for my $row ( 1 .. 5 ) {
my $marked_count = 0;
for my $col ( 1 .. 5 ) {
$marked_count++ if $boards{$board}{$row}{$col}{marked};
}
if ( $marked_count == 5 ) {
$has_won{$board}++;
}
}
# check columns
for my $col ( 1 .. 5 ) {
my $marked_count = 0;
for my $row ( 1 .. 5 ) {
$marked_count++ if $boards{$board}{$row}{$col}{marked};
}
if ( $marked_count == 5 ) {
$has_won{$board}++;
}
}
}
# what is the number of wins?
my %reverse = reverse %has_won;
# either only 1 or 0 wins == first board
if ( scalar keys %reverse == 2 and exists $reverse{1} ) {
say "First board to win: draw $draw led to win on " . $reverse{1};
$ans{1} = $draw * calculate_board( $reverse{1} );
}
# every board has won at least once
elsif ( !exists $reverse{0} ) {
# get the board with least wins (and hope it's unique)
my $last_won
= ( sort { $has_won{$a} <=> $has_won{$b} } keys %has_won )[0];
say "Final board to win: draw $draw led to win on " . $last_won;
$ans{2} = $draw * calculate_board($last_won);
last;
}
}
### FINALIZE - tests and run time
is( $ans{1}, 8442, "Part 1: " . $ans{1} );
is( $ans{2}, 4590, "Part 2: " . $ans{2} );
done_testing();
say sec_to_hms( tv_interval($start_time) );
### SUBS
sub sec_to_hms {
my ($s) = @_;
return sprintf(
"Duration: %02dh%02dm%02ds (%.3f ms)",
int( $s / ( 60 * 60 ) ),
( $s / 60 ) % 60,
$s % 60, $s * 1000
);
}
sub calculate_board {
my ($b) = @_;
my $sum = 0;
for my $r ( keys %{ $boards{$b} } ) {
for my $c ( keys %{ $boards{$b}{$r} } ) {
$sum += $boards{$b}{$r}{$c}{number}
unless $boards{$b}{$r}{$c}{marked};
}
}
return $sum;
}
sub dump_board {
my ($b) = @_;
for my $r ( 1 .. 5 ) {
for my $c ( 1 .. 5 ) {
my $num = $boards{$b}{$r}{$c}{number};
my $string;
if ( $boards{$b}{$r}{$c}{marked} ) {
$string = "[$num]";
}
else {
$string = $num;
}
printf "%4s", $string;
}
print "\n";
}
}
136 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#! /usr/bin/env perl
use Modern::Perl '2015';
# useful modules
use List::Util qw/max/;
use Test::More;
use Time::HiRes qw/gettimeofday tv_interval/;
use Math::Trig;
sub sec_to_hms;
my $start_time = [gettimeofday];
#### INIT - load input data from file into array
my $testing = 0;
my $part2 = shift @ARGV // 0;
my @input;
my $file = $testing ? 'test.txt' : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }
### CODE
my @lines;
my %freq;
my ( $x1, $y1, $x2, $y2 );
for my $in (@input) {
if ( $in =~ m/^(\d+),(\d+) -> (\d+),(\d+)$/ ) {
( $x1, $y1, $x2, $y2 ) = ( $1, $2, $3, $4 );
}
else {
die "can't parse line: $in";
}
my $norm_x = $x2 - $x1;
my $norm_y = $y2 - $y1;
my $dir = rad2deg( atan2( $norm_y, $norm_x ) );
# normalize degrees to between 0 and 360, because we want to use
# them as hash keys and negative values don't work there
$dir = $dir < 0 ? 360 + $dir : $dir;
$freq{$dir}++;
push @lines, {x1 => $x1, y1 => $y1, x2 => $x2, y2 => $y2, dir => $dir};
}
#dump %freq;
my $Map;
sub dump_map;
sub paint;
# note we are dealing with a coordinate system that is "flipped"
# around the X-axis. Positive Y points down
my %vectors = ( 0=>[ 1, 0], 180=>[-1, 0], 90=>[ 0, 1], 270=>[ 0, -1],
45=>[ 1, 1], 135=>[-1, 1], 315=>[ 1,-1], 225=>[-1,- 1]);
my %part1_dirs = ( 0 => 1, 90 => 1, 180 => 1, 270 => 1 );
for my $L (@lines) {
my $dir = $L->{dir};
if ( !$part2 and !exists $part1_dirs{$dir} ) {next}
paint( $L );
}
my $count;
for my $x ( keys %$Map ) {
for my $y ( keys %{ $Map->{$x} } ) {
$count++ if $Map->{$x}{$y} >= 2;
}
}
dump_map if $testing;
my $ans = $count;
if ($part2) { is( $ans, 18442, "Part 2: $ans" ) }
else { is( $ans, 4745, "Part 1: $ans" ) }
done_testing;
say sec_to_hms( tv_interval($start_time) );
### SUBS
sub sec_to_hms {
my ($s) = @_;
return sprintf(
"Duration: %02dh%02dm%02ds (%.3f ms)",
int( $s / ( 60 * 60 ) ),
( $s / 60 ) % 60,
$s % 60, $s * 1000
);
}
sub paint {
my ($L) = @_;
my $steps = max( abs( $L->{x2} - $L->{x1} ), abs( $L->{y2} - $L->{y1} ) );
for ( my $i = 0; $i <= $steps; $i++ ) {
$Map->{ $L->{x1} + $i * $vectors{ $L->{dir} }->[0] }
->{ $L->{y1} + $i * $vectors{ $L->{dir} }->[1] }++;
}
}
sub dump_map {
my ( $max_x, $max_y ) = ( -1, -1 );
my ( $min_x, $min_y ) = ( 10_000, 10_000 );
for my $x ( keys %$Map ) {
if ( $x > $max_x ) {
$max_x = $x;
}
if ( $x < $min_x ) {
$min_x = $x;
}
for my $y ( keys %{ $Map->{$x} } ) {
if ( $y > $max_y ) {
$max_y = $y;
}
if ( $y < $min_y ) {
$min_y = $y;
}
}
}
for my $y ( $min_y .. $max_y ) {
for my $x ( $min_x .. $max_x ) {
print $Map->{$x}{$y} ? $Map->{$x}{$y} : '.';
}
print "\n";
}
}
98 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#! /usr/bin/env perl
use Modern::Perl '2015';
# useful modules
use Test::More;
use Time::HiRes qw/gettimeofday tv_interval/;
sub sec_to_hms;
my $start_time = [gettimeofday];
#### INIT - load input data from file into array
my $testing = 0;
my $part2 = shift @ARGV // 0;
my @input;
my $file = $testing ? 'test.txt' : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }
### CODE
my %generations;
for my $f ( split( ',', $input[0] ) ) {
$generations{$f}++;
}
sub dump_state;
my $days = 1;
my $limit = $part2 ? 256 : 80;
while ( $days <= $limit ) {
my %new = ();
for my $cohort ( sort keys %generations ) {
if ( $cohort == 0 ) {
$new{6} = $generations{0};
$new{8} = $generations{0};
}
else {
$new{ $cohort - 1 } += $generations{$cohort};
}
}
%generations = %new;
$days++;
}
my $ans = 0;
for my $cohort ( keys %generations ) {
$ans += $generations{$cohort};
}
if ($part2) { is( $ans, 1617359101538, "Part 2: $ans" ) }
else { is( $ans, 356190, "Part 1: $ans" ) }
### FINALIZE - tests and run time
# is();
done_testing();
say sec_to_hms( tv_interval($start_time) );
### SUBS
sub sec_to_hms {
my ($s) = @_;
return sprintf(
"Duration: %02dh%02dm%02ds (%.3f ms)",
int( $s / ( 60 * 60 ) ),
( $s / 60 ) % 60,
$s % 60, $s * 1000
);
}
sub dump_state {
my ($state) = @_;
for my $c ( sort { $a <=> $b } keys %$state ) {
printf( "%2d: %3d ", $c, $state->{$c} );
}
print "\n";
}
56 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#! /usr/bin/env perl
use Modern::Perl '2015';
# useful modules
use List::Util qw/sum min max/;
use Test::More;
use Time::HiRes qw/gettimeofday tv_interval/;
sub sec_to_hms;
my $start_time = [gettimeofday];
#### 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 @positions = split( ',', $input[0] );
sub median;
sub cost_per_position;
my $median = median(@positions);
my $average = ( sum @positions ) / scalar @positions;
# this is an optimization, instead of checking every possible position
# we just search around the range of [median,int(average)], as in my
# case these values are the solutions for part 1 and part 2
# respectively
my %ans = ( 1 => 1e10, 2 => 10e10 );
for my $t (min($median, int $average) - 5 .. max($median, int $average) + 5) {
my $res = cost_per_position($t);
# check if result is smaller than what we already have
map { $ans{$_} = $res->[$_-1] < $ans{$_} ? $res->[$_-1] : $ans{$_}} (1,2);
}
### FINALIZE - tests and run time
is( $ans{1}, 337488, "Part 1: " . $ans{1} );
is( $ans{2}, 89647695, "Part 2: " . $ans{2} );
done_testing();
say sec_to_hms( tv_interval($start_time) );
### SUBS
sub median { # https://www.perlmonks.org/?node_id=90772
my @sorted = sort { $a <=> $b } @_;
( $sorted[ $#sorted / 2 + 0.1 ] + $sorted[ $#sorted / 2 + 0.6 ] ) / 2;
}
sub cost_per_position {
my ($goal) = @_;
my @costs = ( 0, 0 );
for my $p (@positions) {
my $d = abs( $goal - $p );
# part 1
$costs[0] += $d;
# part 2
$costs[1] += $d * ( $d + 1 ) / 2;
}
return \@costs;
}
sub sec_to_hms {
my ($s) = @_;
return sprintf(
"Duration: %02dh%02dm%02ds (%.3f ms)",
int( $s / ( 60 * 60 ) ), ( $s / 60 ) % 60, $s % 60, $s * 1000 );
}
48 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#! /usr/bin/env perl
use Modern::Perl '2015';
# useful modules
use List::Util qw/any all/;
use Test::More;
use Time::HiRes qw/gettimeofday tv_interval/;
use Algorithm::Combinatorics qw(permutations);
sub sec_to_hms;
my $start_time = [gettimeofday];
#### 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, $_; }
sub solve;
### CODE
my @permutations = permutations( [ 'a' .. 'g' ] );
my %patterns = (
0 => [qw/0 1 2 4 5 6/],
1 => [qw/ 2 5 /],
2 => [qw/0 2 3 4 6/],
3 => [qw/0 2 3 5 6/],
4 => [qw/ 1 2 3 5 /],
5 => [qw/0 1 3 5 6/],
6 => [qw/0 1 3 4 5 6/],
7 => [qw/0 2 5 /],
9 => [qw/0 1 2 3 5 6/],
);
my $count = 0;
my @values;
my @output;
my $sum = 0;
for my $line (@input) {
my ( $in, $out ) = split( /\|/, $line );
@values = split( " ", $in );
@output = split( " ", $out );
for my $el (@output) {
$count++
if ( length($el) == 2
or length($el) == 3
or length($el) == 4
or length($el) == 7 );
}
my $sol = solve(@values);
if ( defined $sol ) {
my $num = '';
for my $o ( map { join( "", sort split( //, $_ ) ) } @output ) {
$num .= $sol->{$o};
}
$sum += $num;
}
}
### FINALIZE - tests and run time
is( $count, 470, "Part 1: $count" );
is( $sum, 989396, "Part 2: $sum" );
done_testing();
say sec_to_hms( tv_interval($start_time) );
### SUBS
sub solve {
# segment numbering:
# +-0-+
# 1 2
# +-3-+
# 4 5
# +-6-+
my $ret = undef;
my @v = @_;
@v = sort { length($a) <=> length($b) }
map { join( "", sort split( //, $_ ) ) } @v;
for my $per (@permutations) {
my %p;
# check if the current permutation can lead to a solution
# bail if doesn't
# One, Four, Seven
my $pattern = join( '', sort map { $per->[$_] } @{ $patterns{1} } );
next unless $pattern eq $v[0];
$pattern = join( '', sort map { $per->[$_] } @{ $patterns{7} } );
next unless $pattern eq $v[1];
$pattern = join( '', sort map { $per->[$_] } @{ $patterns{4} } );
next unless $pattern eq $v[2];
# Two Three Five
my @ok = ( 0, 0, 0 );
$pattern = join( '', sort map { $per->[$_] } @{ $patterns{2} } );
$ok[0] = any { $pattern eq $v[$_] } qw/3 4 5/;
$pattern = join( '', sort map { $per->[$_] } @{ $patterns{3} } );
$ok[1] = any { $pattern eq $v[$_] } qw/3 4 5/;
$pattern = join( '', sort map { $per->[$_] } @{ $patterns{5} } );
$ok[2] = any { $pattern eq $v[$_] } qw/3 4 5/;
next unless all { $_ == 1 } @ok;
# Zero Six Nine
@ok = ( 0, 0, 0 );
$pattern = join( '', sort map { $per->[$_] } @{ $patterns{0} } );
$ok[0] = any { $pattern eq $v[$_] } qw/6 7 8/;
$pattern = join( '', sort map { $per->[$_] } @{ $patterns{6} } );
$ok[1] = any { $pattern eq $v[$_] } qw/6 7 8/;
$pattern = join( '', sort map { $per->[$_] } @{ $patterns{9} } );
$ok[2] = any { $pattern eq $v[$_] } qw/6 7 8/;
next unless all { $_ == 1 } @ok;
# we've reached a solution, let's return a mapping of strings
# to numbers
$p{8} = $v[-1];
$p{1} = $v[0];
$p{7} = $v[1];
$p{4} = $v[2];
# we need to filter these to identify the unique ones
my @rest = @v[ 3, 4, 5, 6, 7, 8 ];
while (@rest) {
for my $i ( 2, 3, 5, 0, 6, 9 ) {
if ( @rest
and
join( "", sort map { $per->[$_] } @{ $patterns{$i} } ) eq
$rest[0] )
{
$p{$i} = shift @rest;
}
}
}
$ret = { reverse %p } if scalar keys %p == 10;
}
return $ret;
}
sub sec_to_hms {
my ($s) = @_;
return sprintf(
"Duration: %02dh%02dm%02ds (%.3f ms)",
int( $s / ( 60 * 60 ) ),
( $s / 60 ) % 60,
$s % 60, $s * 1000
);
}
125 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#! /usr/bin/env perl
use Modern::Perl '2015';
# useful modules
use List::Util qw/all product/;
use Test::More;
use Time::HiRes qw/gettimeofday tv_interval/;
sub sec_to_hms;
my $start_time = [gettimeofday];
#### 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 $id = 0;
my $Basins;
# We use a hash-of-hashes construct for the map, because it makes
# checking the boundaries much easier
my $r = 1;
for my $line (@input) {
my $c = 1;
for ( split( //, $line ) ) {
$Map->{$r}{$c} = { val => $_ };
$c++;
}
$r++;
}
my $risk = 0;
# Part 1: search for low points and calculate the total risk level
for my $r ( keys %$Map ) {
for my $c ( keys %{ $Map->{$r} } ) {
my @neighbors;
for my $d ( [ -1, 0 ], [ 1, 0 ], [ 0, -1 ], [ 0, 1 ] ) {
my ( $dr, $dc ) = ( $r + $d->[0], $c + $d->[1] );
if ( defined $Map->{$dr}{$dc} ) {
push @neighbors, $Map->{$dr}{$dc}->{val};
}
}
if ( all { $Map->{$r}{$c}->{val} < $_ } @neighbors ) {
# we have a low point, give it an ID and add it to the
# list of locations
++$id;
$Basins->{$id} = { r => $r, c => $c };
$Map->{$r}{$c}->{id} = $id;
$risk += ( $Map->{$r}{$c}->{val} + 1 );
}
}
}
# starting at each low point, find the area that drains to it
for my $id ( keys %$Basins ) {
# we use BFS
my @queue = ( [ $Basins->{$id}{r}, $Basins->{$id}{c} ] );
while (@queue) {
my $cur = shift @queue;
for my $d ( [ -1, 0 ], [ 1, 0 ], [ 0, -1 ], [ 0, 1 ] ) {
my ( $dr, $dc ) = ( $cur->[0] + $d->[0], $cur->[1] + $d->[1] );
if ( defined $Map->{$dr}{$dc} ) {
# a point is in the basin if it is
# - strictly higher than a neighbor
# - not == 9
# - not already marked as visited
if ( $Map->{$dr}{$dc}{val}
> $Map->{ $cur->[0] }{ $cur->[1] }{val}
and $Map->{$dr}{$dc}{val} != 9
and !defined( $Map->{$dr}{$dc}{id} ) )
{
$Map->{$dr}{$dc}{id} = $id;
push @queue, [ $dr, $dc ];
}
}
}
}
}
my %sizes;
for my $r ( keys %$Map ) {
for my $c ( keys %{ $Map->{$r} } ) {
if ( $Map->{$r}{$c}{id} ) {
$sizes{ $Map->{$r}{$c}{id} }++;
}
}
}
# This horror is just to extract the values of the top basins by size
my $prod = product( map { $sizes{$_} }
( sort { $sizes{$b} <=> $sizes{$a} } keys %sizes )[ 0 .. 2 ] );
### FINALIZE - tests and run time
if ($testing) {
is( $risk, 15, "Part 1: $risk" );
is( $prod, 1134, "Part 1: $prod" );
}
else {
is( $risk, 423, "Part 1: $risk" );
is( $prod, 1198704, "Part 2: $prod" );
}
done_testing();
say sec_to_hms( tv_interval($start_time) );
### SUBS
sub sec_to_hms {
my ($s) = @_;
return sprintf(
"Duration: %02dh%02dm%02ds (%.3f ms)",
int( $s / ( 60 * 60 ) ),
( $s / 60 ) % 60,
$s % 60, $s * 1000
);
}
96 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#! /usr/bin/env perl
use Modern::Perl '2015';
# useful modules
use Test::More;
use Time::HiRes qw/gettimeofday tv_interval/;
sub sec_to_hms;
my $start_time = [gettimeofday];
#### 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 %closers = ( ']' => '[', ')' => '(', '}' => '{', '>' => '<' );
my %openers = reverse %closers;
my %scores = ( ')' => 3, ']' => 57, '}' => 1197, '>' => 25137 );
my %autoscores = ( ')' => 1, ']' => 2, '}' => 3, '>' => 4 );
my @part2;
sub parse_line;
my $score = 0;
for my $line (@input) {
my $ret = parse_line($line);
if ( $ret !~ /1/ ) {
$score += $scores{$ret};
}
}
@part2 = sort { $a <=> $b } @part2;
my $part2 = $part2[ int( ( scalar @part2 ) / 2 ) ];
### FINALIZE - tests and run time
is( $score, 318081, "Part 1: $score" );
is( $part2, 4361305341, "Part 2: $part2" );
done_testing();
say sec_to_hms( tv_interval($start_time) );
### SUBS
sub parse_line {
my ($l) = @_;
my @l = split( '', $l );
my @stack;
LOOP:
for my $t (@l) {
if ( exists $closers{$t} ) { # found a closing token
my $c = pop @stack;
return $t unless ( $closers{$t} eq $c );
}
else {
push @stack, $t;
}
}
# part 2
if ( scalar @stack > 1 ) {
my @autocomplete = map { $openers{$_} } reverse @stack;
my $total = 0;
for my $c (@autocomplete) {
$total *= 5;
$total += $autoscores{$c};
}
push @part2, $total;
}
return 1;
}
sub sec_to_hms {
my ($s) = @_;
return sprintf(
"Duration: %02dh%02dm%02ds (%.3f ms)",
int( $s / ( 60 * 60 ) ),
( $s / 60 ) % 60,
$s % 60, $s * 1000
);
}
64 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#! /usr/bin/env perl
use Modern::Perl '2015';
# useful modules
use List::Util qw/sum/;
use Data::Dump qw/dump/;
use Test::More;
use Time::HiRes qw/gettimeofday tv_interval/;
sub sec_to_hms;
my $start_time = [gettimeofday];
#### 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 %ans;
sub dump_map;
my $r = 0;
for my $line (@input) {
my $c = 0;
for my $v ( split( "", $line ) ) {
$Map->{$r}{$c} = { v => $v, sweep => 0 };
$c++;
}
$r++;
}
#dump_map;
my $step = 1;
my $flash_count = 0;
my $has_synced = 0;
while ( !$has_synced ) {
# initial step, raise all levels by one
for my $r ( keys %$Map ) {
for my $c ( keys %{ $Map->{$r} } ) {
$Map->{$r}{$c}{v}++;
}
}
# sweep until all changes have been effected
my $has_changed = 1;
my $sweep_count = 0;
while ($has_changed) {
my $changes = 0;
for my $r ( keys %$Map ) {
for my $c ( keys %{ $Map->{$r} } ) {
# will a recent flash change this cell's level ?
next if $Map->{$r}{$c}{v} > 9;
for my $d (
[ -1, -1 ], [ -1, 0 ], [ -1, 1 ],
[ 0, -1 ], [ 0, 1 ],
[ 1, -1 ], [ 1, 0 ], [ 1, 1 ]
)
{
my ( $dr, $dc ) = ( $r + $d->[0], $c + $d->[1] );
if ( defined $Map->{$dr}{$dc}
and $Map->{$dr}{$dc}{v} > 9
and $Map->{$dr}{$dc}{sweep} == $sweep_count )
{
$Map->{$r}{$c}{v}++;
$Map->{$r}{$c}{sweep} = $sweep_count + 1;
$changes++;
}
}
}
}
$sweep_count++;
$has_changed = 0 if $changes == 0;
}
# reset values for next step, count flashes;
my $step_flashes = 0;
for my $r ( keys %$Map ) {
for my $c ( keys %{ $Map->{$r} } ) {
if ( $Map->{$r}{$c}{v} > 9 ) {
$Map->{$r}{$c}{v} = 0;
$step_flashes++;
}
$Map->{$r}{$c}{sweep} = 0;
}
}
if ( $step_flashes == 100 ) {
$has_synced = 1;
$ans{2} = $step;
}
$flash_count += $step_flashes;
$ans{1} = $flash_count if $step == 100;
$step++;
}
### FINALIZE - tests and run time
if ($testing) {
is( $ans{1}, 1656, "Part 1: " . $ans{1} );
is( $ans{2}, 195, "Part 2: " . $ans{2} );
}
else {
is( $ans{1}, 1652, "Part 1: " . $ans{1} );
is( $ans{2}, 220, "Part 2: " . $ans{2} );
}
done_testing();
say sec_to_hms( tv_interval($start_time) );
### SUBS
sub dump_map {
for my $r ( sort { $a <=> $b } keys %$Map ) {
for my $c ( sort { $a <=> $b } keys %{ $Map->{$r} } ) {
print $Map->{$r}{$c}{v};
}
print "\n";
}
}
sub sec_to_hms {
my ($s) = @_;
return sprintf(
"Duration: %02dh%02dm%02ds (%.3f ms)",
int( $s / ( 60 * 60 ) ),
( $s / 60 ) % 60,
$s % 60, $s * 1000
);
}
110 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#! /usr/bin/env perl
use Modern::Perl '2015';
# useful modules
use Test::More;
use Time::HiRes qw/gettimeofday tv_interval/;
sub sec_to_hms;
my $start_time = [gettimeofday];
#### INIT - load input data from file into array
my $testing = 0;
my @input;
my $file = $testing ? 'test3.txt' : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }
### CODE
my $Map;
for my $line (@input) {
my ( $from, $to ) = $line =~ m/^(.*)-(.*)$/;
$Map->{$from}{$to}++ unless ( $to eq 'start' or $from eq 'end' );
$Map->{$to}{$from}++ unless ( $to eq 'end' or $from eq 'start' );
}
# algo from /u/Abigail
# - https://abigail.github.io/HTML/AdventOfCode/2021/day-12.html
my @queue;
push @queue, [ 'start', {}, 0 ];
my ( $count1, $count2 ) = ( 0, 0 );
BFS:
while (@queue) {
my ( $cur, $seen, $twice ) = @{ shift @queue };
if ( $cur eq 'end' ) {
$count1++ if !$twice;
$count2++;
next;
}
next if ( $seen->{$cur} and $cur eq lc($cur) and $twice++ );
for my $k ( keys %{ $Map->{$cur} } ) {
push @queue, [ $k, { %$seen, $cur => 1 }, $twice ];
}
}
### FINALIZE - tests and run time
is( $count1, 5756, "Part 1: $count1" );
is( $count2, 144603, "Part 2: $count2" );
done_testing();
say sec_to_hms( tv_interval($start_time) );
### SUBS
sub sec_to_hms {
my ($s) = @_;
return sprintf(
"Duration: %02dh%02dm%02ds (%.3f ms)",
int( $s / ( 60 * 60 ) ),
( $s / 60 ) % 60,
$s % 60, $s * 1000
);
}
45 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#! /usr/bin/env perl
use Modern::Perl '2015';
# useful modules
use List::Util qw/sum max/;
use Data::Dump qw/dump/;
use Clone qw/clone/;
use Test::More;
use Time::HiRes qw/gettimeofday tv_interval/;
sub sec_to_hms;
my $start_time = [gettimeofday];
#### 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 %ans;
my @instr;
sub dump_map;
sub dimensions;
for my $line (@input) {
if ( $line =~ m/^(\d+),(\d+)$/ ) {
$Map->{$1}{$2}++;
}
elsif ( $line =~ m/^fold along (.)=(\d+)$/ ) {
push @instr, [ $1, $2 ];
}
}
my $fold = 1;
for my $cmd (@instr) {
my $half1;
my $half2;
for my $x ( keys %$Map ) {
for my $y ( keys %{ $Map->{$x} } ) {
if ( $cmd->[0] eq 'x' ) {
if ( $x > $cmd->[1] ) {
$half2->{ $cmd->[1] - ( $x - $cmd->[1] ) }{$y}++;
}
else {
$half1->{$x}{$y}++;
}
}
elsif ( $cmd->[0] eq 'y' ) {
if ( $y > $cmd->[1] ) {
$half2->{$x}{ $cmd->[1] - ( $y - $cmd->[1] ) }++;
}
else {
$half1->{$x}{$y}++;
}
}
}
}
$Map = clone $half1;
for my $x ( keys %$half2 ) {
for my $y ( keys %{ $half2->{$x} } ) {
$Map->{$x}{$y}++;
}
}
# part 1
if ($fold == 1) {
$ans{1}=0;
for my $x ( keys %$Map ) {
for my $y ( keys %{ $Map->{$x} } ) {
$ans{1}++ if $Map->{$x}{$y};
}
}
}
$fold++;
}
my $digest = dump_map;
### FINALIZE - tests and run time
is($ans{1}, 753, "Part 1: ".$ans{1});
is( $digest, 1536, "Part 2 OK");
done_testing();
say sec_to_hms( tv_interval($start_time) );
### SUBS
sub sec_to_hms {
my ($s) = @_;
return sprintf(
"Duration: %02dh%02dm%02ds (%.3f ms)",
int( $s / ( 60 * 60 ) ),
( $s / 60 ) % 60,
$s % 60, $s * 1000
);
}
sub dump_map {
my $output;
my $digest;
my $max_y = 0;
for my $x ( keys %$Map ) {
$max_y
= max( keys %{ $Map->{$x} } ) > $max_y
? max( keys %{ $Map->{$x} } )
: $max_y;
}
my @rows;
for my $r ( sort { $a <=> $b } keys %$Map ) {
my $digits;
for my $c ( 0 .. $max_y ) {
$output->[$c][$r] = $Map->{$r}{$c} ? '█' : '.';
$digits .= $Map->{$r}{$c}?0:1;
}
$digest += ord( '0b'.$digits);
}
for my $r (0..(scalar @$output)-1) {
say join( '', map { $_ ? $_ : '|' } @{$output->[$r]} );
}
return $digest;
}
105 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#! /usr/bin/env perl
use Modern::Perl '2015';
# useful modules
use Test::More;
use Time::HiRes qw/gettimeofday tv_interval/;
sub sec_to_hms;
my $start_time = [gettimeofday];
#### 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 $template = shift @input;
shift @input;
my %rules;
my @ans;
for my $line (@input) {
if ( $line =~ m/(.*) -> (.*)/ ) {
$rules{$1} = $2;
}
}
my $step = 1;
my @initial = split( "", $template );
# we save this because it will be included in every subsequent string
my $first_elem = $initial[0];
my %pairs;
for my $idx ( 0 .. $#initial - 1 ) {
$pairs{ $initial[$idx] . $initial[ $idx + 1 ] }++;
}
my $end = $initial[-1];
my $LIMIT = 40;
while ( $step <= $LIMIT ) {
# count elements and add
my %elements;
$elements{$first_elem} = 1;
my %next;
for my $k ( keys %pairs ) {
if ( $rules{$k} ) {
my @in = split( '', $k );
# add new combinations to following sequence
$next{ $in[0] . $rules{$k} } += $pairs{$k};
$next{ $rules{$k} . $in[1] } += $pairs{$k};
# add up the elements, only newly added middle and right -
# the left element is already counted in the previous pair
$elements{ $rules{$k} } += $pairs{$k};
$elements{ $in[1] } += $pairs{$k};
}
}
# output all the big numbers
my @freq = sort { $elements{$b} <=> $elements{$a} } keys %elements;
printf(
"%2d %14d %14d %14d\n",
( $step,
$elements{ $freq[0] },
$elements{ $freq[-1] },
$elements{ $freq[0] } - $elements{ $freq[-1] }
)
);
if ( $step == 10 or $step == 40 ) {
push @ans, $elements{ $freq[0] } - $elements{ $freq[-1] };
}
%pairs = %next;
$step++;
}
### FINALIZE - tests and run time
if ($testing) {
is( $ans[0], 1588, "Part 1: " . $ans[0] );
is( $ans[1], 2188189693529, "Part 2: " . $ans[1] );
}
else {
is( $ans[0], 2321, "Part 1: " . $ans[0] );
is( $ans[1], 2399822193707, "Part 2: " . $ans[1] );
}
done_testing();
say sec_to_hms( tv_interval($start_time) );
### SUBS
sub sec_to_hms {
my ($s) = @_;
return sprintf(
"Duration: %02dh%02dm%02ds (%.3f ms)",
int( $s / ( 60 * 60 ) ),
( $s / 60 ) % 60,
$s % 60, $s * 1000
);
}
80 lines [ Plain text ] [ ^Top ]
#! /usr/bin/env perl
use Modern::Perl '2015';
# useful modules
use Test::More;
use Time::HiRes qw/gettimeofday tv_interval/;
sub sec_to_hms;
my $start_time = [gettimeofday];
#### 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 $template = shift @input;
shift @input;
my %rules;
for my $line (@input) {
if ( $line =~ m/(.*) -> (.*)/ ) {
$rules{$1} = $2;
}
}
my $step = 1;
my @initial = split( "", $template );
my $LIMIT = 10;
while ( $step <= $LIMIT ) {
my @next;
my $idx = 0;
while ( $idx < $#initial ) {
my $pair = $initial[$idx] . $initial[ $idx + 1 ];
if ( $rules{$pair} ) {
push @next, ( $initial[$idx], $rules{$pair} );
$idx += 1;
}
else {
$idx++;
}
}
push @next, $initial[-1];
@initial = @next;
$step++;
}
my %freq;
for my $c (@initial) {
$freq{$c}++;
}
my @res = ( sort { $freq{$b} <=> $freq{$a} } keys %freq );
my ( $most, $least ) = ( $freq{ $res[0] }, $freq{ $res[-1] } );
my $ans1 = $most - $least;
### FINALIZE - tests and run time
is( $ans1, 2321, "Part 1: $ans1" );
done_testing();
say sec_to_hms( tv_interval($start_time) );
### SUBS
sub sec_to_hms {
my ($s) = @_;
return sprintf(
"Duration: %02dh%02dm%02ds (%.3f ms)",
int( $s / ( 60 * 60 ) ),
( $s / 60 ) % 60,
$s % 60, $s * 1000
);
}
57 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#! /usr/bin/env perl
use Modern::Perl '2015';
# useful modules
use List::Util qw/sum max/;
use Data::Dump qw/dump/;
use Test::More;
use Time::HiRes qw/gettimeofday tv_interval/;
use Array::Heap::PriorityQueue::Numeric;
sub sec_to_hms;
my $start_time = [gettimeofday];
#### 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 %ans;
sub dump_map;
my $r = 0;
my $max_c = 0;
for my $line (@input) {
my $c = 0;
for my $n ( split( '', $line ) ) {
$Map->{$r}{$c} = $n;
$c++;
}
$max_c = $c;
$r++;
}
my $max_r = max( keys %$Map ) + 1;
# build bigger map for part 2
# extend down
for my $r ( $max_r .. 5 * $max_r - 1 ) {
for my $c ( 0 .. $max_c - 1 ) {
my $new_val = $Map->{ $r - $max_r }{$c} + 1;
$new_val = 1 if $new_val > 9;
$Map->{$r}{$c} = $new_val;
}
}
# extend to the right
for my $r ( sort { $a <=> $b } keys %$Map ) {
for my $c ( $max_c .. 5 * $max_c - 1 ) {
my $new_val = $Map->{$r}{ $c - $max_c } + 1;
$new_val = 1 if $new_val > 9;
$Map->{$r}{$c} = $new_val;
}
}
my $goal = $testing ? [ 49, 49 ] : [ 499, 499 ];
my $pq = Array::Heap::PriorityQueue::Numeric->new();
$pq->add( [ 0, 0 ], 0 );
my $came_from;
my $cost_so_far;
$cost_so_far->{0}{0} = 0;
SEARCH:
while ( $pq->peek ) {
my $cur = $pq->get();
if ( $cur->[0] == $goal->[0] and $cur->[1] == $goal->[1] ) {
$ans{2} = $cost_so_far->{ $goal->[0] }{ $goal->[1] };
last SEARCH;
}
# try to move
for my $d ( [ -1, 0 ], [ 0, -1 ], [ 1, 0 ], [ 0, 1 ] ) {
my $dr = $cur->[0] + $d->[0];
my $dc = $cur->[1] + $d->[1];
next unless exists $Map->{$dr}{$dc};
my $new_cost
= $cost_so_far->{ $cur->[0] }{ $cur->[1] } + $Map->{$dr}{$dc};
if ( !exists $cost_so_far->{$dr}{$dc}
or $new_cost < $cost_so_far->{$dr}{$dc} )
{
$cost_so_far->{$dr}{$dc} = $new_cost;
$pq->add( [ $dr, $dc ], $new_cost );
}
}
}
### FINALIZE - tests and run time
is( $ans{2}, 2800, "Part 2: " . $ans{2} );
done_testing();
say sec_to_hms( tv_interval($start_time) );
### SUBS
sub sec_to_hms {
my ($s) = @_;
return sprintf(
"Duration: %02dh%02dm%02ds (%.3f ms)",
int( $s / ( 60 * 60 ) ),
( $s / 60 ) % 60,
$s % 60, $s * 1000
);
}
sub dump_map {
for my $r ( sort { $a <=> $b } keys %$Map ) {
for my $c ( sort { $a <=> $b } keys %{ $Map->{$r} } ) {
print $Map->{$r}{$c};
}
print "\n";
}
}
90 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#! /usr/bin/env perl
use Modern::Perl '2015';
# useful modules
use List::Util qw/sum min max product all/;
use Test::More;
use Time::HiRes qw/gettimeofday tv_interval/;
sub sec_to_hms;
no warnings 'portable';
my $start_time = [gettimeofday];
#### 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, $_; }
sub decode;
my %actions = (
4 => 'literal number',
0 => sub { sum @_ },
1 => sub { product @_ },
2 => sub { min @_ },
3 => sub { max @_ },
5 => sub { $_[0] > $_[1] ? 1 : 0 },
6 => sub { $_[0] < $_[1] ? 1 : 0 },
7 => sub { $_[0] == $_[1] ? 1 : 0 },
);
my @test_p1 = (
'D2FE28', '38006F45291200',
'EE00D40C823060', '8A004A801A8002F478',
'620080001611562C8802118E34', 'C0015000016115A2E0802F182340',
'A0016C880162017C3686B18A3D4780',
);
my @ans_p1 = ( 6, 9, 14, 16, 12, 23, 31 );
my @test_p2
= qw/C200B40A82 04005AC33890 880086C3E88112 CE00C43D881120 D8005AC2A8F0 F600BC2D8F 9C005AC2F8F0 9C0141080250320F1802104A08/;
my @ans_p2 = qw/3 54 7 9 1 0 0 1/;
### CODE
my $version_sum;
my $idx = 0;
say "==> Part 1 <==";
for my $line ( @test_p1, $input[0] ) {
chomp $line;
$version_sum = 0;
my $B;
for ( split( '', $line ) ) {
push @$B, split( '', sprintf( "%04b", hex($_) ) );
}
my @res;
push( @res, decode($B) );
if ( $idx < scalar @ans_p1 ) {
is( $version_sum, $ans_p1[$idx], "Test $idx: ok" );
}
else {
is( $version_sum, 866, "Part 1: $version_sum" );
}
$idx++;
}
say "==> Part 2 <==";
$idx = 0;
for my $line ( @test_p2, $input[0] ) {
chomp $line;
$version_sum = 0;
my $B;
for ( split( '', $line ) ) {
push @$B, split( '', sprintf( "%04b", hex($_) ) );
}
my @res;
decode( $B, 0, \@res );
if ( $idx < scalar @ans_p2 ) {
is( $res[0], $ans_p2[$idx], "Test $idx: ok" );
}
else {
is( $res[0], 1392637195518, "Part 2: $res[0]" );
}
$idx++;
}
### FINALIZE - tests and run time
done_testing();
say sec_to_hms( tv_interval($start_time) );
### SUBS
sub decode {
my ( $in, $reps, $vals ) = @_;
my $visits = 0;
while (@$in) {
last if all { $_ == 0 } @$in;
last if $reps and $reps == $visits;
my $version = oct( '0b' . join( '', splice( @$in, 0, 3 ) ) );
$version_sum += $version;
my $id = oct( '0b' . join( '', splice( @$in, 0, 3 ) ) );
$visits++;
if ( $id == 4 ) {
# literal number
my $next = 1;
my @num;
while ($next) {
my @chunk = splice( @$in, 0, 5 );
$next = shift @chunk;
push @num, @chunk;
}
push @$vals, oct( '0b' . join( '', @num ) );
}
else {
my @subvals;
my $lenid = shift @$in;
if ($lenid) { # 11
my $n = oct( '0b' . join( '', splice( @$in, 0, 11 ) ) );
decode( $in, $n, \@subvals );
}
else { # 15
my $len = oct( '0b' . join( '', splice( @$in, 0, 15 ) ) );
my $sub = [ splice( @$in, 0, $len ) ];
decode( $sub, 0, \@subvals );
}
push @$vals, $actions{$id}->(@subvals);
}
}
return $in;
}
sub sec_to_hms {
my ($s) = @_;
return sprintf(
"Duration: %02dh%02dm%02ds (%.3f ms)",
int( $s / ( 60 * 60 ) ),
( $s / 60 ) % 60,
$s % 60, $s * 1000
);
}
121 lines [ Plain text ] [ ^Top ]
#! /usr/bin/env perl
use Modern::Perl '2015';
# useful modules
use List::Util qw/sum min max product/;
use Data::Dump qw/dump/;
use Test::More;
use Time::HiRes qw/gettimeofday tv_interval/;
sub sec_to_hms;
no warnings 'portable';
my $start_time = [gettimeofday];
#### 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, $_; }
sub decode;
my @test_p1 = (
'D2FE28', '38006F45291200',
'EE00D40C823060', '8A004A801A8002F478',
'620080001611562C8802118E34', 'C0015000016115A2E0802F182340',
'A0016C880162017C3686B18A3D4780',
);
my @ans_p1 = ( 6, 9, 14, 16, 12, 23, 31 );
### CODE
my $version_sum;
my $idx = 0;
for my $line ( @test_p1, $input[0] ) {
chomp $line;
say $line if $debug;
$version_sum = 0;
my $B;
for ( split( '', $line ) ) {
push @$B, split( '', sprintf( "%04b", hex($_) ) );
}
my @res;
push( @res, decode($B) );
if ( $idx < scalar @ans_p1 ) {
is( $version_sum, $ans_p1[$idx], "Test $ans_p1[$idx]: ok" );
}
else {
is( $version_sum, 866, "Part 1: $version_sum" );
}
$idx++;
}
### FINALIZE - tests and run time
# is();
done_testing();
say sec_to_hms( tv_interval($start_time) );
### SUBS
sub decode {
my ($in) = @_;
my $res;
while (@$in) {
my $version = oct( '0b' . join( '', splice( @$in, 0, 3 ) ) );
$version_sum += $version;
my $id = oct( '0b' . join( '', splice( @$in, 0, 3 ) ) );
say "(V: $version I: $id)" if $debug;
if ( $id == 4 ) {
# literal number
my $next = 1;
my @num;
while ($next) {
my @chunk = splice( @$in, 0, 5 );
$next = shift @chunk;
push @num, @chunk;
}
$res = oct( '0b' . join( '', @num ) );
say "(Num: $res)" if $debug;
}
else {
my @vals;
my $lenid = shift @$in;
if ($lenid) { # 11
my $n = oct( '0b' . join( '', splice( @$in, 0, 11 ) ) );
say "(Rep: $n)" if $debug;
for ( 1 .. $n ) {
push @vals, decode($in);
}
}
else { # 15
my $len = oct( '0b' . join( '', splice( @$in, 0, 15 ) ) );
say "(L: $len)" if $debug;
my $sub = [ splice( @$in, 0, $len ) ];
say " ", join( '', @$sub ) if $debug;
push @vals, decode($sub);
}
}
}
return $res;
}
sub sec_to_hms {
my ($s) = @_;
return sprintf(
"Duration: %02dh%02dm%02ds (%.3f ms)",
int( $s / ( 60 * 60 ) ),
( $s / 60 ) % 60,
$s % 60, $s * 1000
);
}
94 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#! /usr/bin/env perl
use Modern::Perl '2015';
# useful modules
use Test::More;
use Time::HiRes qw/gettimeofday tv_interval/;
sub sec_to_hms;
my $start_time = [gettimeofday];
#### INIT - load input data from file into array
my $testing = 0;
my @input;
my %ans;
my $file = $testing ? 'test.txt' : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }
### CODE
my $target;
if ( $input[0] =~ m/x=(\d+)..(\d+), y=-(\d+)..-(\d+)/ ) {
$target = {
x => { min => $1, max => $2 },
y => { min => $3 * (-1), max => $4 * (-1) }
};
}
# part 1: only need to consider y. Each y(t) is a triangular number,
# so y(t) = t*(t+1)/2. If we launch upwards we will have v=0 at the
# apex. The next y's after that will have to cross the x-axis and hit
# the target box. So the highest point will be y_min*(y_min+1)/2
$ans{1} = $target->{y}{min} * ( $target->{y}{min} + 1 ) / 2;
# part 2: just brute force the solution space
my @hits;
my $count = 0;
for my $vx ( 0 .. $target->{x}{max} )
{ # any faster and we overshoot at step 1
for my $vy ( $target->{y}{min} .. 105 )
{ # upper range found by inspection
my $v = { x => $vx, y => $vy };
if ( hit($v) ) {
push @hits, $v;
}
}
}
$ans{2} = scalar @hits;
is( $ans{1}, 5565, "Part 1: " . $ans{1} );
is( $ans{2}, 2118, "Part 2: " . $ans{2} );
### FINALIZE - tests and run time
# is();
done_testing();
say sec_to_hms( tv_interval($start_time) );
### SUBS
sub hit {
my ($v) = @_;
my ( $x, $y ) = ( 0, 0 );
my $hit = 0;
my $max_y = $target->{y}{min};
while ( $y > $target->{y}{min} and $x <= $target->{x}{max} ) {
$x = $x + $v->{x};
$y = $y + $v->{y};
if ( $x >= $target->{x}{min}
and $x <= $target->{x}{max}
and $y <= $target->{y}{max}
and $y >= $target->{y}{min} )
{
$hit = 1;
last;
}
if ( $v->{x} > 0 ) {
$v->{x}--;
}
elsif ( $v->{x} < 0 ) {
$v->{x}++;
}
$v->{y}--;
}
if ($hit) {
return $v;
}
else {
return undef;
}
}
sub sec_to_hms {
my ($s) = @_;
return sprintf(
"Duration: %02dh%02dm%02ds (%.3f ms)",
int( $s / ( 60 * 60 ) ),
( $s / 60 ) % 60,
$s % 60, $s * 1000
);
}
76 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#! /usr/bin/env perl
use Modern::Perl '2015';
# useful modules
use List::Util qw/sum any all/;
use Data::Dump qw/dump/;
use POSIX qw [ceil floor];
use Test::More;
use Time::HiRes qw/gettimeofday tv_interval/;
sub sec_to_hms;
my $start_time = [gettimeofday];
#### 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 explode;
sub mysplit;
sub reduce;
sub add;
sub dump_snf;
sub magnitude;
my @homework;
my %ans;
for my $line (@input) {
push @homework, [ split( '', $line ) ];
}
# part 1
my $t1 = $homework[0];
my $sum;
for my $idx ( 1 .. $#homework ) {
my $t2 = $homework[$idx];
$sum = add( $t1, $t2 );
$t1 = $sum;
}
$ans{1} = magnitude($sum);
is( $ans{1}, 4417, "Part 1: $ans{1}" );
# part 2
my $max_mag = 0;
for my $i ( keys @homework ) {
say "==> $i" if $i%10==0;
for my $j ( keys @homework ) {
next if $i == $j;
my ( $mag1, $mag2 ) = (
magnitude( add( $homework[$i], $homework[$j] ) ),
magnitude( add( $homework[$i], $homework[$j] ) )
);
$max_mag = $mag1 if $mag1 > $max_mag;
$max_mag = $mag2 if $mag2 > $max_mag;
}
}
$ans{2} = $max_mag;
is( $ans{2}, 4796, "Part 2: $ans{2}" );
### FINALIZE - tests and run time
done_testing();
say sec_to_hms( tv_interval($start_time) );
### SUBS
sub sec_to_hms {
my ($s) = @_;
return sprintf(
"Duration: %02dh%02dm%02ds (%.3f ms)",
int( $s / ( 60 * 60 ) ), ( $s / 60 ) % 60, $s % 60, $s * 1000 );
}
sub explode {
my ($snf) = @_;
my $depth = 0;
for my $idx ( keys @$snf ) {
my $part = $snf->[$idx];
if ( $part eq '[' ) {
$depth++;
next;
}
if ( $part eq ']' ) {
$depth--;
next;
}
next if $part eq ',';
if ( $depth > 4 ) {
my $left = $part;
my $i = $idx;
my $right = $snf->[ $i + 2 ];
my $j = $i;
next unless all { $_ =~ /\d+/ } ( $left, $right );
say join( '', @{$snf}[ $i - 1 .. $i + 3 ] ) if $debug;
while ( --$j >= 0 ) {
next if ( any { $snf->[$j] eq $_ } ( '[', ',', ']' ) );
$snf->[$j] += $left;
last;
}
my $k = $i + 2;
while ( ++$k < @$snf ) {
next if ( any { $snf->[$k] eq $_ } ( '[', ',', ']' ) );
$snf->[$k] += $right;
last;
}
splice @$snf, $i - 1, 5, 0;
return $snf;
}
}
return undef;
}
sub mysplit {
my ($snf) = @_;
for my $idx ( keys @$snf ) {
my $part = $snf->[$idx];
next
if ( any { $snf->[$idx] eq $_ } ( '[', ',', ']' ) or $part < 10 );
splice @$snf, $idx, 1,
(
'[', floor( $snf->[$idx] / 2 ),
',', ceil( $snf->[$idx] / 2 ), ']'
);
return $snf;
}
return undef;
}
sub reduce {
my ($snf) = @_;
my @stack;
push @stack, 'spl';
push @stack, 'exp';
while (@stack) {
my $act = pop @stack;
my $res;
if ( $act eq 'exp' ) {
say "=> explode" if $debug;
$res = explode($snf);
if ($res) {
$snf = $res;
push @stack, 'exp';
}
dump_snf($snf) if $debug;
}
elsif ( $act eq 'spl' ) {
say "==> split" if $debug;
$res = mysplit($snf);
if ($res) {
$snf = $res;
push @stack, 'spl';
push @stack, 'exp';
}
dump_snf($snf) if $debug;
}
}
return $snf;
}
sub add { # input: two snailfish numbers
my ( $t1, $t2 ) = @_;
my $snf = [ '[', @$t1, ',', @$t2, ']' ];
dump_snf($snf) if $debug;
my $res = reduce($snf);
return $res;
}
sub dump_snf {
my ($snf) = @_;
my @arr;
my $depth = 0;
for my $idx ( keys @$snf ) {
my $part = $snf->[$idx];
print $part;
if ( $part eq '[' ) {
$depth++;
$arr[$idx] = $depth;
next;
}
if ( $part eq ']' ) {
$depth--;
$arr[$idx] = $depth;
next;
}
}
print "\n";
for my $idx ( keys @$snf ) {
print $arr[$idx] ? $arr[$idx] : '.';
}
print "\n";
}
sub magnitude {
no warnings 'uninitialized';
my ($snf) = @_;
while ( scalar @$snf > 2 ) {
for my $idx ( keys @$snf ) {
if ( $snf->[$idx] eq '['
and $snf->[ $idx + 1 ] =~ /\d+/
and $snf->[ $idx + 2 ] eq ','
and $snf->[ $idx + 3 ] =~ /\d+/
and $snf->[ $idx + 4 ] eq ']' )
{
my $mag = 3 * $snf->[ $idx + 1 ] + 2 * $snf->[ $idx + 3 ];
splice @$snf, $idx, 5, $mag;
}
}
}
return $snf->[0];
}
189 lines [ Plain text ] [ ^Top ]
#! /usr/bin/env perl
use Modern::Perl '2015';
# useful modules
use List::Util qw/sum any all/;
use Data::Dump qw/dump/;
use POSIX qw [ceil floor];
use Test::More;
use Time::HiRes qw/gettimeofday tv_interval/;
sub sec_to_hms;
my $start_time = [gettimeofday];
#### INIT - load input data from file into array
my $testing = 1;
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 explode;
sub mysplit;
sub reduce;
sub add;
sub dump_snf;
sub magnitude;
# insert test cases here
my @test_explode = ('[[[[[9,8],1],2],3],4]',
'[7,[6,[5,[4,[3,2]]]]]',
'[[6,[5,[4,[3,2]]]],1]',
'[[3,[2,[1,[7,3]]]],[6,[5,[4,[3,2]]]]]',
'[[3,[2,[8,0]]],[9,[5,[4,[3,2]]]]]');
my @ans_explode = ('[[[[0,9],2],3],4]',
'[7,[6,[5,[7,0]]]]',
'[[6,[5,[7,0]]],3]',
'[[3,[2,[8,0]]],[9,[5,[4,[3,2]]]]]',
'[[3,[2,[8,0]]],[9,[5,[7,0]]]]' );
for my $idx (keys @test_explode) {
my $str = $test_explode[$idx];
my $res = explode( [split('', $str)]);
is( join('',@$res), $ans_explode[$idx], "explode ok");
}
my $str ='[[[[[4,3],4],4],[7,[[8,4],9]]],[1,1]]';
my $snf = [split('', $str)];
my $res = reduce($snf);
is(join('',@$res),'[[[[0,7],4],[[7,8],[6,0]]],[8,1]]', "sum 1 ok");
my @arr = ('[[[[4,3],4],4],[7,[[8,4],9]]]','[1,1]');
$res = add( $arr[0], $arr[1]);
is(join('',@$res),'[[[[0,7],4],[[7,8],[6,0]]],[8,1]]', "sum 2 ok");
my @sum_ans = ('[[[[1,1],[2,2]],[3,3]],[4,4]]','[[[[3,0],[5,3]],[4,4]],[5,5]]','[[[[5,0],[7,4]],[5,5]],[6,6]]');
for my $end (4..6) {
my @list;
for my $i (1..$end) {
push @list, "[$i,$i]";
}
my $t1 = shift @list;
my $res;
while (@list) {
my $t2 = shift @list;
$res = add( $t1, $t2);
$t1 = join('',@$res);
}
is( $t1, $sum_ans[$end-4], "add example ok");
}
my @long;
while () {
chomp;
push @long, $_;
}
my $t1 = shift @long;
$res = undef;
while (@long) {
my $t2 = shift @long;
$res = add( $t1, $t2 );
$t1 = join('',@$res);
}
is(join('',@$res), '[[[[8,7],[7,7]],[[8,6],[7,7]]],[[[0,7],[6,6]],[8,7]]]', "long example ok");
my %mag_tests =('[[1,2],[[3,4],5]]' => 143,
'[[[[0,7],4],[[7,8],[6,0]]],[8,1]]' => 1384,
'[[[[1,1],[2,2]],[3,3]],[4,4]]' => 445,
'[[[[3,0],[5,3]],[4,4]],[5,5]]' => 791,
'[[[[5,0],[7,4]],[5,5]],[6,6]]' => 1137,
'[[[[8,7],[7,7]],[[8,6],[7,7]]],[[[0,7],[6,6]],[8,7]]]' => 3488);
for my $m (sort keys %mag_tests) {
my $snf = [split('',$m)];
my $res = magnitude( $snf);
is( $res, $mag_tests{$m}, "magnitude $mag_tests{$m}");
}
$t1 = shift @input;
$res = undef;
while (@input) {
my $t2 = shift @input;
$res = add( $t1, $t2 );
$t1 = join('', @$res);
}
### FINALIZE - tests and run time
is(magnitude( $res ),4140 ,"final test");
done_testing();
say sec_to_hms(tv_interval($start_time));
### SUBS
sub sec_to_hms {
my ($s) = @_;
return sprintf("Duration: %02dh%02dm%02ds (%.3f ms)",
int( $s / ( 60 * 60 ) ), ( $s / 60 ) % 60, $s % 60, $s * 1000 );
}
sub explode {
my ( $snf ) = @_;
my $depth= 0;
for my $idx (keys @$snf) {
my $part = $snf->[$idx];
if ($part eq '[' ) {
$depth++;
next;
}
if ($part eq ']') {
$depth--;
next;
}
next if $part eq ',';
if ($depth>4) {
my $left = $part;
my $i= $idx;
my $right = $snf->[$i+2];
my $j = $i;
next unless all { $_ =~ /\d+/} ($left, $right);
say join('', @{$snf}[$i-1..$i+3]) if $debug;
while (--$j >= 0) {
next if ( any {$snf->[$j] eq $_} ('[',',',']'));
$snf->[$j] += $left;
last;
}
my $k = $i+2;
while (++$k < @$snf) {
next if (any {$snf->[$k] eq $_} ('[',',',']'));
$snf->[$k] += $right;
last;
}
splice @$snf, $i-1,5, 0;
return $snf;
}
}
return undef;
}
sub mysplit {
my ( $snf ) = @_;
for my $idx (keys @$snf) {
my $part = $snf->[$idx];
next if (any {$snf->[$idx] eq $_} ('[',',',']') or $part < 10);
splice @$snf, $idx, 1,('[',floor( $snf->[$idx]/2),',',ceil($snf->[$idx]/2), ']');
return $snf;
}
return undef;
}
sub reduce {
my ( $snf ) = @_;
my @stack;
push @stack, 'spl';
push @stack, 'exp';
while (@stack) {
my $act = pop @stack;
my $res;
if ($act eq 'exp') {
say "=> explode" if $debug;
$res = explode( $snf );
if ($res) {
$snf=$res;
push @stack, 'exp';
}
dump_snf( $snf ) if $debug;
} elsif ($act eq 'spl') {
say "==> split" if $debug;
$res = mysplit( $snf );
if ($res) {
$snf=$res;
push @stack, 'spl';
push @stack, 'exp';
}
dump_snf($snf) if $debug;
}
}
return $snf;
}
sub add { # input: two strings representing snailfish numbers
my ( $t1, $t2 ) = @_;
my $snf = [split('','['.$t1.','.$t2.']')];
dump_snf($snf) if $debug;
my $res = reduce( $snf);
return $res;
}
sub dump_snf {
my ( $snf ) = @_;
my @arr;
my $depth =0;
for my $idx (keys @$snf) {
my $part = $snf->[$idx];
print $part;
if ($part eq '[') {
$depth++;
$arr[$idx]=$depth;
next;
}
if ($part eq ']') {
$depth--;
$arr[$idx]=$depth;
next;
}
}
print "\n";
for my $idx (keys @$snf) {
print $arr[$idx]?$arr[$idx]:'.';
}
print "\n";
}
sub magnitude {
no warnings 'uninitialized';
my ( $snf ) = @_;
while (scalar @$snf >2) {
for my $idx (keys @$snf) {
if ($snf->[$idx] eq '[' and $snf->[$idx+1] =~ /\d+/ and $snf->[$idx+2] eq ',' and $snf->[$idx+3] =~ /\d+/ and $snf->[$idx+4] eq ']') {
my $mag = 3 * $snf->[$idx+1] + 2 * $snf->[$idx+3];
splice @$snf, $idx, 5, $mag;
}
}
}
return $snf->[0];
}
__DATA__
[[[0,[4,5]],[0,0]],[[[4,5],[2,6]],[9,5]]]
[7,[[[3,7],[4,3]],[[6,3],[8,8]]]]
[[2,[[0,8],[3,4]]],[[[6,7],1],[7,[1,6]]]]
[[[[2,4],7],[6,[0,5]]],[[[6,8],[2,8]],[[2,1],[4,5]]]]
[7,[5,[[3,8],[1,4]]]]
[[2,[2,2]],[8,[8,1]]]
[2,9]
[1,[[[9,3],9],[[9,0],[0,7]]]]
[[[5,[7,4]],7],1]
[[[[4,2],2],6],[8,7]]
228 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#! /usr/bin/env perl
use Modern::Perl '2015';
# useful modules
use List::Util qw/sum/;
use Data::Dump qw/dump/;
use Test::More;
use Time::HiRes qw/gettimeofday tv_interval/;
sub sec_to_hms;
my $start_time = [gettimeofday];
#### 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, $_; }
my %data;
my $scanner_id = undef;
for my $line (@input) {
if ( $line =~ m/^--- scanner (\d+) ---$/ ) {
$scanner_id = $1;
}
else {
my $coord = [ split( /,/, $line ) ];
push @{ $data{$scanner_id} }, $coord
if defined $scanner_id and scalar @$coord;
}
}
# load all tranformation matrices (copied from this site:
# https://www.euclideanspace.com/maths/algebra/matrix/transforms/examples/index.htm)
my $transforms;
my @list;
while () {
chomp;
s/\r//gm;
push @list, $_;
}
while (@list) {
# grab 3 lines + empty
my $m;
for ( 1 .. 3 ) {
push @$m, [ split( /\s+/, shift @list ) ];
}
push @$transforms, $m;
shift @list;
}
my $seen;
my @check = ( { id => 0, beacons => $data{0}, pos => "0,0,0" } );
my @res;
while (@check) {
# this rigmarole is to avoid modifying datastructures in the loop
my $next = shift @check;
my $s1 = $next->{id};
my $beacons = $next->{beacons};
push @res, $next;
for my $s2 ( sort { $a <=> $b } keys %data ) {
next if $s1 == $s2;
if ( $seen->{$s1}{$s2} or $seen->{$s2}{$s1} ) {
say "$s1 and $s2 have been compared, skipping" if $debug;
next;
}
$seen->{$s1}{$s2}++;
$seen->{$s2}{$s1}++;
say "comp $s1 $s2";
# generate all 24 possible rotations for each vector
my $rotations;
for my $v ( @{ $data{$s2} } ) {
push @$rotations, rotate_vec($v);
}
my $matches;
# compare each rotation to the vector in the "known" set,
# taking differences for each axis
for my $R (@$rotations) {
my $rot = 0;
for my $c (@$R) {
for my $v (@$beacons) {
$matches->{$rot}{x}{ $v->[0] - $c->[0] }++;
$matches->{$rot}{y}{ $v->[1] - $c->[1] }++;
$matches->{$rot}{z}{ $v->[2] - $c->[2] }++;
}
$rot++;
}
}
# if there is an overlap, there should be a "spike" of
# matching differences, and the rotation that has these
# differences in all three axes is the one we want. The
# differences are the x,y,z offsets for the scanner
my $summary;
for my $rot ( sort { $a <=> $b } keys %{$matches} ) {
for my $axis (qw/x y z/) {
for my $d ( keys %{ $matches->{$rot}{$axis} } ) {
$summary->{$rot}{$axis} = $d
if $matches->{$rot}{$axis}{$d} >= 12;
}
}
}
# dump $summary if $debug;
my ($sought) = grep {
$summary->{$_}{x}
and $summary->{$_}{y}
and $summary->{$_}{z}
} keys %$summary;
if ( !$sought ) {
say "no match, skipping to next" if $debug;
next;
}
say "$s2 <-> $s1: $sought" if $debug;
# transform the coordinates in the current set to the correct
# offset and orientation, and push it to the array of
# corrected sets to compare to others
my $rotated;
for my $v (@$rotations) {
push @$rotated,
[
$v->[$sought][0] + $summary->{$sought}{x},
$v->[$sought][1] + $summary->{$sought}{y},
$v->[$sought][2] + $summary->{$sought}{z}
];
}
my $scanner_pos
= join( ',', map { $summary->{$sought}{$_} } qw/x y z/ );
push @check, { id => $s2, beacons => $rotated, pos => $scanner_pos };
}
}
# gather all corrected beacons and count them
my %all_beacons;
for my $sc (@res) {
for my $v ( @{ $sc->{beacons} } ) {
my $str = join( ',', @$v );
$all_beacons{$str}++;
}
}
# calculate Manhattan distance between scanners
my $max_dist = 0;
sub manhattan;
for my $set1 (@res) {
for my $set2 (@res) {
next if $set1->{id} == $set2->{id};
my $d = manhattan( $set1->{pos}, $set2->{pos} );
$max_dist = $d if $d > $max_dist;
}
}
### FINALIZE - tests and run time
is( scalar keys %all_beacons, 315, "Part 1: " . scalar keys %all_beacons );
is( $max_dist, 13192, "Part 2: $max_dist" );
done_testing();
say sec_to_hms( tv_interval($start_time) );
### SUBS
sub sec_to_hms {
my ($s) = @_;
return sprintf(
"Duration: %02dh%02dm%02ds (%.3f ms)",
int( $s / ( 60 * 60 ) ), ( $s / 60 ) % 60, $s % 60, $s * 1000 );
}
sub rotate_vec { # given a 3 element arrayref, return all 24 rotations
my ($v) = @_;
my $res;
for my $m (@$transforms) {
push @$res,
[
$m->[0][0] * $v->[0] + $m->[0][1] * $v->[1] + $m->[0][2] * $v->[2],
$m->[1][0] * $v->[0] + $m->[1][1] * $v->[1] + $m->[1][2] * $v->[2],
$m->[2][0] * $v->[0] + $m->[2][1] * $v->[1] + $m->[2][2] * $v->[2]
];
}
return $res;
}
sub manhattan {
my ( $p1, $p2 ) = @_;
my @p1 = split( ',', $p1 );
my @p2 = split( ',', $p2 );
return sum( map { abs( $p2[$_] - $p1[$_] ) } ( 0 .. 2 ) );
}
__DATA__
1 0 0
0 1 0
0 0 1
1 0 0
0 0 -1
0 1 0
1 0 0
0 -1 0
0 0 -1
1 0 0
0 0 1
0 -1 0
0 -1 0
1 0 0
0 0 1
0 0 1
1 0 0
0 1 0
0 1 0
1 0 0
0 0 -1
0 0 -1
1 0 0
0 -1 0
-1 0 0
0 -1 0
0 0 1
-1 0 0
0 0 -1
0 -1 0
-1 0 0
0 1 0
0 0 -1
-1 0 0
0 0 1
0 1 0
0 1 0
-1 0 0
0 0 1
0 0 1
-1 0 0
0 -1 0
0 -1 0
-1 0 0
0 0 -1
0 0 -1
-1 0 0
0 1 0
0 0 -1
0 1 0
1 0 0
0 1 0
0 0 1
1 0 0
0 0 1
0 -1 0
1 0 0
0 -1 0
0 0 -1
1 0 0
0 0 -1
0 -1 0
-1 0 0
0 -1 0
0 0 1
-1 0 0
0 0 1
0 1 0
-1 0 0
0 1 0
0 0 -1
-1 0 0
237 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#! /usr/bin/env perl
use Modern::Perl '2015';
# useful modules
use List::Util qw/sum min max/;
use Test::More;
use Time::HiRes qw/gettimeofday tv_interval/;
sub sec_to_hms;
my $start_time = [gettimeofday];
#### 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 %ans;
my @rule = split( '', $input[0] );
my $Map;
sub count_map;
for my $r ( 2 .. $#input ) {
my $c = 0;
for my $p ( split( '', $input[$r] ) ) {
$Map->{ $r - 2 }{$c} = $p;
$c++;
}
}
# ENHANCE
for my $N ( 1 .. 50 ) {
my $newM;
# add a border around the map
my $min_r = min keys %$Map;
my $max_r = max keys %$Map;
my ( $min_c, $max_c ) = ( 10e6, -1 );
for my $r ( keys %$Map ) {
$min_c = min( keys %{ $Map->{$r} } )
if min( keys %{ $Map->{$r} } ) < $min_c;
$max_c = max( keys %{ $Map->{$r} } )
if max( keys %{ $Map->{$r} } ) > $max_c;
}
for my $r ( $min_r - 1 .. $max_r + 1 ) {
for my $c ( $min_c - 1 .. $max_c + 1 ) {
my $digit;
for my $d (
[ -1, -1 ], [ -1, 0 ], [ -1, 1 ],
[ 0, -1 ], [ 0, 0 ], [ 0, 1 ],
[ 1, -1 ], [ 1, 0 ], [ 1, 1 ]
)
{
my ( $rd, $cd ) = ( $r + $d->[0], $c + $d->[1] );
# This is the key issue. For my input, index 0 mean
# "light the pixel" while the last index mean "turn it
# off". So every second iteration the infinite outside
# "changes signs"
if ( !$Map->{$rd}{$cd} ) {
if ( $N % 2 == 0 ) {
$digit .= '1';
}
else {
$digit .= '0';
}
}
elsif ( $Map->{$rd}{$cd} eq '#' ) {
$digit .= '1';
}
elsif ( $Map->{$rd}{$cd} eq '.' ) {
$digit .= '0';
}
}
my $index = oct( '0b' . $digit );
$newM->{$r}{$c} = $rule[$index];
}
}
$Map = $newM;
$ans{1} = count_map if $N == 2;
}
$ans{2} = count_map;
### FINALIZE - tests and run time
is( $ans{1}, 5846, "Part 1: " . $ans{1} );
is( $ans{2}, 21149, "Part 2: " . $ans{2} );
done_testing();
say sec_to_hms( tv_interval($start_time) );
### SUBS
sub sec_to_hms {
my ($s) = @_;
return sprintf(
"Duration: %02dh%02dm%02ds (%.3f ms)",
int( $s / ( 60 * 60 ) ),
( $s / 60 ) % 60,
$s % 60, $s * 1000
);
}
sub count_map {
my $count = 0;
for my $r ( keys %$Map ) {
for my $c ( keys %{ $Map->{$r} } ) {
$count++ if $Map->{$r}{$c} eq '#';
}
}
return $count;
}
93 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#! /usr/bin/env perl
use Modern::Perl '2015';
# useful modules
use List::Util qw/sum any all min max/;
use Test::More;
use Memoize;
use Time::HiRes qw/gettimeofday tv_interval/;
sub sec_to_hms;
my $start_time = [gettimeofday];
#### INIT - load input data from file into array
my $testing = 0;
my $debug = 0;
my %ans;
my @input;
my $file = $testing ? 'test.txt' : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }
### CODE
my %players;
for my $idx ( 0, 1 ) {
$input[$idx] =~ m/^.*(\d+).*(\d+)$/;
$players{$1} = { pos => $2, score => 0 };
}
sub dump_players;
my $rolls = 0;
GAME:
while (1) {
# say "==> $rolls" if $debug;
for my $p ( 1, 2 ) {
my $moves;
for my $d ( 1 .. 3 ) {
$rolls++;
my $diceval = $rolls % 100;
$moves += $diceval == 0 ? 100 : $diceval;
}
my $target = ( $players{$p}->{pos} + $moves ) % 10;
$players{$p}->{score} += $target == 0 ? 10 : $target;
last GAME if $players{$p}->{score} >= 1000;
$players{$p}->{pos} = $target;
}
}
$ans{1} = $rolls * min( map { $players{$_}->{score} } 1, 2 );
sub ucount;
memoize 'ucount';
# reset position from input
for my $idx ( 0, 1 ) {
$input[$idx] =~ m/^.*(\d+).*(\d+)$/;
$players{$1} = { pos => $2, score => 0 };
}
$ans{2} = max( ucount( 3, $players{1}->{pos}, $players{2}->{pos}, 0, 0 ) );
### FINALIZE - tests and run time
is( $ans{1}, 989352, "Part 1: " . $ans{1} );
is( $ans{2}, 430229563871565, "Part 2: " . $ans{2} );
done_testing();
say sec_to_hms( tv_interval($start_time) );
### SUBS
sub sec_to_hms {
my ($s) = @_;
return sprintf(
"Duration: %02dh%02dm%02ds (%.3f ms)",
int( $s / ( 60 * 60 ) ),
( $s / 60 ) % 60,
$s % 60, $s * 1000
);
}
sub dump_players {
for my $p ( 1, 2 ) {
printf(
"Player %d: pos %2d score %3d\n",
$p,
$players{$p}->{pos},
$players{$p}->{score}
);
}
}
sub ucount {
# Credit: /u/EffectivePriority986
# https://www.reddit.com/r/adventofcode/comments/rl6p8y/2021_day_21_solutions/hpe68q2/
# assume turn is for player 1
# in: rolls remaining for p1, p1 pos, p2 pos, p1 score, p2 score
my ( $r, $p1, $p2, $s1, $s2 ) = @_;
my ( $u1, $u2 );
say join( ' ', ( $r, $p1, $p2, $s1, $s2 ) ) if $debug;
unless ($r) {
$s1 += $p1;
if ( $s1 >= 21 ) {
return ( 1, 0 );
}
# switch players
( $u2, $u1 ) = ucount( 3, $p2, $p1, $s2, $s1 );
return ( $u1, $u2 );
}
for my $d ( 1 .. 3 ) {
my $np1 = $p1 + $d;
$np1 = $np1 % 10 || 10;
my ( $du1, $du2 ) = ucount( $r - 1, $np1, $p2, $s1, $s2 );
$u1 += $du1;
$u2 += $du2;
}
return ( $u1, $u2 );
}
94 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#! /usr/bin/env perl
use Modern::Perl '2015';
# useful modules
use List::Util qw/sum/;
use Data::Dump qw/dump/;
use Test::More;
use Time::HiRes qw/gettimeofday tv_interval/;
sub sec_to_hms;
my $start_time = [gettimeofday];
#### INIT - load input data from file into array
my $testing = 0;
my $debug = 0;
my @input;
my $file = $testing ? 'test.txt' : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }
### CODE
my @ranges;
for my $line (@input) {
if ( $line
=~ m/^(on|off) x=(-?\d+)\.\.(-?\d+),y=(-?\d+)\.\.(-?\d+),z=(-?\d+)\.\.(-?\d+)$/
)
{
push @ranges,
{ cmd => $1, x => [ $2, $3 ], y => [ $4, $5 ], z => [ $6, $7 ] };
}
else {
warn "can't parse: $line";
}
}
dump @ranges if $debug;
my $Map;
for my $r (@ranges) {
next
unless ( $r->{x}[0] >= -50
and $r->{x}[1] <= 50
and $r->{y}[0] >= -50
and $r->{y}[1] <= 50
and $r->{z}[0] >= -50
and $r->{z}[1] <= 50 );
dump $r if $debug;
for my $x ( $r->{x}[0] .. $r->{x}[1] ) {
for my $y ( $r->{y}[0] .. $r->{y}[1] ) {
for my $z ( $r->{z}[0] .. $r->{z}[1] ) {
if ( $r->{cmd} eq 'on' ) {
$Map->{$x}{$y}{$z} = 1;
}
else {
$Map->{$x}{$y}{$z} = 0;
}
}
}
}
}
my $count = 0;
for my $x ( -50 .. 50 ) {
for my $y ( -50 .. 50 ) {
for my $z ( -50 .. 50 ) {
$count++ if ( $Map->{$x}{$y}{$z} and $Map->{$x}{$y}{$z} == 1 );
}
}
}
### FINALIZE - tests and run time
is($count, 642125, "Part 1: $count");
done_testing();
say sec_to_hms( tv_interval($start_time) );
### SUBS
sub sec_to_hms {
my ($s) = @_;
return sprintf(
"Duration: %02dh%02dm%02ds (%.3f ms)",
int( $s / ( 60 * 60 ) ),
( $s / 60 ) % 60,
$s % 60, $s * 1000
);
}
70 lines [ Plain text ] [ ^Top ]
#! /usr/bin/env perl
use Modern::Perl '2015';
# useful modules
use List::Util qw/sum min max product/;
use Data::Dump qw/dump /;
use Test::More;
use Time::HiRes qw/gettimeofday tv_interval/;
sub sec_to_hms;
my $start_time = [gettimeofday];
#### INIT - load input data from file into array
my $testing = 0;
my $debug = 0;
my @input;
my $file = $testing ? 'test2.txt' : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }
### CODE
my @instr;
for my $line (@input) {
if ( $line =~
m/^(on|off) x=(-?\d+)\.\.(-?\d+),y=(-?\d+)\.\.(-?\d+),z=(-?\d+)\.\.(-?\d+)$/
) {
my $state = $1;
push @instr, { sign => $state eq 'on' ? 1 : -1,
x => { min => $2, max => $3 },
y => { min => $4, max => $5 },
z => { min => $6, max => $7 } };
}
else {
warn "can't parse: $line";
}
}
sub intersect;
sub get_intersection;
sub get_volume;
my @construct = shift @instr;
while (@instr) {
my $curr = shift @instr;
my @intersections;
for my $comp (@construct) {
if ( intersect( $curr, $comp ) ) {
push @intersections, get_intersection( $curr, $comp );
}
else {
next;
}
}
push @construct, @intersections;
if ( $curr->{sign} == 1 ) {
push @construct, $curr;
}
}
my $sum;
for my $b (@construct) {
$sum += get_volume($b) * $b->{sign};
}
say $sum;
### FINALIZE - tests and run time
is($sum, 1235164413198198, "Part 2: $sum");
done_testing();
say sec_to_hms( tv_interval($start_time) );
### SUBS
sub sec_to_hms {
my ($s) = @_;
return sprintf(
"Duration: %02dh%02dm%02ds (%.3f ms)",
int( $s / ( 60 * 60 ) ), ( $s / 60 ) % 60, $s % 60, $s * 1000 );
}
sub intersect {
my ( $b1, $b2 ) = @_;
if (($b1->{x}{min} <= $b2->{x}{max} and $b1->{x}{max} >= $b2->{x}{min}) and
($b1->{y}{min} <= $b2->{y}{max} and $b1->{y}{max} >= $b2->{y}{min}) and
( $b1->{z}{min} <= $b2->{z}{max} and $b1->{z}{max} >= $b2->{z}{min} ))
{
return 1;
}
else {
return 0;
}
}
sub get_intersection {
my ( $b1, $b2 ) = @_;
my $min_x = max( $b1->{x}{min}, $b2->{x}{min} );
my $max_x = min( $b1->{x}{max}, $b2->{x}{max} );
my $min_y = max( $b1->{y}{min}, $b2->{y}{min} );
my $max_y = min( $b1->{y}{max}, $b2->{y}{max} );
my $min_z = max( $b1->{z}{min}, $b2->{z}{min} );
my $max_z = min( $b1->{z}{max}, $b2->{z}{max} );
my $sign = $b1->{sign} * $b2->{sign};
if ( $b1->{sign} == $b2->{sign} ) {
$sign = -1 * $b1->{sign};
}
elsif ( $b1->{sign} == 1 and $b2->{sign} == -1 ) {
$sign = 1;
}
return {
sign => $sign,
x => { min => $min_x, max => $max_x },
y => { min => $min_y, max => $max_y },
z => { min => $min_z, max => $max_z },
};
}
sub get_volume {
my ($b) = @_;
return product( map { $b->{$_}{max} - $b->{$_}{min} + 1 } qw/ x y z / );
}
100 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#! /usr/bin/env perl
use Modern::Perl '2015';
# useful modules
use List::Util qw/sum none all/;
use Data::Dump qw/dump/;
use Test::More;
use Clone qw/clone/;
use Time::HiRes qw/gettimeofday tv_interval/;
use Array::Heap::PriorityQueue::Numeric;
sub sec_to_hms;
my $start_time = [gettimeofday];
#### INIT - load input data from file into array
my $testing = 0;
my $debug = 0;
my $part2 = shift @ARGV // 0;
my @input;
my $file = $testing ? 'test.txt' : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }
### CODE
my %amphipods = (
A => { name => 'amber', home_col => 3, cost => 1 },
B => { name => 'bronze', home_col => 5, cost => 10 },
C => { name => 'copper', home_col => 7, cost => 100 },
D => { name => 'desert', home_col => 9, cost => 1000 }
);
my $Map;
my $state;
my $pos;
my $R = 0;
my $C = 0;
if ($part2) {
splice( @input, 3, 0, ( ' #D#C#B#A#', ' #D#B#A#C#' ) );
}
for my $line (@input) {
$C = 0;
for my $t ( split( '', $line ) ) {
$Map->{$R}{$C} = $t;
if ( $t =~ m/[ABCD]/ ) {
$state->{$R}{$C} = $t;
$Map->{$R}{$C} = '.';
}
$C++;
}
$R++;
}
sub move_and_cost;
sub dump_map;
sub serialize_state;
sub deserialize_state;
my $st = serialize_state($state);
say "R=$R, C=$C" if $debug;
dump_map($st) if $debug;
dump $state if $debug;
my $goal_state = {
2 => { 3 => "A", 5 => "B", 7 => "C", 9 => "D" },
3 => { 3 => "A", 5 => "B", 7 => "C", 9 => "D" },
};
if ($part2) {
$goal_state->{4} = { 3 => "A", 5 => "B", 7 => "C", 9 => "D" };
$goal_state->{5} = { 3 => "A", 5 => "B", 7 => "C", 9 => "D" };
}
my $goal = serialize_state($goal_state);
my $pq = Array::Heap::PriorityQueue::Numeric->new();
$pq->add( $st, 0 );
my $cost_so_far;
$cost_so_far->{$st} = 0;
my $ans;
my $round=0;
SEARCH:
while ( $pq->peek ) {
my $cur = $pq->get();
if ( $cur eq $goal ) {
$ans = $cost_so_far->{$goal};
last SEARCH;
}
# generate new states
my $ret = move_and_cost($cur);
next unless $ret;
my @moves = @{$ret};
for my $move (@moves) {
my $new_cost = $cost_so_far->{$cur} + $move->{cost};
if ( !exists $cost_so_far->{ $move->{state} }
or $new_cost < $cost_so_far->{ $move->{state} } )
{
$cost_so_far->{ $move->{state} } = $new_cost;
$pq->add( $move->{state}, $new_cost );
}
}
$round++;
}
say "Rounds: $round";
### FINALIZE - tests and run time
if ( !$part2 ) {
if ($testing) {
is( $ans, 12521, "TESTING Part 1: $ans" );
}
else {
is( $ans, 18300, "Part 1: $ans" );
}
}
else {
is( $ans, 50190, "Part 2: $ans" );
}
done_testing();
say sec_to_hms( tv_interval($start_time) );
### SUBS
sub sec_to_hms {
my ($s) = @_;
return sprintf(
"Duration: %02dh%02dm%02ds (%.3f ms)",
int( $s / ( 60 * 60 ) ),
( $s / 60 ) % 60,
$s % 60, $s * 1000
);
}
sub move_and_cost {
# in: a state string
# out: a list of new state strings with costs
my ($str) = @_;
my $st = deserialize_state($str);
my $ret;
# scan the map, generate possible targets
my @to_try;
for my $r ( sort { $a <=> $b } keys %{$st} ) {
for my $c ( sort { $a <=> $b } keys %{ $st->{$r} } ) {
if ( $r == 1 ) { # hallway, valid targets are burrows
my $col = $amphipods{ $st->{$r}{$c} }->{home_col};
for my $lvl ( 2 .. $R - 2 )
{ # test every level in target burrow
if (none { exists $st->{$_}{$col} } ( 2 .. $lvl )
and all { exists $st->{$_}{$col}
and $st->{$_}{$col} eq
$st->{$r}{$c}}( $lvl + 1 .. $R - 2 )) {
push @to_try,
{ from => [ $r, $c ], to => [ $lvl, $col ] };
}
}
}
else { # we are starting from a burrow, see if we can move
my $col = $amphipods{ $st->{$r}{$c} }->{home_col};
if ($c == $col
and all { exists $st->{$_}{$c}
and $st->{$_}{$c} eq
$st->{$r}{$c}} ( $r + 1 .. $R - 2 )){
# already in a target state, don't move
next;
}
elsif ( $c == $col and exists $st->{ $r - 1 }{$c} )
{ #blocked from moving out
next;
}
my $can_goto_burrow = 0;
for my $lvl ( 2 .. $R - 2 )
{ # test every level in target burrow
if (none { exists $st->{$_}{$col} } ( 2 .. $lvl )
and all { exists $st->{$_}{$col}
and $st->{$_}{$col}
eq $st->{$r}{$c}}( $lvl + 1 .. $R - 2 )) {
push @to_try,
{ from => [ $r, $c ], to => [ $lvl, $col ] };
$can_goto_burrow++;
}
}
if ( !$can_goto_burrow ) { # we need to move to the corridor
for my $tc ( 1, 2, 4, 6, 8, 10, 11 ) {
next if exists $st->{1}{$tc}; # occupied
push @to_try,
{ from => [ $r, $c ], to => [ 1, $tc ] };
}
}
}
}
}
# use BFS to check paths
return undef unless @to_try;
for my $try (@to_try) {
my @queue = ( [ 0, $try->{from} ] );
my %seen;
my $shortest = undef;
BFS:
while (@queue) {
my $cur = shift @queue;
my $step = $cur->[0];
my ( $r, $c ) = @{ $cur->[1] };
next if exists $seen{$r}{$c};
$seen{$r}{$c}++;
$step += 1;
for my $d ( [ -1, 0 ], [ 1, 0 ], [ 0, -1 ], [ 0, 1 ] ) {
my ( $dr, $dc ) = ( $r + $d->[0], $c + $d->[1] );
if ( $Map->{$dr}{$dc} ne '.' or exists $st->{$dr}{$dc} ) {
next;
}
if ( $dr == $try->{to}[0] and $dc == $try->{to}[1] )
{ # reached target
$shortest = $step;
last BFS;
}
push @queue, [ $step, [ $dr, $dc ] ];
}
}
if ($shortest) { # we have found a path
# update the state for this move
my ( $rf, $cf ) = map { $try->{from}[$_] } ( 0, 1 );
my $type = $st->{$rf}{$cf};
my ( $rt, $ct ) = map { $try->{to}[$_] } ( 0, 1 );
my $cost = $shortest * $amphipods{$type}->{cost};
my $new_st = clone $st;
delete $new_st->{$rf}{$cf};
$new_st->{$rt}{$ct} = $type;
push @$ret, { cost => $cost, state => serialize_state($new_st) };
}
}
return $ret if $ret;
}
sub dump_map {
my ($str) = @_;
my $st = deserialize_state($str);
for my $r ( sort { $a <=> $b } keys %$Map ) {
for my $c ( sort { $a <=> $b } keys %{ $Map->{$r} } ) {
if ( $st->{$r}{$c} ) {
print $st->{$r}{$c};
}
else {
print $Map->{$r}{$c};
}
}
print "\n";
}
}
sub serialize_state {
my ($st) = @_;
my @ar;
for my $r ( sort { $a <=> $b } keys %$st ) {
for my $c ( sort { $a <=> $b } keys %{ $st->{$r} } ) {
push @ar, join( ',', $r, $c, $st->{$r}{$c} );
}
}
return join( ';', @ar );
}
sub deserialize_state {
my ($str) = @_;
my $st;
for my $el ( split( ';', $str ) ) {
my ( $r, $c, $t ) = split( ',', $el );
$st->{$r}{$c} = $t;
}
return $st;
}
243 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#! /usr/bin/env perl
use Modern::Perl '2015';
# useful modules
use Test::More;
use Time::HiRes qw/gettimeofday tv_interval/;
sub sec_to_hms;
my $start_time = [gettimeofday];
#### 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
=pod
For the solution, I followed the excellent explanation here:
L
(via comment L 148 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#! /usr/bin/env perl
use Modern::Perl '2015';
# useful modules
use Test::More;
use Time::HiRes qw/gettimeofday tv_interval/;
sub sec_to_hms;
my $start_time = [gettimeofday];
#### INIT - load input data from file into array
my $testing = 0;
my $debug = 0;
my @input;
my $file = $testing ? 'test.txt' : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; }
### CODE
my $Map;
sub dump_map;
my ( $R, $C ) = ( 0, 0 );
for my $line (@input) {
$C = 0;
for my $t ( split( '', $line ) ) {
$Map->{$R}{$C} = $t unless $t eq '.';
$C++;
}
$R++;
}
dump_map if $debug;
my $moved = 1;
my $steps = 0;
while ($moved) {
no warnings 'uninitialized';
say "==> $steps" if $steps % 25 == 0;
$moved = 0;
# east herd
my $seen;
for my $r ( sort { $a <=> $b } keys %$Map ) {
for my $c ( sort { $a <=> $b } keys %{ $Map->{$r} } ) {
if ( $Map->{$r}{$c} eq '>' and !defined $seen->{$r}{$c} ) {
my $dc = ( $c + 1 ) % $C;
if ( !defined $Map->{$r}{$dc}
and $Map->{$r}{$dc} ne '>'
and $Map->{$r}{$dc} ne 'v'
and !$seen->{$r}{$dc} )
{
delete $Map->{$r}{$c};
$seen->{$r}{$c}++;
$Map->{$r}{$dc} = '>';
$seen->{$r}{$dc}++;
$moved++;
}
}
}
}
# south herd
$seen = undef;
for my $r ( sort { $a <=> $b } keys %$Map ) {
for my $c ( sort { $a <=> $b } keys %{ $Map->{$r} } ) {
if ( $Map->{$r}{$c} eq 'v' and !defined $seen->{$r}{$c} ) {
my $dr = ( $r + 1 ) % $R;
if ( !defined $Map->{$dr}{$c}
and $Map->{$dr}{$c} ne '>'
and $Map->{$dr}{$c} ne 'v'
and !$seen->{$dr}{$c} )
{
delete $Map->{$r}{$c};
$seen->{$r}{$c}++;
$Map->{$dr}{$c} = 'v';
$seen->{$dr}{$c}++;
$moved++;
}
}
}
}
$steps++;
if ($debug) {
say "After $steps steps:";
dump_map;
print "\n";
}
}
#say $steps;
### FINALIZE - tests and run time
is( $steps, 305, "Part 1: $steps" );
done_testing();
say sec_to_hms( tv_interval($start_time) );
### SUBS
sub sec_to_hms {
my ($s) = @_;
return sprintf(
"Duration: %02dh%02dm%02ds (%.3f ms)",
int( $s / ( 60 * 60 ) ),
( $s / 60 ) % 60,
$s % 60, $s * 1000
);
}
sub dump_map {
for my $r ( 0 .. $R - 1 ) {
for my $c ( 0 .. $C - 1 ) {
print $Map->{$r}{$c} ? $Map->{$r}{$c} : '.';
}
print "\n";
}
}
96 lines [ Plain text ] [ ^Top ]
[ AoC problem link ] [ Discussion ].
#! /usr/bin/env perl
use Modern::Perl '2015';
# useful modules
use List::Util qw/sum/; # this module also has min, max, all etc
use Data::Dump qw/dump/; # simpler interface than Data::Dumper, does sorting
use Test::More; # simple testing harness
use Time::HiRes qw/gettimeofday tv_interval/;
sub sec_to_hms; # predeclare subs, but keep the definition at the end of the file
my $start_time = [gettimeofday]; # include reading and parsing in the total runtime
#### INIT - load input data from file into array
my $testing = 0; # set to true to get test data
my @input;
my $file = $testing ? 'test.txt' : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @input, $_; } # file content is now in @input
### CODE
# add your awesome solution here!
### FINALIZE - tests and run time
is($file, 'input.txt', "File that has been read: ".$file); # use this to verify your answers between runs
done_testing();
say sec_to_hms(tv_interval($start_time));
### SUBS
sub sec_to_hms {
my ($s) = @_;
return sprintf("Duration: %02dh%02dm%02ds (%.3f ms)",
int( $s / ( 60 * 60 ) ), ( $s / 60 ) % 60, $s % 60, $s * 1000 );
}
20 lines [ Plain text ] [ ^Top ]
Generated on Tue Jan 4 10:06:02 2022 UTC.