Advent of Code 2020 solutions

These are my solutions for this year's contest.

Main page on my blog.

If you want to copy these files, use the GitHub link.

All files covered by the UNLICENSE.

Table of contents

Advent of Code 2020 day 1 - Report Repair

[ AoC problem link ] [ Discussion ].

Day 01 - complete solution


#! /usr/bin/env perl
use Modern::Perl '2015';

# useful modules
use List::Util qw/sum/;
use Data::Dumper;
use Test::More tests => 2;

#### INIT - load input data from file into array

my $testing = 0;
my @file_contents;
my $file = $testing ? 'test.txt' : 'input.txt';
open( my $fh, '<', "$file" );

# in this case, we also load a hash where the values in the list are the keys

my $pos = 0;
my %index;
while (<$fh>) {
    chomp;
    s/\r//gm;

    # Add the list positions as an arrayref, in case there are doubles
    # and the order counts. It turns out it doesn't in my input, each
    # value is unique

    push @{ $index{$_} }, $pos;
    push @file_contents, $_;
    $pos++;
}

### CODE
my @invoice = @file_contents;
my %ans     = ();

OUTER:
for my $i ( 0 .. $#invoice ) {
    my $candidate = $invoice[$i];
    for my $j ( $i + 1 .. $#invoice ) {
        if ( $candidate + $invoice[$j] == 2020 ) {
            $ans{1} = $candidate * $invoice[$j];
        }
        next if ( $invoice[$j] > 2020 - $candidate );
        my $target = 2020 - ( $candidate + $invoice[$j] );
        if ( exists $index{$target} ) {
            my $part2 = $candidate * $invoice[$j] * $target;
            $ans{2} = $part2;
            last OUTER if scalar keys %ans == 2;
        }
    }
}
is( $ans{1}, 870331,    "Part 1: $ans{1}");
is( $ans{2}, 283025088, "Part 2: $ans{2}" );


40 lines [ Plain text ] [ ^Top ]

Advent of Code 2020 day 2 - Password Philosophy

[ AoC problem link ] [ Discussion ].

Day 02 - complete solution


#! /usr/bin/env perl
use Modern::Perl '2015';

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

### CODE
my %counts = ( 1 => 0, 2 => 0 );
foreach my $line (@file_contents) {
    my ( $min, $max, $req, $pwd ) = $line =~ m/^(\d+)-(\d+) (.): (.*)$/;

    my @ary = split( //, $pwd );
    my %freq;
    map { $freq{$_}++ } @ary;

    # this assignment is just to supress errors in the numeric
    # comparison in case the key doesn't exist
    my $res = $freq{$req} // 0;
    $counts{1}++ if ( ( $min <= $res ) and ( $res <= $max ) );

    # part 2

    my @pos = map { $ary[ $_ - 1 ] eq $req ? 1 : 0 } ( $min, $max );
    $counts{2}++ if ( $pos[0] ^ $pos[1] );

}
is( $counts{1}, 477, "Part 1: $counts{1}" );
is( $counts{2}, 686, "Part 2: $counts{2}" );


23 lines [ Plain text ] [ ^Top ]

Advent of Code 2020 day 3 - Toboggan Trajectory

[ AoC problem link ] [ Discussion ].

Day 03 - complete solution


#! /usr/bin/env perl
use Modern::Perl '2015';

# useful modules
use Test::More tests => 2;
#### INIT - load input data from file into the map we need
# We store the map by rows, and unpack it into columns when needed.
my $testing = 0;
my $Map;
my $file = $testing ? 'test.txt' : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) {
    chomp;
    s/\r//gm;
    push @{$Map}, $_;
}

### CODE
my $maxcol = scalar( split( //, $Map->[0] ) );
my @factors;

# coordinates: (row, column);
foreach my $move ( [ 1, 3 ],
		   [ 1, 1 ],
		   [ 1, 5 ],
		   [ 1, 7 ],
		   [ 2, 1 ] ) {
    my @pos = ( 0, 0 );
    my $hits = 0;

    while ($pos[0] < scalar @{$Map}) {
        # Check for tree.  We know we start in a clear space, so this
	# can be done before a move. Doing it this way avoids an
	# irritating check for definedness in the last row, at the
	# expense of this long commment

        my @treeline = split( //, $Map->[ $pos[0] ] );
        if ( $treeline[ $pos[1] ] eq '#' ) {
            $hits++;
        }
        $pos[0] += $move->[0];
	# The obvious way to account for the map extending to the
	# right is to use a modulus to "warp" back into the map we
	# have. So let's do that.
        $pos[1] = ( $pos[1] + $move->[1] ) % $maxcol;
    } 
    push @factors, $hits;
}

is( $factors[0], 223, "Part 1: $factors[0]" );
my $result = 1;
foreach my $f (@factors) {
    $result *= $f;
}
is( $result, 3517401300, "Part 2: $result" );

43 lines [ Plain text ] [ ^Top ]

Day 03 - alternative solution


#! /usr/bin/env perl
use Modern::Perl '2015';

# useful modules
use List::Util qw/any product/;
use Test::More tests => 2;
#### INIT - load input data from file into the map we need
my $testing = 0;
my $Map;
my $file = $testing ? 'test.txt' : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) {
    chomp;
    s/\r//gm;
    push @{$Map}, $_;
}

### CODE
my $maxcol = scalar( split( //, $Map->[0] ) );
my @factors;

# this string is to avoid definedness errors when we venture outside the map
my $empty = ('.') x $maxcol;

# slope => [right , down]
my @toboggans = ({slope=>[3,1]},{slope=>[1,1]},{slope=>[5,1]},
		 {slope=>[7,1]},{slope=>[1,2]},);

# initialize each toboggan
map { $_->{r} = 0; $_->{c} = 0; $_->{hits} = 0 } @toboggans;

# as long as there's a toboggan on the course...
while ( any { $_->{r} < scalar @$Map } @toboggans ) {

    # did anyone hit a tree?
    map {$_->{hits}+=substr($Map->[$_->{r}]//$empty, $_->{c}, 1) eq '#'?1:0
    } @toboggans;

    # move the toboggans
    map {$_->{r}+=$_->{slope}[1];
         $_->{c}=($_->{c}+$_->{slope}[0]) % $maxcol
    } @toboggans;

}
my $part1 = $toboggans[0]->{hits};
my $part2 = product( map { $_->{hits} } @toboggans );
is( $part1, 223,        "Part 1: $part1" );
is( $part2, 3517401300, "Part 2: $part2" );


31 lines [ Plain text ] [ ^Top ]

Advent of Code 2020 day 4 - Passport Processing

[ AoC problem link ] [ Discussion ].

Day 04 - complete solution


#! /usr/bin/env perl
use Modern::Perl '2015';

# useful modules
use Test::More tests => 2;
#### INIT - load input data from file into array
my $testing = 0;
my @file_contents;
my $file = $testing ? 'invalid.txt' : 'input.txt';
open( my $fh, '<', "$file" );
{
    # set the local IFS to an empty string to treat the input as paragraphs
    local $/ = "";
    while (<$fh>) {
        chomp;
        push @file_contents, $_;
    }
}
### CODE

my %rules = (
    byr => sub {
        return undef unless $_[0] =~ m/\d{4}/;
        return undef unless ( $_[0] >= 1920 and $_[0] <= 2002 );
    },
    iyr => sub {
        return undef unless $_[0] =~ m/\d{4}/;
        return undef unless ( $_[0] >= 2010 and $_[0] <= 2020 );
    },
    eyr => sub {
        return undef unless $_[0] =~ m/\d{4}/;
        return undef unless ( $_[0] >= 2020 and $_[0] <= 2030 );
    },
    hgt => sub {
        return undef unless $_[0] =~ m/(\d+)(..)/;
        if ( $2 eq 'cm' ) {
            return undef unless ( $1 >= 150 and $1 <= 193 );
        }
        elsif ( $2 eq 'in' ) {
            return undef unless ( $1 >= 59 and $1 <= 76 );
        }
        else {
            return undef;
        }

    },
    hcl => sub {
        return undef unless $_[0] =~ m/\#[0-9a-f]{6}/;

    },
    ecl => sub {
        return undef unless $_[0] =~ m/amb|blu|brn|gry|grn|hzl|oth/;

    },
    pid => sub {
        return undef unless $_[0] =~ m/^\d{9}$/;

    },
);

sub validate {

    my ($rec) = @_;

    foreach my $key ( keys %rules ) {
        return undef unless exists $rec->{$key};
        return undef unless ( $rules{$key}->( $rec->{$key} ) );
    }
    return 1;
}

sub dump_record {
    my ($rec) = @_;
    foreach my $key ( sort { $a cmp $b } keys %rules ) {
        print $key, ": ", $rec->{$key} // "n/a", ' ';
    }
    print "\n";
}

# massage data into a form we can use
my @records;
foreach (@file_contents) {
    my @r = split( /\n/, $_ );

    my %data;
    while (@r) {
        my $line = shift @r;
        my @c = split( /:| /, $line );
        while (@c) {
            my $key = shift @c;
            my $val = shift @c;
            $data{$key} = $val;
        }
    }

    push @records, \%data;
}

# count the valid passports!
my %valids = ( 1=> 0, 2=>0 );
foreach my $record (@records) {
    if ( scalar keys %{$record} == 8 ) {
        $valids{1}++;
    }
    elsif ( scalar keys %{$record} == 7 and !exists $record->{cid} ) {
        $valids{1}++;
    }
    if ( validate($record) ) {

        $valids{2}++;

    }

}
is( $valids{1}, 239, "Part1: $valids{1}" );
is( $valids{2}, 188, "Part2: $valids{2}" );


93 lines [ Plain text ] [ ^Top ]

Advent of Code 2020 day 5 - Binary Boarding

[ AoC problem link ] [ Discussion ].

Day 05 - complete solution


#! /usr/bin/env perl
use Modern::Perl '2015';

# useful modules
use List::Util qw/min max/;
use Test::More tests => 2;
#### INIT - load input data from file into array
my $testing = 0;
my @file_contents;
my $file = $testing ? 'test.txt' : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @file_contents, $_; }

### CODE
sub half_range {
    my ( $lower, $upper, $choice ) = @_;
    my $mid = int( ( $upper - $lower ) / 2 );
    if ( $choice =~ m/F|L/ ) {    #lower half
        return [ $lower, $lower + $mid ];
    }
    elsif ( $choice =~ m/B|R/ ) {    #upper half
        return [ $lower + $mid + 1, $upper ];
    }
    else {
        die "can't work with these values! $lower $upper $choice";
    }
}
my %ids = ();
while (@file_contents) {
    my @string = split( //, shift @file_contents );
    my ( $lower, $upper ) = ( 0, 127 );
    my $pos = 0;
    while ( $pos < 7 ) {
        my $choice = shift @string;
        ( $lower, $upper ) = @{ half_range( $lower, $upper, $choice ) };
        $pos++;
    }
    my $row = $lower;
    ( $lower, $upper ) = ( 0, 7 );
    while (@string) {
        my $choice = shift @string;
        ( $lower, $upper ) = @{ half_range( $lower, $upper, $choice ) };
    }

    my $column = $lower;
    my $seat_id = $row * 8 + $column;
    $ids{$seat_id}++;

}
my $min_id = min keys %ids;
my $max_id = max keys %ids;
my $part1  = $max_id;
my $part2;
for ( $min_id .. $max_id ) {
    $part2 = $_ unless exists $ids{$_};
}
is( $part1, 850, "Part1: $part1" );
is( $part2, 599, "Part2: $part2" );

50 lines [ Plain text ] [ ^Top ]

Advent of Code 2020 day 6 - Custom Customs

[ AoC problem link ] [ Discussion ].

Day 06 - complete solution


#! /usr/bin/env perl
use Modern::Perl '2015';

# useful modules
use Test::More tests => 2;
#### INIT - load input data from file into array
my $testing = 0;
my @file_contents;
my $file = $testing ? 'test.txt' : 'input.txt';
open( my $fh, '<', "$file" );
{
    # set the local IFS to an empty string to treat the input as paragraphs
    local $/ = "";
    while (<$fh>) {
        chomp;
        push @file_contents, $_;
    }
}

### CODE
my $part1;
my $part2;
foreach (@file_contents) {
    my $respondents = 0;
    my %h;
    foreach ( split( "\n", $_ ) ) {
        foreach ( split( //, $_ ) ) {
            $h{$_}++;
        }
        $respondents++;
    }
    foreach my $k ( keys %h ) {
        $part1++;
        $part2++ if $h{$k} == $respondents;
    }
}
is( $part1, 6382, "Part1: $part1" );
is( $part2, 3197, "Part2: $part2" );

32 lines [ Plain text ] [ ^Top ]

Advent of Code 2020 day 7 - Handy Haversacks

[ AoC problem link ] [ Discussion ].

Day 07 - complete solution


#! /usr/bin/env perl
use Modern::Perl '2015';
use Test::More tests => 2;
#### INIT - load input data from file into array
my $testing = 0;
my $opt = shift // 0;
my @file_contents;

# for part 2 there are 2 example files, passing an argument will
# switch between them

my $testfile;

if ($opt) {
    $testfile = 'test2.txt';
}
else {
    $testfile = 'test.txt';
}
my $file = $testing ? $testfile : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @file_contents, $_; }

### CODE
my $hash;
while (@file_contents) {
    my $line = shift @file_contents;
    my ( $container, $contents ) = $line =~ m/^(.*) bags contain (.*)$/;
    if ( $contents =~ /no other bags/ ) {
        $hash->{$container} = {};
        next;
    }
    my @contents = split( /,/, $contents );
    foreach my $content (@contents) {
        my ( $amount, $kind ) = $content =~ m/(\d+) (.*) bag/;
        $hash->{$container}{$kind} = $amount;
    }
}

# soundtrack - Lloyd Cole & The Commotions: "My Bag" -
# https://www.youtube.com/watch?v=MG6lDsZQs5A

my %results;
my @queue = ('shiny gold');

while (@queue) {
    my $target = shift @queue;
    foreach my $bag ( keys %$hash ) {
        if ( exists $hash->{$bag}{$target} ) {
            $results{$bag}++;
            push @queue, $bag;
        }
    }
}

my $part1 = scalar keys %results;
is( $part1, 268, "Part1: $part1" );

# part 2
@queue = ( [ 'shiny gold', 1 ] );
my $count = 0;
while (@queue) {
    my $target = shift @queue;
    foreach my $bag ( keys %{ $hash->{ $target->[0] } } ) {
        my $multiple = $target->[1] * $hash->{ $target->[0] }{$bag};
        $count += $multiple;
        push @queue, [ $bag, $multiple ];
    }
}
is( $count, 7867, "Part2: $count" );

53 lines [ Plain text ] [ ^Top ]

Advent of Code 2020 day 8 - Handheld Halting

[ AoC problem link ] [ Discussion ].

Day 08 - complete solution


#! /usr/bin/env perl
use Modern::Perl '2015';

# useful modules
use Test::More tests => 2;
use Clone qw/clone/;
#### INIT - load input data from file into array
my $testing = 0;
my @file_contents;
my $file = $testing ? 'test.txt' : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @file_contents, $_; }

### CODE
my @original;
my %ops;
my $line_no = 0;
foreach (@file_contents) {
    my ( $op, $val ) = split ' ', $_;

    # gather the line numbers of all operations
    push @{ $ops{$op} }, $line_no;

    push @original, [ $op, $val ];
    $line_no++;
}

my $part1; my $part2;

# part 1
my $ret = run_program( \@original );
if (defined $ret->[0]) {
    die "this shouldn't be possible here!"
} else {
    $part1 = $ret->[1];

}
is($part1, 1200, "Part 1: $part1");
# part 2
# start with jmp->nop as that's the largest set
my $subst=0;
foreach my $line_no (@{$ops{'jmp'}}) {
    # we need to use Clone::clone here because just assigning will
    # modify the original
    my $code = clone(\@original);
    # sanity check
    if ($original[$line_no][0] eq 'jmp') {
	$code->[$line_no][0] = 'nop'
    } else {
	die "value ",$original[$line_no][0]," is not expected 'jmp'!";
    }
    my $ret = run_program($code);
    if (defined $ret->[0]) {
	$part2 = $ret->[1];
	say "==> found part 2 at substition ('jmp'->'nop') $subst of ",scalar @{$ops{'jmp'}};
	last;
    }
    $subst++;
}

# we should maybe try the nop->jmp substitution here but as the
# previous one already gave the answer I won't bother

is($part2, 1023, "Part 2: $part2");

sub run_program {
    my ($program) = @_;

    my %seen  = ();
    my $accum = 0;
    my $pos   = 0;
    while ( $pos < $line_no ) {
        my ( $op, $val ) = @{ $program->[$pos] };
        if ( $op eq 'acc' ) {
            $accum += $val;
            $pos++;
        }
        elsif ( $op eq 'jmp' ) {
            $pos += $val;
        }
        elsif ( $op eq 'nop' ) {
            $pos++;
        }
        if ( $seen{$pos} ) {
            return [ undef, $accum ];
        }
        else {
            $seen{$pos}++;
        }

    }
    return [ $pos, $accum ];
}

72 lines [ Plain text ] [ ^Top ]

Advent of Code 2020 day 9 - Encoding Error

[ AoC problem link ] [ Discussion ].

Day 09 - complete solution


#! /usr/bin/env perl
use Modern::Perl '2015';

# useful modules
use List::Util qw/sum min max/;
use Data::Dumper;
use Test::More tests => 2;
#### INIT - load input data from file into array
my $testing = 0;
my @stream;
my $file = $testing ? 'test.txt' : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @stream, $_; }

### CODE
# set up window
my $lower = 0;
my $upper = $testing ? 4 : 24;

my $target = $stream[ $upper + 1 ];
my %h;

for ( $lower .. $upper ) {
    $h{ $stream[$_] }++;
}

while ( $upper < scalar @stream ) {

    # compare the difference between the target and each 25 preceding
    # elements and see if the result is among those elements.

    my $match = grep { exists $h{$_} }
        map { $target - $stream[$_] } ( $lower .. $upper );

    last unless $match;

    # move our window
    delete $h{ $stream[$lower] };
    $h{ $stream[ $upper + 1 ] }++;
    $target = $stream[ $upper + 2 ];
    $lower++;
    $upper++;
}
is( $target, 20874512, "Part 1: $target" );

# part 2
my $part2;

# let's go from the top
my $start = $#stream;
while ( $start > 0 ) {
    if ( $stream[$start] >= $target ) {
        $start--;
        next;
    }

    my $sum  = $stream[$start];
    my $next = $start - 1;
    while ( $sum < $target ) {
        $sum += $stream[$next];
        $next--;
    }

    if ( $sum == $target ) {    # this could probably be more elegant

        # find sum of smallest and largest
        my @contig = map { $stream[$_] } ( $next + 1 .. $start );
        $part2 = sum( min(@contig), max(@contig) );
        last;
    }
    $start--;
}

is( $part2, 3012420, "Part 2: $part2" );

52 lines [ Plain text ] [ ^Top ]

Advent of Code 2020 day 10 - Adapter Array

[ AoC problem link ] [ Discussion ].

Day 10 - complete solution


#! /usr/bin/env perl
use Modern::Perl '2015';

# useful modules
use List::Util qw/max/;
use Test::More tests => 2;
use Time::HiRes qw/gettimeofday tv_interval/;
use Memoize ;
my $start_time = [gettimeofday];

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

### CODE
my $device = max( keys %adapters ) + 3;
$adapters{$device} = undef;
my $joltage = 0;
my $count   = 0;
my %diffs   = ();
while ( $count < scalar keys %adapters ) {
STEPS:
    for my $step ( 1 .. 3 ) {
        my $sought = $joltage + $step;
        if ( exists $adapters{$sought} ) {
            $adapters{$sought} = $joltage;
            $diffs{$step}++;
            $joltage += $step;
            last STEPS;
        }
    }
    $count++;
}

my $part1 = $diffs{1} * $diffs{3};
is( $part1, 1917, "Part 1: " . $part1 );

# part 2
# This solution inspired by a solution by /u/Loonis
# https://www.reddit.com/r/adventofcode/comments/ka8z8x/2020_day_10_solutions/gf9bwuw/

my @sequence = sort { $a <=> $b } keys %adapters;
unshift @sequence, 0;

# build a graph
my @G;
for my $i ( 0 .. $#sequence ) {
    $G[$i]{v} = $sequence[$i];
    for my $step (  1 .. 3 ) {
        last unless defined $sequence[$i+$step];
        push @{ $G[$i]{e} }, $i+$step if $sequence[$i+$step] - $sequence[$i] <= 3;
    }
}

# this is part of a test of Memoize. It's the same sub are `traverse`
# but without the explicit memoization

sub slow_traverse {
    my $node  = $G[ $_[0] ];
    my $count = 0;
    return 1 unless defined $node->{e};
    foreach my $idx ( @{ $node->{e} } ) {
        $count += slow_traverse($idx);
    }
    return $count;

}
memoize ('slow_traverse');

sub traverse {
    my $node  = $G[ $_[0] ];
    my $count = 0;
    return 1 unless defined $node->{e};
    return $node->{m} if defined $node->{m};

    foreach my $idx ( @{ $node->{e} } ) {
        $count += traverse($idx);
    }
    $node->{m} = $count;
    return $count;
}
my $part2;
$part2 = traverse(0);

is( $part2, 113387824750592, "Part 2: " . $part2 );

say "Duration: ", tv_interval($start_time) * 1000, "ms";


70 lines [ Plain text ] [ ^Top ]

Advent of Code 2020 day 11 - Seating System

[ AoC problem link ] [ Discussion ].

Day 11 - complete solution


#! /usr/bin/env perl
use Modern::Perl '2015';

# useful modules
use Test::More tests => 2;
use Clone qw/clone/;
use Time::HiRes qw/gettimeofday tv_interval/;

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

### CODE
my $Map;
my $state;
my $maxrow = 0;
my $maxcol;
foreach my $line (@file_contents) {
    $maxcol = 0;
    foreach my $char ( split( //, $line ) ) {
        $Map->{$maxrow}{$maxcol}   = $char;
        $state->{$maxrow}{$maxcol} = $char;
        $maxcol++;
    }
    $maxrow++;
}
my $Neighbors;
for my $row ( 0 .. $maxrow - 1 ) {
    for my $col ( 0 .. $maxcol - 1 ) {

        # only consider points with chairs
        next unless $Map->{$row}{$col} eq 'L';
    DIRECTION:
        for my $dir ( [ -1, -1 ], [ -1, 0 ], [ -1, 1 ],
		      [  0, -1 ],            [  0, 1 ],
		      [  1, -1 ], [  1, 0 ], [  1, 1 ] ) {
            my ( $r, $c ) = ( $row + $dir->[0], $col + $dir->[1] );
            my $layer = 1;
            next DIRECTION unless defined $Map->{$r}{$c};
            while ( defined $Map->{$r}{$c} ) {
                if ( $Map->{$r}{$c} eq 'L' ) {
                    push @{ $Neighbors->{$row}{$col}{$layer} }, [ $r, $c ];
                    next DIRECTION;
                }
                $r += $dir->[0];
                $c += $dir->[1];
                $layer++;
            }

        }
    }
}


sub count_seated {
    my ($s) = @_;
    my $count = 0;
    foreach my $r ( keys %$s ) {
        foreach my $c ( keys %{ $s->{$r} } ) {
            $count++ if $s->{$r}{$c} eq '#';
        }
    }
    return $count;
}

# part 1

my $newstate;

for ( 1 .. 99 ) {
    my $diffs = 0;
    for ( my $row = 0; $row < $maxrow; $row++ ) {
        for ( my $col = 0; $col < $maxcol; $col++ ) {

            next unless $Map->{$row}{$col} eq 'L';
            my $occupied = 0;
            foreach my $pos ( @{ $Neighbors->{$row}{$col}{1} } ) {
                $occupied++ if $state->{ $pos->[0] }{ $pos->[1] } eq '#';
            }
            my $prev = $newstate->{$row}{$col} // '*';
            if ( $state->{$row}{$col} eq '#' and $occupied >= 4 ) {
                $newstate->{$row}{$col} = 'L';
            }
            elsif ( $state->{$row}{$col} eq 'L' and $occupied == 0 ) {
                $newstate->{$row}{$col} = '#';
            }
            else {
                $newstate->{$row}{$col} = $state->{$row}{$col};
            }
            $diffs++ unless $prev eq $newstate->{$row}{$col};

        }

    }
    if ( $diffs == 0 ) {
        my $solution = count_seated($state);
        is( $solution, 2093, "Part 1: " . $solution );
        last;
    }
    $state = clone $newstate;
}

# part 2
$state    = clone $Map;
$newstate = undef;

foreach ( 1 .. 99 ) {
    my $diffs = 0;
    for ( my $row = 0; $row < $maxrow; $row++ ) {
        for ( my $col = 0; $col < $maxcol; $col++ ) {
            next unless $Map->{$row}{$col} eq 'L';
            my $occupied = 0;
            foreach my $layer ( keys %{ $Neighbors->{$row}{$col} } ) {
                foreach my $pos ( @{ $Neighbors->{$row}{$col}{$layer} } ) {
                    $occupied++ if $state->{ $pos->[0] }{ $pos->[1] } eq '#';
                }
            }
            my $prev = $newstate->{$row}{$col} // '*';
            if ( $state->{$row}{$col} eq 'L' and $occupied == 0 ) {
                $newstate->{$row}{$col} = '#';
            }
            elsif ( $state->{$row}{$col} eq '#' and $occupied >= 5 ) {
                $newstate->{$row}{$col} = 'L';
            }
            else {
                $newstate->{$row}{$col} = $state->{$row}{$col};
            }
            $diffs++ unless $prev eq $newstate->{$row}{$col};
        }
    }
    if ( $diffs == 0 ) {
        my $solution = count_seated($state);
        is( $solution, 1862, "Part 2: " . $solution );
        last;

    }
    $state = clone $newstate;

}
say "Duration: ", tv_interval($start_time) * 1000, "ms";

121 lines [ Plain text ] [ ^Top ]

Day 11 - part 1


#! /usr/bin/env perl
use Modern::Perl '2015';

# useful modules
use Test::More tests=>1;
use Time::HiRes qw/gettimeofday tv_interval/;
use Clone qw/clone/;
my $start_time = [gettimeofday];
#### INIT - load input data from file into array
my $testing = 0;
my @file_contents;
my $file = $testing ? 'test.txt' : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @file_contents, $_; }

### SUBS

sub dump_state {
    my ($S) = @_;
    foreach ( @{$S} ) {
        foreach my $c ( @{$_} ) {
            print $c // ' ';
        }
        print "\n";
    }
}

sub compare_states {
    my ( $in, $out ) = @_;
    my $count = 0;
    my $diff  = 0;
    for ( my $r = 0; $r < scalar @$in; $r++ ) {
        for ( my $c = 0; $c < scalar $in->[$r]->@*; $c++ ) {
	    next unless (defined $in->[$r][$c] and defined $out->[$r][$c]);
            $count++ if $in->[$r][$c] eq '#';
            if ( $in->[$r][$c] ne $out->[$r][$c] ) {
                $diff++;
            }
        }
    }
    if ($diff) {
        return undef;
    }
    else {
        return $count;
    }
}
### CODE
my $Map;
my $state;
my $row = 0;
foreach (@file_contents) {
    my $line = [ split( //, $_ ) ];
    push @$Map,   $line;
    push @$state, $line;
}
my $maxcol = scalar $Map->[0]->@*;
say $maxcol;

for ( 1 .. 999 ) {

    my $newstate;
    for ( my $row = 0; $row < scalar @$Map; $row++ ) {
        for ( my $col = 0; $col < scalar $Map->[$row]->@*; $col++ ) {

            next unless $Map->[$row][$col] eq 'L';

            my $occupied = 0;
            for my $dir (
			 [ -1, -1 ], [ -1, 0 ], [ -1, 1 ],
 			  [ 0, -1 ],          , [ 0, 1 ],
			  [ 1, -1 ], [ 1, 0 ] , [ 1, 1 ]
                )
            {
                my ( $r, $c ) = ( $row + $dir->[0], $col + $dir->[1] );
                next
                    if ( $r < 0
                    or $c < 0
                    or $r > scalar @$Map
			 or $c > $maxcol );
		my $mapval = $Map->[$r]->[$c]?$Map->[$r]->[$c] : '/';
                if ( $mapval eq 'L' and $state->[$r]->[$c] eq '#' ) {
                    $occupied++;
                }

            }
            if ( $state->[$row]->[$col] eq '#' and $occupied >= 4 ) {
                $newstate->[$row]->[$col] = 'X';
            }
            elsif (
                (      $state->[$row]->[$col] eq 'L'
                    or $state->[$row]->[$col] eq 'X'
                )
                and $occupied == 0
                )
            {
                $newstate->[$row]->[$col] = '#';
            }
            else {
                $newstate->[$row]->[$col] = $state->[$row]->[$col];
            }

        }
    }
    say $_;

    my $same = compare_states( $state, $newstate );
    if ($same) {
	is( $same, 2093 , "Part 1: ".$same);
        last;
    }
    $state = clone $newstate;
}

say "Duration: ", tv_interval($start_time) * 1000, "ms";

98 lines [ Plain text ] [ ^Top ]

Day 11 - part 2


#! /usr/bin/env perl
use Modern::Perl '2015';
# useful modules
use Test::More tests=>1;
use Clone qw/clone/;
use Time::HiRes qw/gettimeofday tv_interval/;

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

### CODE
my $Map;
my $state;
my $maxrow=0;
my $maxcol;
foreach my $line (@file_contents) {
    $maxcol = 0;
    foreach my $char (split(//,$line)) {
	$Map->{$maxrow}->{$maxcol} = $char;
	$state->{$maxrow}->{$maxcol} = $char ;
	$maxcol++;
    }
    $maxrow++;
		     
}
sub dump_state {
    my ( $m ) = @_;
    for (my $r =0 ;$r<$maxrow;$r++) {
	for (my $c=0;$c<$maxcol;$c++) {
	    print $m->{$r}->{$c} // '.'
	}
	print "\n";
    }
}
sub compare_states {
    my ( $A, $B ) = @_;
    my ( $count, $diff ) = (0,0);
    for (my $r =0 ;$r<$maxrow;$r++) {
	for (my $c=0;$c<$maxcol;$c++) {
	    next unless (defined $A->{$r}{$c} and defined $B->{$r}{$c});
	    $count++ if $A->{$r}{$c} eq '#';
	    if ($A->{$r}{$c} ne $B->{$r}{$c}) {
		$diff++
	    }
	}
    }
    if ($diff) {
	return undef
    } else {
	return $count;
    }
}    

say '0';

my $newstate;
my @check=(0,2);
foreach (1..9999) {
    # scan the map and assign seats
    for (my $row=0;$row<$maxrow;$row++) {
	for (my $col=0;$col<$maxcol;$col++) {
	    next unless $Map->{$row}{$col} eq 'L';
	    my $occupied = 0;
	  DIRECTION:
	    for my $dir ([-1,0,'N'],[-1,1,'NE'],[0,1,'E'],[1,1,'SE'],[1,0,'S'],[1,-1,'SW'],[0,-1,'W'],[-1,-1,'NW']) {
		my ( $r,$c )= ($row + $dir->[0], $col + $dir->[1]);
		next DIRECTION unless defined $Map->{$r}{$c};
		while (defined $Map->{$r}{$c}) {
		    if ($Map->{$r}{$c} eq 'L') {
			if ($state->{$r}{$c} eq '#') {
			    $occupied++
			}
			next DIRECTION;
		    }
		    $r += $dir->[0];
		    $c += $dir->[1];
		}
	    }
	    if ($state->{$row}{$col} eq 'L' and $occupied == 0) {
		$newstate->{$row}{$col} = '#'
	    } elsif ($state->{$row}{$col} eq '#' and $occupied >=5 ) {
		$newstate->{$row}{$col} = 'L'
	    } else {
		$newstate->{$row}{$col} = $state->{$row}{$col}
	    }
	}
    }
    say $_;
    my $same = compare_states( $state, $newstate);
    if ($same) {
	is($same, 1862,"Part 2: ".$same);
	last;
    }
    $state = clone $newstate;
}
say "Duration: ", tv_interval($start_time) * 1000, "ms";

92 lines [ Plain text ] [ ^Top ]

Advent of Code 2020 day 12 - Rain Risk

[ AoC problem link ] [ Discussion ].

Day 12 - complete solution


#! /usr/bin/env perl
use Modern::Perl '2015';

# useful modules
use List::Util qw/sum/;
use Test::More tests => 2;
use Time::HiRes qw/gettimeofday tv_interval/;

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

### CODE
my @instr;
for (@file_contents) {
    if (m/([NSEWLRF])(\d+)/) {
        push @instr, [ $1, $2 ];

    }
    else {
        die "can't parse: $_";
    }
}

my %move = (

    N => sub { my ( $d, $p ) = @_; $p->[0] += $d; return $p; },
    S => sub { my ( $d, $p ) = @_; $p->[0] -= $d; return $p; },
    E => sub { my ( $d, $p ) = @_; $p->[1] += $d; return $p; },
    W => sub { my ( $d, $p ) = @_; $p->[1] -= $d; return $p; },

);
my %rotate = (

	      # these rules are essentially from
	      # https://askinglot.com/what-is-the-rule-for-rotating-90-degrees-counterclockwise,
	      # but I had to tweak them to get the correct values
    L => sub {
        my ( $th, $p ) = @_;
        if    ( $th ==  90 ) { return [  $p->[1], -$p->[0] ] }
        elsif ( $th == 180 ) { return [ -$p->[0], -$p->[1] ] }
        else                 { return [ -$p->[1],  $p->[0] ] }
    },

    R => sub {
        my ( $th, $p ) = @_;
        if ( $th ==    270 ) { return [  $p->[1], -$p->[0] ] }
        elsif ( $th == 180 ) { return [ -$p->[0], -$p->[1] ] }
        else                 { return [ -$p->[1],  $p->[0] ] }

    },
);
my $ship1 = [ 0, 0 ];
my $dir   = [ 0, 1 ];    # start facing E
my $ship2 = [ 0, 0 ];
my $wp    = [ 1, 10 ];
foreach my $ins (@instr) {

    if ( $ins->[0] eq 'F' ) {
        $ship1->[0] += $dir->[0] * $ins->[1];
        $ship1->[1] += $dir->[1] * $ins->[1];
        $ship2->[0] += $wp->[0] * $ins->[1];
        $ship2->[1] += $wp->[1] * $ins->[1];
    }
    elsif ( $ins->[0] eq 'L' or $ins->[0] eq 'R' ) {
        $dir = $rotate{ $ins->[0] }->( $ins->[1], $dir );
        $wp  = $rotate{ $ins->[0] }->( $ins->[1], $wp );

    }
    else {
        $ship1 = $move{ $ins->[0] }->( $ins->[1], $ship1 );
        $wp    = $move{ $ins->[0] }->( $ins->[1], $wp );
    }

}
my $part1 = sum( map { abs($_) } @{$ship1} );
is( $part1, 938, "Part 1: " . $part1 );
my $part2 = sum( map { abs($_) } @{$ship2} );
is( $part2, 54404, "Part 2: " . $part2 );
say "Duration: ", tv_interval($start_time) * 1000, "ms";

67 lines [ Plain text ] [ ^Top ]

Day 12 - part 1


#! /usr/bin/env perl
use Modern::Perl '2015';

# useful modules
use List::Util qw/sum/;
use Data::Dumper;
use Test::More tests => 1;
use Time::HiRes qw/gettimeofday tv_interval/;

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

### CODE
my @instr;
for (@file_contents) {
    if (m/([NSEWLRF])(\d+)/) {

        #	say "$1 $2";
        push @instr, [ $1, $2 ];

    }
    else {
        die "can't parse: $_";
    }
}
my %L90  = ( N => 'W', E => 'N', S => 'E', W => 'S' );
my %L180 = ( N => 'S', E => 'W', S => 'N', W => 'E' );
my %L270 = ( N => 'E', E => 'S', S => 'W', W => 'N' );
my %move = (
    N => sub {
        my ( $d, $p ) = @_;
        $p->[0][0] += $d; return $p;
    },
    S => sub {
        my ( $d, $p ) = @_;
        $p->[0][0] -= $d; return $p;
    },
    E => sub {
        my ( $d, $p ) = @_;
        $p->[0][1] += $d; return $p;
    },
    W => sub {
        my ( $d, $p ) = @_;
        $p->[0][1] -= $d; return $p;
    },
    F => sub {
        my ( $d, $p ) = @_;
        my $dir = $p->[1];
        if ( $dir eq 'N' ) { $p->[0][0] += $d; return $p }
        elsif ( $dir eq 'S' ) { $p->[0][0] -= $d; return $p }
        elsif ( $dir eq 'E' ) { $p->[0][1] += $d; return $p }
        else                  { $p->[0][1] -= $d; return $p }
    },
    L => sub {
        my ( $th, $p ) = @_;
        my $dir = $p->[1];
        if ( $th == 90 )     { $p->[1] =  $L90{$dir}; return $p }
	elsif ( $th == 180 ) { $p->[1] = $L180{$dir}; return $p }
        else                 { $p->[1] = $L270{$dir}; return $p }
    },
    R => sub {
        my ( $th, $p ) = @_;
        my $dir = $p->[1];
        if ( $th == 90 )     { $p->[1] = $L270{$dir}; return $p }
        elsif ( $th == 180 ) { $p->[1] = $L180{$dir}; return $p }
        else                 { $p->[1] =  $L90{$dir}; return $p }
    },

);
my $pos = [ [ 0, 0 ], 'E' ];
foreach my $ins (@instr) {

    $pos = $move{ $ins->[0] }->( $ins->[1], $pos );

}

my $part1 = sum( map { abs($_) } @{ $pos->[0] } );
is( $part1, 938, "Part 1: " . $part1 );
say "Duration: ", tv_interval($start_time) * 1000, "ms";

71 lines [ Plain text ] [ ^Top ]

Day 12 - part 2


#! /usr/bin/env perl
use Modern::Perl '2015';

# useful modules
use List::Util qw/sum/;
use Test::More tests => 1;
use Time::HiRes qw/gettimeofday tv_interval/;

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

### CODE
my @instr;
for (@file_contents) {
    if (m/([NSEWLRF])(\d+)/) {
        push @instr, [ $1, $2 ];

    }
    else {
        die "can't parse: $_";
    }
}

my %move = (

    N => sub { my ( $d, $p ) = @_; $p->[0] += $d; return $p; },
    S => sub { my ( $d, $p ) = @_; $p->[0] -= $d; return $p; },
    E => sub { my ( $d, $p ) = @_; $p->[1] += $d; return $p; },
    W => sub { my ( $d, $p ) = @_; $p->[1] -= $d; return $p; },

);
my %rotate = (

	      # these rules are essentially from
	      # https://askinglot.com/what-is-the-rule-for-rotating-90-degrees-counterclockwise,
	      # but I had to tweak them to get the correct values
	      
    L => sub {
        my ( $th, $p ) = @_;
        if    ( $th ==  90 ) { return [  $p->[1], -$p->[0] ] }
        elsif ( $th == 180 ) { return [ -$p->[0], -$p->[1] ] }
        else                 { return [ -$p->[1],  $p->[0] ] }
    },

    R => sub {
        my ( $th, $p ) = @_;
        if ( $th ==    270 ) { return [  $p->[1], -$p->[0] ] }
        elsif ( $th == 180 ) { return [ -$p->[0], -$p->[1] ] }
        else                 { return [ -$p->[1],  $p->[0] ] }

    },
);

my $ship = [ 0, 0 ];
my $wp   = [ 1, 10 ];
foreach my $ins (@instr) {

    if ( $ins->[0] eq 'F' ) {
#	@$ship = map { $_ * $ins->[1] } @$wp;
        $ship->[0] += $wp->[0] * $ins->[1];
        $ship->[1] += $wp->[1] * $ins->[1];
    }
    elsif ( $ins->[0] eq 'L' or $ins->[0] eq 'R' ) {
        $wp = $rotate{ $ins->[0] }->( $ins->[1], $wp );
    }
    else {
        $wp = $move{ $ins->[0] }->( $ins->[1], $wp );
    }

}
my $part2 = sum( map { abs($_) } @{$ship} );
is( $part2, 54404, "Part 2: " . $part2 );
say "Duration: ", tv_interval($start_time) * 1000, "ms";

59 lines [ Plain text ] [ ^Top ]

Advent of Code 2020 day 13 - Shuttle Search

[ AoC problem link ] [ Discussion ].

Day 13 - complete solution


#! /usr/bin/env perl
use Modern::Perl '2015';

# useful modules
use List::Util qw/all max product/;
use Test::More;
use Time::HiRes qw/gettimeofday tv_interval/;

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

#### SUBS
sub part1 {
    my ( $dep_time, $string ) = @_;
    my %possibles;
    foreach ( split( ',', $string ) ) {
        next unless $_ =~ /\d+/;
        my $no_of_times = int( $dep_time / $_ );
        my $next        = $no_of_times * $_ + $_;
        $possibles{$next} = $_;

    }
    my $next_dep = ( sort { $a <=> $b } keys %possibles )[0];
    return ( $next_dep - $dep_time ) * $possibles{$next_dep};
}

sub run {
    my ($string) = @_;
    my @targets  = ();
    my @offsets  = ();
    my $idx      = 0;
    for ( split( ',', $string ) ) {
        if ( $_ ne 'x' ) {
            push @targets, $_;
            push @offsets, $idx;
        }
        $idx++;
    }
    my $pos  = 1;
    my $t    = $offsets[0];
    my $step = $targets[0];

    # Solution inspired by
    # https://www.reddit.com/r/adventofcode/comments/kc60ri/2020_day_13_can_anyone_give_me_a_hint_for_part_2/gfnnfm3/

    while ( $pos <= $#targets ) {

        # Iteratively search for the next $t that satisfies all
        # previous conditions.

        do {
            $t += $step;
            } until (
            all { ( $t + $offsets[$_] ) % $targets[$_] == 0 } ( 0 .. $pos ) );

        # The new $step is the product of the previous factors, and we
        # start from where we left off when the loop finished
	# This works because all bus ids are prime

        $step = product( map { $targets[$_] } ( 0 .. $pos ) );
        $pos++;
    }

    return $t;
}
### CODE

#my $departure_time = $file_contents[0];
my $part1 = part1( $file_contents[0], $file_contents[1] );
is( $part1, 2845, "Part 1: " . $part1 );

# part 2
if ($run_unit_tests) {
    say "==> running unit tests for part 2";
    while () {
        chomp;
        my ( $string, $starting, $expected ) = split;
        my $res = run($string);
	if (!defined $expected) {
	    say $res;
	    next;
	}
#	say $res if !defined expecting;
        is( $res, $expected );

    }
    say "==> tests done";
}
my $part2 = run( $file_contents[1] );
is( $part2, 487905974205117, "Part 2: " . $part2 );
done_testing();
say "Duration: ", tv_interval($start_time) * 1000, "ms";

__DATA__
7,13,x,x,59,x,31,19 1000000 1068781
17,x,13,19 3000 3417
67,7,59,61 750000  754018
67,x,7,59,61 750000 779210
67,7,x,59,61 1260000 1261476
1789,37,47,1889 1202160000 1202161486
41,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,37,x,x,x,x,x,431,x,x,x,x,x,x,x,23,x,x,x,x,13,x,x,x,17,x,19,x,x,x,x,x,x,x,x,x,x,x,863,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,29 from_wink

83 lines [ Plain text ] [ ^Top ]

Advent of Code 2020 day 14 - Docking Data

[ AoC problem link ] [ Discussion ].

Day 14 - complete solution


#! /usr/bin/env perl
use Modern::Perl '2015';
no warnings qw(portable);

# useful modules
use List::AllUtils qw/sum all first_index/;
use Test::More;
use Time::HiRes qw/gettimeofday tv_interval/;

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

# solution for part 2 inspired by /u/Loonis (https://www.reddit.com/r/adventofcode/comments/kcr1ct/2020_day_14_solutions/gfseyzj/)

### SUBS
sub apply_mask_1 {
    my ( $mask, $bitstring ) = @_;
    my @mask = split( //, $mask );
    my @bits = split( //, $bitstring );
    for ( my $i = 0; $i <= $#mask; $i++ ) {
	# here we let the mask overwrite both 0 and 1, but ignore 'X'
        $bits[$i] = $mask[$i] unless $mask[$i] eq 'X';
    }
    return join( '', @bits );

}

sub apply_mask_2 {
    my ( $mask, $bitstring ) = @_;
    my @mask = split( //, $mask );
    my @bits = split( //, $bitstring );
    for ( my $i = 0; $i <= $#mask; $i++ ) {
	# this mask acts as an 'and' mask, but we need to take 'X' ("floating") into account
        $bits[$i] = $mask[$i] if $mask[$i] =~ /(1|X)/;
    }
    return join( '', @bits );

}

sub generate_mask {
    my ($str) = @_;
    my @list    = split( //, $str );
    my @result  = ();
    my $first_X = first_index { $_ eq 'X' } @list;
    if ( $first_X >= 0 ) {

        $list[$first_X] = 0;
        push @result, generate_mask( join( '', @list ) );
        $list[$first_X] = 1;
        push @result, generate_mask( join( '', @list ) );
    }
    else {
        push @result, $str;
    }
    return @result;
}

### CODE

my $mask;
my $addr;
my $val;
my %memory =(1=>undef,2=>undef);
foreach my $line (@file_contents) {

    if ( $line =~ m/^mask = ([01X]{36})$/ ) {
        $mask = $1;
        $addr = '';
        $val  = '';

    }
    elsif ( $line =~ m/mem\[(\d+)\] = (\d+)/ ) {
        $addr = $1;
        $val  = $2;
    }
    else {
        die "can't parse: $line !";
    }

    if ( $addr and $val ) {
	# part 1

	my $newval = apply_mask_1 ( $mask, sprintf( "%036b", $val ));
	$memory{1}->{$addr} = oct( '0b' . $newval );
	
	# part 2 
        # initiate the subsitution of the floating values by applying
        # the raw mask to the address

        my $new = apply_mask_2( $mask, sprintf( "%036b", $addr ) );

	# now we can generate all our masks
        my @masks = generate_mask($new);

        for my $m (@masks) {
            $memory{2}->{ oct( '0b' . $m ) } = $val;
        }
    }
}
my $part1 = sum( values %{$memory{1}} );
is( $part1, 13865835758282, "Part 1: " . $part1 );

my $part2 = sum( values %{$memory{2}} );
is( $part2, 4195339838136, "Part 2: " . $part2 );
done_testing();
say "Duration: ", tv_interval($start_time) * 1000, "ms";

86 lines [ Plain text ] [ ^Top ]

Day 14 - part 1


#! /usr/bin/env perl
use Modern::Perl '2015';
no warnings qw(portable);

# useful modules
use List::Util qw/sum all/;
use Test::More;
use Time::HiRes qw/gettimeofday tv_interval/;

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

sub apply_mask {
    my ( $mask, $bitstring ) = @_;
    my @mask = split( //, $mask );
    my @bits = split( //, $bitstring );
    for ( my $i = 0; $i <= $#mask; $i++ ) {
        $bits[$i] = $mask[$i] unless $mask[$i] eq 'X';
    }
    return join( '', @bits );

}
### CODE
my $mask;
my $addr;
my $val;
my %memory;
foreach my $line (@file_contents) {

    if ( $line =~ m/^mask = ([01X]{36})$/ ) {
        $mask = $1;
        $addr = '';
        $val  = '';
    }
    elsif ( $line =~ m/mem\[(\d+)\] = (\d+)/ ) {
        $addr = $1;
        $val  = $2;
    }
    else {
        die "can't parse: $line !";
    }

    #    say "$mask $addr $val";
    if ( $addr and $val ) {
        my $new = apply_mask( $mask, sprintf( "%036b", $val ) );
        if ($debug) {
            say "addr: [$addr]";
            printf( "in   %036b %d\n", $val, $val );
            say "mask $mask";
            say "out  $new " . oct( '0b' . $new );
        }
        $memory{$addr} = oct( '0b' . $new );
    }
}
my $part1 = sum( values %memory );
is( $part1, 13865835758282, "Part 1: " . $part1 );
done_testing();
say "Duration: ", tv_interval($start_time) * 1000, "ms";

54 lines [ Plain text ] [ ^Top ]

Day 14 - part 2


#! /usr/bin/env perl
use Modern::Perl '2015';
no warnings qw(portable);

# useful modules
use List::AllUtils qw/sum all first_index/;
use Test::More;
use Time::HiRes qw/gettimeofday tv_interval/;

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

# solution inspired by /u/Loonis (https://www.reddit.com/r/adventofcode/comments/kcr1ct/2020_day_14_solutions/gfseyzj/)

### SUBS

sub apply_mask {
    my ( $mask, $bitstring ) = @_;
    my @mask = split( //, $mask );
    my @bits = split( //, $bitstring );
    for ( my $i = 0; $i <= $#mask; $i++ ) {
        $bits[$i] = $mask[$i] if $mask[$i] =~ /(1|X)/;
    }
    return join( '', @bits );

}

sub generate_mask {
    my ($str) = @_;
    my @list    = split( //, $str );
    my @result  = ();
    my $first_X = first_index { $_ eq 'X' } @list;
    if ( $first_X >= 0 ) {

        $list[$first_X] = 0;
        push @result, generate_mask( join( '', @list ) );
        $list[$first_X] = 1;
        push @result, generate_mask( join( '', @list ) );
    }
    else {
        push @result, $str;
    }
    return @result;
}

### CODE

my $mask;
my $addr;
my $val;
my %memory;
foreach my $line (@file_contents) {

    if ( $line =~ m/^mask = ([01X]{36})$/ ) {
        $mask = $1;
        $addr = '';
        $val  = '';

    }
    elsif ( $line =~ m/mem\[(\d+)\] = (\d+)/ ) {
        $addr = $1;
        $val  = $2;
    }
    else {
        die "can't parse: $line !";
    }

    if ( $addr and $val ) {

        # initiate the subsitution of the floating values by applying
        # the raw mask to the address

        my $new = apply_mask( $mask, sprintf( "%036b", $addr ) );

        my @masks = generate_mask($new);
        for my $m (@masks) {
            $memory{ oct( '0b' . $m ) } = $val;
        }
    }
}
my $part2 = sum( values %memory );
is( $part2, 4195339838136, "Part 2: " . $part2 );
done_testing();
say "Duration: ", tv_interval($start_time) * 1000, "ms";

68 lines [ Plain text ] [ ^Top ]

Advent of Code 2020 day 15 - Rambunctious Recitation

[ AoC problem link ] [ Discussion ].

Day 15 - part 1


#! /usr/bin/env perl
use Modern::Perl '2015';

# useful modules
use Test::More;
use Time::HiRes qw/gettimeofday tv_interval/;

### CODE
my $start_time = [gettimeofday];
my $testing    = 0;
my $debug      = 0;


my @results    = ( 870, 436, 1, 10, 27, 78, 438, 1836 );
my $limit      = 2020;

my $case       = 1;
while () {

    chomp;
    my @start = split( ',', $_ );
    my %history;
    my $lastnum;
    my $turn = 1;
    foreach my $num (@start) {
        push @{ $history{$num} }, $turn;
        $lastnum = $num;
        print "$lastnum ";
        $turn++;
    }
    print ": ";
TURNS:
    while ( $turn <= $limit ) { 
        say "==> $turn " if $turn % 500_000 == 0;
        if ( exists $history{$lastnum}
            and scalar $history{$lastnum}->@* == 1 )
        {
            push $history{0}->@*, $turn;
            $lastnum = 0;
        }
        elsif ( !exists $history{$lastnum} ) {
            push $history{$lastnum}->@*, $turn;
            shift $history{$lastnum}->@*;

        }
        else {
            $lastnum = $history{$lastnum}->[-1] - $history{$lastnum}->[-2];
            push @{ $history{$lastnum} }, $turn;
        }
        if ( $turn == $limit ) {
            my $res = $lastnum;
            is( $res, $results[$case-1], "Case $case: $res" );
            last TURNS;
        }
        if ($debug) {

            foreach my $k ( sort { $a <=> $b } keys %history ) {
                print "$turn ==> $k [ ";
                say join( ' ', map { $_ ? $_ : '_' } @{ $history{$k} }, ']' );

            }
        }
        $turn++;
    }
    $case++;
}

done_testing();

say "Duration: ", tv_interval($start_time) * 1000, "ms";
__DATA__
11,0,1,10,5,19
0,3,6
1,3,2
2,1,3
1,2,3
2,3,1
3,2,1
3,1,2

65 lines [ Plain text ] [ ^Top ]

Day 15 - part 2


#! /usr/bin/env perl
use Modern::Perl '2015';

# useful modules
use Test::More;
use Time::HiRes qw/gettimeofday tv_interval/;

my $start_time = [gettimeofday];
### CODE
# solution cribbed from /u/musifter, https://www.reddit.com/r/adventofcode/comments/kdf85p/2020_day_15_solutions/gfwky22/
my @results = ( 9136, 175594, 2578, 3544142, 261214, 6895259, 18, 362 );
my $limit   = 30_000_000;
my $case    = 0;

while () {

    #    next if $case>0;
    chomp;

    my @list = split( ',', $_ );
    my @history;

    foreach my $t ( 0 .. $#list - 1 ) {
        $history[ $list[$t] ] = $t + 1;
    }
    my ( $next, $curr ) = ( $list[-1], 0 );
    foreach my $t ( $#list + 1 .. $limit - 1 ) {
        $curr = $next;
        $next = ( defined $history[$curr] ) ? $t - $history[$curr] : 0;
        $history[$curr] = $t;

    }
    is( $next, $results[$case], "Case $case: $next" );

    $case++;
}
done_testing();

say "Duration: ", tv_interval($start_time) * 1000, "ms";

__DATA__
11,0,1,10,5,19
0,3,6
1,3,2
2,1,3
1,2,3
2,3,1
3,2,1
3,1,2

35 lines [ Plain text ] [ ^Top ]

Advent of Code 2020 day 16 - Ticket Translation

[ AoC problem link ] [ Discussion ].

Day 16 - complete solution


#! /usr/bin/env perl
use Modern::Perl '2015';

# useful modules
use List::Util qw/any/;
use Test::More tests => 2;
use Time::HiRes qw/gettimeofday tv_interval/;

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

### CODE
my %rules;
my @tickets;
my @valids;
foreach my $line (@file_contents) {
    if ( $line =~ m/^(.*): (\d+)-(\d+) or (\d+)-(\d+)$/ ) {
        $rules{$1} = {
            r1 => { min => $2, max => $3 },
            r2 => { min => $4, max => $5 }
        };

    }
    elsif ( $line =~ m/^\d+,.*,\d+$/ ) {
        push @tickets, $line;
    }
}
my $target_ticket = shift @tickets;

my $invalid_sums = 0;
foreach (@tickets) {

    my @vals = split( ',', $_ );
    my $invalids = 0;
    my @oks;
    my $val_id = 0;
    foreach my $v (@vals) {
        my $field_row = 0;
        foreach my $rule ( keys %rules ) {
            if ((       $v >= $rules{$rule}->{r1}->{min}
                    and $v <= $rules{$rule}->{r1}->{max}
                )
                or (    $v >= $rules{$rule}->{r2}->{min}
                    and $v <= $rules{$rule}->{r2}->{max} )
                )
            {

                $oks[$field_row] = 1;

            }
            else {
                $oks[$field_row] = 0;

            }
            $field_row++;
        }
        if ( any { $_ == 1 } @oks ) {

            # valid

        }
        else {
            $invalid_sums += $v;
            $invalids++;
        }
        $val_id++;
    }

    push @valids, $_ unless $invalids++;

}
is( $invalid_sums, 21996, "Part 1: " . $invalid_sums );

# part 2
my %hits;

my @target = split( ',', $target_ticket );
foreach ( my $i = 0; $i < scalar(@target); $i++ ) {

    foreach my $rule ( keys %rules ) {

        my $validrule = 0;
        foreach my $ticket (@valids) {
            my @fields = split( ',', $ticket );
            my $field = $fields[$i];
            if ((       $field >= $rules{$rule}->{r1}->{min}
                    and $field <= $rules{$rule}->{r1}->{max}
                )
                or (    $field >= $rules{$rule}->{r2}->{min}
                    and $field <= $rules{$rule}->{r2}->{max} )
                ) { $validrule++; }
        }

        if ( $validrule == scalar @valids ) {
            $hits{$i}->{$rule}++;
        }
    }
}
my %solution;

# this part cribbed from 2018D16
while ( keys %hits ) {
    foreach my $field ( keys %hits ) {
        if ( scalar keys %{ $hits{$field} } == 1 ) {
            my $rule = ( keys %{ $hits{$field} } )[0];
            $solution{$field} = $rule;
            delete $hits{$field};
        }

        while ( my ( $k, $rule ) = each %solution ) {
            foreach my $v ( keys %{ $hits{$field} } ) {
                if ( $v eq $rule ) {
                    delete $hits{$field}->{$v};
                }
            }
        }
        if ( scalar keys %{ $hits{$field} } == 0 ) {
            delete $hits{$field};
        }
    }
}

my $part2 = 1;
foreach my $field ( keys %solution ) {
    if ( $solution{$field} =~ m/^departure/ ) {
        $part2 *= $target[$field];

    }
}
is( $part2, 650080463519, "Part 2: " . $part2 );
say "Duration: ", tv_interval($start_time) * 1000, "ms";


108 lines [ Plain text ] [ ^Top ]

Advent of Code 2020 day 17 - Conway Cubes

[ AoC problem link ] [ Discussion ].

Day 17 - part 1


#! /usr/bin/env perl
use Modern::Perl '2015';

# useful modules
use Test::More tests => 1;
use Clone 'clone';
use Time::HiRes qw/gettimeofday tv_interval/;

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

sub dump_state {
    my ($st) = @_;
    my $sum = 0;
    for my $x ( keys %$st ) {
        for my $y ( keys $st->{$x}->%* ) {
            for my $z ( keys $st->{$x}{$y}->%* ) {
		if ( exists $st->{$x}{$y}{$z}
		     and $st->{$x}{$y}{$z} eq '#' ) { $sum++ }
	    }
        }
    }
    return $sum;
}

my $state;

sub count_neighbors {
    no warnings 'uninitialized';
    my ( $x, $y, $z, ) = @_;
    my $count = 0;
    for my $dx ( $x - 1, $x, $x + 1 ) {
        for my $dy ( $y - 1, $y, $y + 1 ) {
            for my $dz ( $z - 1, $z, $z + 1 ) {

                next if ( $x == $dx and $y == $dy and $z == $dz );

                if ( $state->{$dx}{$dy}{$dz} eq '#' ) {

                    $count++;
                }
            }
        }
    }
    return $count;
}
my $y = 0;
foreach (@file_contents) {
    my $x = 0;
    foreach ( split( //, $_ ) ) {
        $state->{$x}{$y}{0} = '#' if $_ eq '#';
        $x++;
    }
    $y++;
}
my $cycle = 1;

my $newstate = clone($state);

while ( $cycle <= 6 ) {
    print "Cycle $cycle ... ";
    my $cubes=0;
    for my $x ( keys %{$state} ) {
        for my $y ( keys $state->{$x}->%* ) {
            for my $z ( keys $state->{$x}{$y}->%* ) {

                # we now have an active cell, let's check its neighbors
                for my $dx ( $x - 1, $x, $x + 1 ) {
                    for my $dy ( $y - 1, $y, $y + 1 ) {
                        for my $dz ( $z - 1, $z, $z + 1 ) {
			    $cubes++;
                            no warnings 'uninitialized';
                            my $n = count_neighbors( $dx, $dy, $dz );
                            if ( $state->{$dx}{$dy}{$dz} eq '#' ) {
                                if ( $n == 2 or $n == 3 ) {
                                    $newstate->{$dx}{$dy}{$dz} = '#';
                                }
                                else {
                                    delete $newstate->{$dx}{$dy}{$dz};
                                }
                            }
                            else {
                                if ( $n == 3 ) {
                                    $newstate->{$dx}{$dy}{$dz} = '#';
                                }
                            }
                        }
                    }
                }
            }
        }
    }

    $state = clone $newstate;
    say "$cubes cubes visited";
    $cycle++;
}
my $part1 = dump_state($state);
is( $part1, 247, "Part 1: " . $part1 );

say "Duration: ", tv_interval($start_time) * 1000, "ms";

90 lines [ Plain text ] [ ^Top ]

Day 17 - part 2


#! /usr/bin/env perl
use Modern::Perl '2015';

# useful modules
use List::Util qw/min max/;
use Test::More tests=>1;
use Clone 'clone';
use Time::HiRes qw/gettimeofday tv_interval/;

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

sub dump_state {
    my ($st) = @_;
    my $sum = 0;
    my %ranges = ( x => {min => min(keys %$st), max => max(keys %$st)});
    for my $id ('y','z','w') {
	$ranges{$id} = {min=>10_000, max=>-10_000};
    }
    for my $x ( keys %$st ) {
        for my $y ( keys $st->{$x}->%* ) {
	    if ($y < $ranges{y}->{min}) { $ranges{y}->{min}=$y  }
	    if ($y > $ranges{y}->{max}) { $ranges{y}->{max}=$y  }
            for my $z ( keys $st->{$x}{$y}->%* ) {
		if ($z < $ranges{z}->{min}) { $ranges{z}->{min}=$z  }
		if ($z > $ranges{z}->{max}) { $ranges{z}->{max}=$z  }

                for my $w ( keys $st->{$x}{$y}{$z}->%* ) {
		    if ($w < $ranges{w}->{min}) { $ranges{w}->{min}=$w  }
		    if ($w > $ranges{w}->{max}) { $ranges{w}->{max}=$w  }
		    if ( exists $st->{$x}{$y}{$z}{$w}
                        and $st->{$x}{$y}{$z}{$w} eq '#' ) { $sum++ }
                }
            }
        }
    }
    my $ranges;
    return [$sum, \%ranges];
}

my $state;

sub count_neighbors {
    no warnings 'uninitialized';
    my ( $x, $y, $z, $w ) = @_;

    #    say "==> $x,$y,$z:";
    my $count = 0;
    for my $dx ( $x - 1, $x, $x + 1 ) {
        for my $dy ( $y - 1, $y, $y + 1 ) {
            for my $dz ( $z - 1, $z, $z + 1 ) {
                for my $dw ( $w - 1, $w, $w + 1 ) {
                    next
                        if ($x == $dx
                        and $y == $dy
                        and $z == $dz
                        and $w == $dw );

                    if ( $state->{$dx}{$dy}{$dz}{$dw} eq '#' ) {
                        $count++;
                    }
                }
            }
        }
    }
    return $count;
}
my $y = 0;
foreach (@file_contents) {
    my $x = 0;
    foreach ( split( //, $_ ) ) {
        $state->{$x}{$y}{0}{0} = '#' if $_ eq '#';
        $x++;
    }
    $y++;
}
my $cycle = 1;

my $newstate = clone($state);

while ( $cycle <= 6 ) {
    print "Cycle $cycle ... ";
    my $cubes=0;
    for my $x ( keys %{$state} ) {
        for my $y ( keys $state->{$x}->%* ) {
            for my $z ( keys $state->{$x}{$y}->%* ) {
                for my $w ( keys $state->{$x}{$y}{$z}->%* ) {

                    # we now have an active cell, let's check its neighbors
                    for my $dx ( $x - 1, $x, $x + 1 ) {
                        for my $dy ( $y - 1, $y, $y + 1 ) {
                            for my $dz ( $z - 1, $z, $z + 1 ) {
                                for my $dw ( $w - 1, $w, $w + 1 ) {
				    $cubes++;
                                    no warnings 'uninitialized';
                                    my $n = count_neighbors( $dx, $dy, $dz,
                                        $dw );
                                    if ( $state->{$dx}{$dy}{$dz}{$dw} eq '#' )
                                    {
                                        if ( $n == 2 or $n == 3 ) {
                                            $newstate->{$dx}{$dy}{$dz}{$dw}
                                                = '#';
                                        }
                                        else {
                                        delete $newstate->{$dx}{$dy}{$dz}{$dw};
                                        }
                                    }
                                    else {
                                        if ( $n == 3 ) {
                                          $newstate->{$dx}{$dy}{$dz}{$dw}='#';
                                        }
                                    }
                                }
                            }
                        }
                    }
                }
            }
        }
    }
    say "$cubes cubes visited";
    $state = clone $newstate;
    $cycle++;
}

# count active
my $data = dump_state( $state );
my $part2=  $data->[0];
my $ranges = $data->[1];
say "Number of active cubes: ", $part2;
say "==> ranges";
foreach my $range (qw/x y z w/) {
    say join(' ','    ',$range, map {$ranges->{$range}->{$_}} qw/min max/);
}
is($part2,1392, "Part 2: ".$part2);
say "Duration: ", tv_interval($start_time) * 1000, "ms";


125 lines [ Plain text ] [ ^Top ]

Advent of Code 2020 day 18 - Operator Order

[ AoC problem link ] [ Discussion ].

Day 18 - complete solution


#! /usr/bin/env perl
use Modern::Perl '2015';

# useful modules
use Test::More;
use Time::HiRes qw/gettimeofday tv_interval/;

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

### CODE
# shunting yard algo adapted from http://www.rosettacode.org/wiki/Parsing/Shunting-yard_algorithm#Perl

my %prec = ( '*' => 2, '+' => 2, '(' => 1 );
if ($part2) {
    $prec{'+'} = 3;
}
my %assoc = ( '*' => 'left', '+' => 'left' );

sub shunting_yard {
    my @inp = split( //, $_[0] );
    my @ops;
    my @res;
    my $shift  = sub { push @ops, @_ };
    my $reduce = sub { push @res, @_ };

    while (@inp) {
        my $token = shift @inp;
        next if $token =~ /\s+/;
        if    ( $token =~ /\d+/ ) { $reduce->($token) }
        elsif ( $token eq '(' )   { $shift->($token) }
        elsif ( $token eq ')' ) {
            while ( @ops and "(" ne ( my $x = pop @ops ) ) { $reduce->($x) }

        }
        else {
            my $newprec = $prec{$token};
            while (@ops) {
                my $oldprec = $prec{ $ops[-1] };
                last if $newprec > $oldprec;
                last if $newprec == $oldprec and $assoc{$token} eq 'right';
                $reduce->( pop @ops );
            }
            $shift->($token);
        }
    }
    $reduce->( pop @ops ) while @ops;
    return join( ' ', @res );
}

# RPN solution from https://www.perlmonks.org/?node_id=520826
sub RPN {
    my ($in) = @_;
    my @stack;
    for my $tok ( split( ' ', $in ) ) {
        if ( $tok =~ /\d+/ ) {
            push @stack, $tok;
            next;
        }
        my $x = pop @stack;
        my $y = pop @stack;
        if ( $tok eq '+' ) {
            push @stack, $y + $x;
        }
        elsif ( $tok eq '*' ) {
            push @stack, $y * $x;
        }
        else {
            die "invalid token:\"$tok\"\n";
        }
    }
    @stack == 1 or die "invalid stack: [@stack]\n";
    return $stack[0];
}

foreach () {
    my ( $expr, $test1, $test2 ) = split ':';
    my $res = shunting_yard($expr);
    my $val = RPN($res);
    if ($part2) { ok( $val == $test2 ) }
    else { ok( $val == $test1 ) }
}

my $sum = 0;
foreach my $expr (@file_contents) {
    my $res = shunting_yard($expr);
    my $val = RPN($res);
    $sum += $val;
}
if ($part2) {
    is( $sum, 388966573054664, "Part2: " . $sum );
}
else {
    is( $sum,  18213007238947, "Part1: " . $sum );
}

done_testing();
say "Duration: ", tv_interval($start_time) * 1000, "ms";

__DATA__
1 + 2 * 3 + 4 * 5 + 6:71:231
1 + (2 * 3) + (4 * (5 + 6)):51:51
2 * 3 + (4 * 5):26:46
5 + (8 * 3 + 9 + 3 * 4 * 3):437:1445
5 * 9 * (7 * 3 * 3 + 9 * 3 + (8 + 6 * 4)):12240:669060
((2 + 4 * 9) * (6 + 9 * 8 + 6) + 6) + 2 + 4 * 2:13632:23340

93 lines [ Plain text ] [ ^Top ]

Advent of Code 2020 day 19 - Monster Messages

[ AoC problem link ] [ Discussion ].

Day 19 - part 1


#! /usr/bin/env perl
use Modern::Perl '2015';

# useful modules
use Test::More tests => 1;
use Time::HiRes qw/gettimeofday tv_interval/;
use Parse::RecDescent;
my $start_time = [gettimeofday];
#### INIT - load input data from file into array
my $testing = 0;
my @file_contents;
my $file = $testing ? 'test.txt' : 'input.txt';
open( my $fh, '<', "$file" );
while (<$fh>) { chomp; s/\r//gm; push @file_contents, $_; }

### CODE
my %rules;
my @messages;
foreach (@file_contents) {
    if (m/(\d+): (.*)/) {
        $rules{$1} = $2;
    }
    elsif (m/^[a|b]/) {
        push @messages, $_;
    }
}
say "messages: ", scalar @messages;
my $grammar = "startrule: r0\n";
foreach my $rule ( sort { $a <=> $b } keys %rules ) {

    # ensure only matches once
    my ($subrules) = $rules{$rule} =~ s/(\d+)/r$1\(1\)/g;
    $grammar .= 'r' . "$rule: $rules{$rule}\n";
}
say $grammar;

my $parser = new Parse::RecDescent($grammar) or die "bad grammar!\n";

# kludge to avoid excessive matches
my $maxlen = length('abbbaabbababbaaabaaaaaba');
my $count  = 0;
my @matches;
foreach my $msg (@messages) {
    if ( defined $parser->startrule($msg) ) {
        next if length($msg) > $maxlen;
        $count++;
        push @matches, $msg;
    }
}
say $count;
say "Duration: ", tv_interval($start_time) * 1000, "ms";

41 lines [ Plain text ] [ ^Top ]

Advent of Code 2020 day 20 - Jurassic Jigsaw

[ AoC problem link ] [ Discussion ].

Day 20 - complete solution


#! /usr/bin/env perl
use Modern::Perl '2015';

# useful modules
use List::Util qw/all/;
use Test::More tests => 2;
use Time::HiRes qw/gettimeofday tv_interval/;

my $start_time = [gettimeofday];
#### INIT - load input data from file into array
my $testing = 0;
my @file_contents;
my $file = $testing ? 'test.txt' : 'input.txt';
open( my $fh, '<', "$file" );
{
    local $/ = '';
    while (<$fh>) {
        chomp;
        push @file_contents, $_;
    }
}
### SUBS
sub transpose {    # https://perlmaven.com/transpose-a-matrix
    my ($M) = @_;
    my $T;
    for my $r ( 0 .. scalar @$M - 1 ) {
        for my $c ( 0 .. scalar @{ $M->[$r] } - 1 ) {
            $T->[$c][$r] = $M->[$r][$c];
        }
    }
    return $T;
}

sub rotate90 {     # https://stackoverflow.com/a/8664879
    my ($M) = @_;
    my $T = transpose($M);
    my $R;
    for my $r ( 0 .. scalar @$T - 1 ) {
        push @$R, [ reverse @{ $T->[$r] } ];
    }
    return $R;
}

sub flipH {        # flip around horisontal axis, up <-> down
    my ($M) = @_;
    my $F;
    my $maxr = scalar @$M - 1;
    for ( my $r = $maxr; $r >= 0; $r-- ) {
        push @$F, $M->[$r];
    }
    return $F;
}

sub flipV {        # flip around horisontal axis, left <-> right
    my ($M) = @_;
    my $F;
    for my $r ( 0 .. scalar @$M - 1 ) {
        push @$F, [ reverse @{ $M->[$r] } ];
    }
    return $F;
}

sub edges {
    my ($M) = @_;
    my $len = scalar @$M;    # implicitely square matrix
    my $res;

    # N, E, S, W
    $res->{N} = $M->[0];

    my $E;
    for my $r ( 0 .. $len - 1 ) {
        $E->[$r] = $M->[$r][ $len - 1 ];
    }
    $res->{E} = $E;

    # S
    $res->{S} = $M->[ $len - 1 ];

    # W
    my $W;
    for my $r ( 0 .. $len - 1 ) {
        $W->[$r] = $M->[$r][0];
    }
    $res->{W} = $W;
    return $res;

}
my %rotate = (
    '100' => sub { my ($m) = @_; return $m },
    '101' => sub { my ($m) = @_; return flipH($m) },
    '102' => sub { my ($m) = @_; return flipV($m) },
    '200' => sub { my ($m) = @_; return rotate90($m) },
    '201' => sub { my ($m) = @_; return flipH( rotate90($m) ) },
    '202' => sub { my ($m) = @_; return flipV( rotate90($m) ) },
    '300' => sub { my ($m) = @_; return rotate90( rotate90($m) ) },
    '400' =>
        sub { my ($m) = @_; return rotate90( rotate90( rotate90($m) ) ) },
);

sub all_edges {
    my ($M) = @_;
    my $all_edges;
    my $res;
    my $named;
    push @$all_edges, edges($M);
    push @$all_edges, edges( flipH($M) );
    push @$all_edges, edges( flipV($M) );

    my $T = rotate90($M);
    push @$all_edges, edges($T);
    push @$all_edges, edges( flipH($T) );
    push @$all_edges, edges( flipV($T) );

    push @$all_edges, edges( rotate90($T) );
    push @$all_edges, edges( rotate90( rotate90($T) ) );

    $named->{100}   = edges($M);
    $named->{'101'} = edges( flipH($M) );
    $named->{'102'} = edges( flipV($M) );
    $T              = rotate90($M);
    $named->{'200'} = edges($T);
    $named->{'201'} = edges( flipH($T) );
    $named->{'202'} = edges( flipV($T) );

    $named->{300} = edges( rotate90($T) );
    $named->{400} = edges( rotate90( rotate90($T) ) );

    for my $el (@$all_edges) {
        for my $k ( keys %$el ) {
            my @edge = @{ $el->{$k} };
            my @rev  = reverse @edge;
            $res->{ join( '', @edge ) }++;
            $res->{ join( '', @rev ) }++;
        }
    }
    return { canon => $res, named => $named };
}

sub dump_matrix {
    my ($M) = @_;
    for my $r (@$M) {
        say join( '', @$r );
    }
    say '';

}

sub dump_edges {
    my ($e) = @_;
    for (@$e) {
        say join( '', @{$_} );
    }
}

sub dump_string {
    my ($M) = @_;
    my $str;
    for (@$M) {
        $str .= join( '', @{$_} );
    }
    return $str;
}
my %tiles;
my %opposites = ( N => 'S', W => 'E', E => 'W', S => 'N' );

sub find_neighbors_by_edge {
    my ( $id, $image, $edge ) = @_;
    my $edges = edges($image);
    my $sought = join( '', @{ $edges->{$edge} } );
    my @results;
    my @neighbors = keys %{ $tiles{$id}{matches} };
    for my $nid (@neighbors) {
        my $n_edges = all_edges( $tiles{$nid}{matrix} )->{named};
        for my $or ( sort keys %{$n_edges} ) {
            for my $d (qw/N E S W/) {
                next unless $d eq $opposites{$edge};
                my $target = join( '', @{ $n_edges->{$or}{$d} } );
                if ( $target eq $sought ) {
                    push @results, [ $nid, $or ];
                }

            }
        }
    }
    return \@results;
}

sub strip_edges {
    my ($m) = @_;
    my $res;
    shift @$m;
    pop @$m;
    for my $r (@$m) {
        shift @$r;
        pop @$r;
        push @$res, $r;
    }
    return $res;
}
### CODE

for my $entry (@file_contents) {
    my @rows      = split( "\n", $entry );
    my $first_row = shift @rows;
    my ($id)      = ( $first_row =~ /(\d+)/ );

    my $matrix;
    for my $r (@rows) {
        push @$matrix, [ split //, $r ];

    }

    $tiles{$id}{matrix} = $matrix;
    $tiles{$id}{edges}  = all_edges($matrix)->{canon};
}

for my $id1 ( sort keys %tiles ) {
    my %edges1 = $tiles{$id1}{edges}->%*;
    for my $id2 ( sort keys %tiles ) {
        next if ( $id1 == $id2 );
        my $matches = 0;

        for my $e1 ( keys %edges1 ) {
            if ( exists $tiles{$id2}{edges}{$e1} ) {
                $tiles{$id1}{matches}{$id2} = $e1;
                $tiles{$id2}{matches}{$id1} = $e1;
            }
        }
    }
}

my $part1 = 1;
for my $k ( sort keys %tiles ) {
    if ( scalar keys $tiles{$k}{matches}->%* == 2 ) {
        $part1 *= $k;
        my %top_left;
        my %edges1 = %{ edges( $tiles{$k}{matrix} ) };
        for my $mid ( sort keys $tiles{$k}{matches}->%* ) {

            my %target_edges
                = %{ all_edges( $tiles{$mid}{matrix} )->{named} };
            for my $or ( keys %target_edges ) {
                my %edges2 = %{ $target_edges{$or} };
                for my $d1 (qw/N E S W/) {
                    if (join( '', @{ $edges1{$d1} } ) eq
                        join( '', @{ $edges2{ $opposites{$d1} } } ) )
                    {
                        $tiles{$k}{neighbors}{$d1}
                            = { id => $mid, or => $or };
                        $tiles{$mid}{neighbors}{ $opposites{$d1} }
                            = { id => $k, or => '000' };
                    }
                }
            }
        }
    }
}
if ($testing) {
    ok( $part1 == 20899048083289 );
}
else {
    is( $part1, 19955159604613, "Part 1: " . $part1 );
}

# build image map
my @Map;
my $top_left_id;
for my $k ( keys %tiles ) {
    if (    exists $tiles{$k}{neighbors}{E}
        and exists $tiles{$k}{neighbors}{S} )
    {
        $top_left_id = $k;
        $Map[0][0] = { id => $k, image => $tiles{$k}{matrix} };
        my $n = $tiles{$k}{neighbors}{E};

        my $image = $rotate{ $n->{or} }->( $tiles{ $n->{id} }{matrix} );
        $Map[0][1] = { id => $n->{id}, image => $image };
        last;
    }
    else {
        next;
    }
}

my $no_of_rows = sqrt( scalar keys %tiles );
if ( int($no_of_rows) != $no_of_rows ) {
    die "non-square number of tiles, algo won't work";
}

# build top row
for my $c ( 1 .. $no_of_rows - 1 ) {
    my $curr = $Map[0][ $c - 1 ];
    my $candidates
        = find_neighbors_by_edge( $curr->{id}, $curr->{image}, 'E' );
    die "can't find any candidates!" unless @$candidates;
    my $n = shift @$candidates;
    $Map[0][$c]->{id} = $n->[0];
    $Map[0][$c]->{image}
        = $rotate{ $n->[1] }->( $tiles{ $n->[0] }{matrix} );
}

# build left edge (West side)
for my $r ( 1 .. $no_of_rows - 1 ) {
    my $curr = $Map[ $r - 1 ][0];
    my $candidates
        = find_neighbors_by_edge( $curr->{id}, $curr->{image}, 'S' );
    die "can't find any candidates!" unless @$candidates;
    my $n = shift @$candidates;
    $Map[$r][0]->{id} = $n->[0];
    $Map[$r][0]->{image}
        = $rotate{ $n->[1] }->( $tiles{ $n->[0] }{matrix} );
}

# build rest of the map
for my $r ( 1 .. $no_of_rows - 1 ) {
    for my $c ( 1 .. $no_of_rows - 1 ) {
        my $curr = $Map[$r][ $c - 1 ];
        my $candidates
            = find_neighbors_by_edge( $curr->{id}, $curr->{image}, 'E' );
        die "can't find any candidates!" unless @$candidates;
        my $n = shift @$candidates;
        $Map[$r][$c]->{id} = $n->[0];
        $Map[$r][$c]->{image}
            = $rotate{ $n->[1] }->( $tiles{ $n->[0] }{matrix} );
    }
}

# build a giant matrix of the inner images, stripping "edges"
my $Img;
my $hashcount = 0;
for my $r ( 0 .. $no_of_rows - 1 ) {
    for my $c ( 0 .. $no_of_rows - 1 ) {
        my $inner = $Map[$r][$c]->{image};
        for my $r_i ( 1 .. 8 ) {
            for my $c_i ( 1 .. 8 ) {
                $hashcount++ if $inner->[$r_i][$c_i] eq '#';
                $Img->[ $r * 8 + $r_i - 1 ][ $c * 8 + $c_i - 1 ]
                    = $inner->[$r_i][$c_i];
            }
        }
    }
}

# find monsters
for my $rot ( sort keys %rotate ) {
    my $choppiness = $hashcount;
    my $I          = $rotate{$rot}->($Img);
    for my $r ( 0 .. ( $no_of_rows * 8 - 3 ) ) {
        for my $c ( 0 .. ( $no_of_rows * 8 - 20 - 1 ) ) {
            my @offset = (
                [ 0, 18 ], [ 1, 0 ],  [ 1, 5 ],  [ 1, 6 ],
                [ 1, 11 ], [ 1, 12 ], [ 1, 17 ], [ 1, 18 ],
                [ 1, 19 ], [ 2, 1 ],  [ 2, 4 ],  [ 2, 7 ],
                [ 2, 10 ], [ 2, 13 ], [ 2, 16 ]
            );
            if (all { $I->[ $r + $_->[0] ][ $c + $_->[1] ] eq '#' }
                @offset
                )
            {
                $choppiness = $choppiness - 15;
            }
        }
    }
    if ( $choppiness != $hashcount ) {    # we've found part 2!
        if ($testing) {
            is( $choppiness, 273, "Part 2: " . $choppiness );
        }
        else {
            is( $choppiness, 1639, "Part 2: " . $choppiness );
        }
    }
}

say "Duration: ", tv_interval($start_time) * 1000, "ms";

323 lines [ Plain text ] [ ^Top ]

Advent of Code 2020 day 21 - Allergen Assessment

[ AoC problem link ] [ Discussion ].

Day 21 - complete solution


#! /usr/bin/env perl
use Modern::Perl '2015';

# useful modules
use Test::More tests => 2;
use Time::HiRes qw/gettimeofday tv_interval/;

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

### CODE
my %ingredients;
my %allergens;
foreach my $line (@file_contents) {
    my @ins;
    my @alls;
    if ( $line =~ m/^(.*) \(contains (.*)\)$/ ) {
        @ins  = split( / /, $1 );
        @alls = split( ',', $2 );
        map {s/^\s+|\s+$//g} @alls;

        foreach my $in (@ins) {
            $ingredients{$in}->{num}++;
        }
        foreach my $al (@alls) {
            $allergens{$al}->{num}++;
            foreach my $i (@ins) {
                $allergens{$al}->{counts}->{$i}++;
            }
        }
    }
    else {
        die "can't parse: $line\n";
    }
}
my %possibles;
foreach my $al ( keys %allergens ) {
    foreach my $in ( keys %{ $allergens{$al}->{counts} } ) {
        if ( $allergens{$al}->{counts}->{$in} == $allergens{$al}->{num} ) {
            $possibles{$in}->{$al}++;
        }
    }
}

my $part1 = 0;
foreach my $in ( keys %ingredients ) {
    $part1 += $ingredients{$in}->{num} unless exists $possibles{$in};
}
is( $part1, 2461, "Part 1: " . $part1 );

# part 2

my %solution;

# this part cribbed from 2018D16 and 2020D16
while ( keys %possibles ) {
    foreach my $ing ( keys %possibles ) {
        if ( scalar keys %{ $possibles{$ing} } == 1 ) {
            my $al = ( keys %{ $possibles{$ing} } )[0];
            $solution{$ing} = $al;
            delete $possibles{$ing};
        }

        while ( my ( $k, $al ) = each %solution ) {
            foreach my $v ( keys %{ $possibles{$ing} } ) {
                if ( $v eq $al ) {
                    delete $possibles{$ing}->{$v};
                }
            }
        }
        if ( scalar keys %{ $possibles{$ing} } == 0 ) {
            delete $possibles{$ing};
        }
    }
}
my @part2 = ();
foreach my $in ( sort { $solution{$a} cmp $solution{$b} } keys %solution ) {
    push @part2, $in;
}
my $answer_str = join( ',', @part2 );
is( $answer_str, 'ltbj,nrfmm,pvhcsn,jxbnb,chpdjkf,jtqt,zzkq,jqnhd',
    "Part 2: ok" );
say "Duration: ", tv_interval($start_time) * 1000, "ms";

73 lines [ Plain text ] [ ^Top ]

Advent of Code 2020 day 22 - Crab Combat

[ AoC problem link ] [ Discussion ].

Day 22 - complete solution


#! /usr/bin/env perl
use Modern::Perl '2015';

# useful modules
use List::Util qw/max/;
use Test::More tests => 2;
use Time::HiRes qw/gettimeofday tv_interval/;

my $start_time = [gettimeofday];
#### INIT - load input data from file into array
my $game_no = 0;
my $testing = 0;
my @file_contents;
my $file = $testing ? 'test.txt' : 'input.txt';
open( my $fh, '<', "$file" );
{
    local $/ = '';
    while (<$fh>) {
        chomp;
        push @file_contents, $_;
    }
}
### SUBS

sub score {
    my ($d) = @_;
    return 0 unless @$d;
    my $score  = 0;
    my $factor = 1;
    while (@$d) {
        $score += $factor * pop @$d;
        $factor++;
    }
    return $score;
}

sub make_state {
    my ( $d0, $d1 ) = @_;
    return join( ',', @$d0 ) . ':' . join( ',', @$d1 );
}

# this code courtesy of /u/musifter at https://www.reddit.com/r/adventofcode/comments/khyjgv/2020_day_22_solutions/ggo7v7a/
sub recurse_game {
    my ( $depth, $d0, $d1 ) = @_;
    my %states;
    $game_no++;
    print "Starting game $game_no at depth $depth\r"
        if ( $game_no % 100 == 0 );

    while ( @$d0 and @$d1 ) {
        my $curr_state = make_state( $d0, $d1 );
        if ( exists $states{$curr_state} ) {
            return ( ( $depth > 0 ) ? 0 : score(@$d0) );
        }
        $states{$curr_state}++;

        my $c0 = shift @$d0;
        my $c1 = shift @$d1;

        my $winner;
        if ( ( $c0 <= scalar @$d0 ) and $c1 <= scalar @$d1 ) {
            my $new_d0 = [ map { $d0->[$_] } ( 0 .. $c0 - 1 ) ];
            my $new_d1 = [ map { $d1->[$_] } ( 0 .. $c1 - 1 ) ];
            $winner = recurse_game( $depth + 1, $new_d0, $new_d1 );
        }
        elsif ( $c0 > $c1 ) {
            $winner = 0;
        }
        else {
            $winner = 1;
        }
        if ( $winner == 0 ) {
            push @$d0, ( $c0, $c1 );
        }
        else {
            push @$d1, ( $c1, $c0 );
        }
    }
    if ( $depth > 0 ) {
        return ( @$d0 ? 0 : 1 );
    }
    else {
        return max( score( $d0, $d1 ) );
    }

}

### CODE
# part 1
my @decks;
foreach (@file_contents) {
    my @data = split( "\n", $_ );
    shift @data;
    push @decks, [@data];
}

foreach (@decks) {
    say join( ',', map { sprintf( "%2d", $_ ) } ( $_->@* ) );
}
while ( $decks[0]->@* and $decks[1]->@* ) {
    my $c0 = shift $decks[0]->@*;
    my $c1 = shift $decks[1]->@*;

    if ( $c0 > $c1 ) {
        push $decks[0]->@*, ( $c0, $c1 );
    }
    else {
        push $decks[1]->@*, ( $c1, $c0 );
    }
}
my $part1 = max( map { score($_) } @decks );
is( $part1, 33561, "Part 1: " . $part1 );

# part2
# reload decks
@decks = ();
foreach (@file_contents) {
    my @data = split( "\n", $_ );
    shift @data;
    push @decks, [@data];
}
my $part2 = recurse_game( 0, $decks[0], $decks[1] );
print "\n";
is( $part2, 34594, "Part 2: " . $part2 );

say "Duration: ", tv_interval($start_time) * 1000, "ms";

103 lines [ Plain text ] [ ^Top ]

Advent of Code 2020 day 23 - Crab Cups

[ AoC problem link ] [ Discussion ].

Day 23 - part 1


#! /usr/bin/env perl
use Modern::Perl '2015';

# useful modules
use List::AllUtils qw/sum max min first_index/;
use Data::Dump qw/dump/;
use Test::More tests => 1;
use Time::HiRes qw/gettimeofday tv_interval/;

my $start_time = [gettimeofday];
#### INIT - load input data from file into array
my $debug   = 0;
my $testing = 0;
my @file_contents;

my $input = $testing ? '389125467' : '942387615';

### CODE
my @cups = split( //, $input );
my ( $minlabel, $maxlabel ) = ( min(@cups), max(@cups) );
my $no_of_cups = scalar @cups;
my $round      = 0;
my $currpos    = 0;
my $currlabel  = $cups[$currpos];
my ( $destlabel, $destpos ) = ( '', 0 );

while ( $round < 100 ) {
    if ($debug) {
        say "-- round $round --";
        say '    ' . join( ' ', ( 0 .. $#cups ) );
        say "L=> " . join( ',', @cups );

    }

    my @pickup;
    my %seen;
    foreach ( 1, 2, 3 ) {
        my $target = ( $currpos + 1 );
        if ( $target > $#cups ) {
            $target = 0;
        }
        my $val = splice( @cups, $target, 1 );
        push @pickup, $val;
        $seen{$val}++;
    }
    say "P=> " . join( ',', @pickup ) if $debug;

    $destlabel = $currlabel - 1;
    if ( $destlabel < $minlabel ) {
        $destlabel = $maxlabel;
    }
    while ( exists $seen{$destlabel} ) {
        $destlabel--;
        if ( $destlabel < $minlabel ) {
            $destlabel = $maxlabel;
        }
    }
    $currpos   = ( $currpos + 1 ) % $no_of_cups;
    $currlabel = $cups[$currpos];
    if ( !defined $currlabel ) {
        $currlabel = $cups[0];
    }

    #    $currlabel = $cups[$currpos];
    say "    currpos: $currpos currlabel: $currlabel destlabel: $destlabel"
        if $debug;

    $destpos = first_index { $_ == $destlabel } @cups;
    say "    destlabel: $destlabel destpos: $destpos" if $debug;
    foreach ( 1, 2, 3 ) {
        my $target = ( $destpos + 1 ) % $no_of_cups;
        my $val    = pop @pickup;
        splice( @cups, $target, 0, $val );
    }

    # adjust the array around the current position
    my $index = first_index { $_ == $currlabel } (@cups);
    say "    index: $index currpos: $currpos" if $debug;
    if ( $index > $currpos ) {

        while ( $index > $currpos ) {
            my $offset = shift @cups;
            push @cups, $offset;
            say "    " . join( ' ', @cups ) if $debug;
            $index = first_index { $_ == $currlabel } @cups;
        }
    }
    elsif ( $index < $currpos ) {
        while ( $index < $currpos ) {
            my $offset = pop @cups;
            unshift @cups, $offset;
            say "    " . join( ' ', @cups ) if $debug;
            $index = first_index { $_ == $currlabel } @cups;
        }
    }
    say "R=> " . join( ',', @cups ) if $debug;
    $round++;

}
my $ptr = first_index { $_ == 1 } @cups;
$ptr++;
my $count = 0;
my $res   = '';
while ( $count < $#cups ) {
    $res .= $cups[$ptr];
    $ptr = ( $ptr + 1 ) % $no_of_cups;
    $count++;
}
is( $res, 36542897, "Part 1: " . $res );
say "Duration: ", tv_interval($start_time) * 1000, "ms";

93 lines [ Plain text ] [ ^Top ]

Day 23 - part 2


#! /usr/bin/env perl
use Modern::Perl '2015';

# useful modules
use Test::More tests=>1;
use Time::HiRes qw/gettimeofday tv_interval/;

my $start_time = [gettimeofday];
#### INIT - load input data from file into array
my $testing = 0;
my $input = $testing ? '389125467' : '942387615';
### CODE
my @circle;
my @input_ary = split( //, $input );

my $first = $input_ary[0];
my $last  = $input_ary[-1];
my $prev  = $first;
for my $i ( 1 .. $#input_ary ) {

    $circle[$prev] = $input_ary[$i];
    $prev = $input_ary[$i];
}
for my $j ( 10 .. 1_000_000 ) {
    $circle[$prev] = $j;
    $prev = $j;
}
$circle[1_000_000] = $first;
printf(
    "1: %d val1: %d 50: %d 500_000: %d 999999: %d\n",
    $circle[1], $circle[ $circle[1] ],
    $circle[50], $circle[500000], $circle[999999]
);


for my $turn ( 1 .. 10_000_000 ) {
    say "==> $turn" if $turn % 500_000 == 0;
    my $pointer = $first;
    my %pickup = ( 0 => 1 );
    for ( 1 .. 3 ) {
        $pointer = $circle[$pointer];
        $pickup{$pointer} = 1;
    }

    my $dest = $first - 1;
    while ( exists $pickup{$dest} ) {
        $dest = ( $dest - 1 ) % 1_000_001;
    }

    my $new_first   = $circle[$pointer];
    my $new_pointer = $circle[$dest];
    my $new_dest    = $circle[$first];
    $circle[$first]   = $new_first;
    $circle[$pointer] = $new_pointer;
    $circle[$dest]    = $new_dest;

    $first = $circle[$first];
}
printf(
    "1: %d val1: %d 50: %d 500_000: %d 999999: %d\n",
    $circle[1], $circle[ $circle[1] ],
    $circle[50], $circle[500000], $circle[999999]
);

my $part2 = $circle[1] * ( $circle[ $circle[1] ] );

is( $part2, 562136730660, "Part 2: ".$part2);
say "Duration: ", tv_interval($start_time) * 1000, "ms";

53 lines [ Plain text ] [ ^Top ]

Advent of Code 2020 day 24 - Lobby Layout

[ AoC problem link ] [ Discussion ].

Day 24 - complete solution


#! /usr/bin/env perl
use Modern::Perl '2015';

# useful modules
use Clone qw/clone/;
use Test::More tests => 2;
use Time::HiRes qw/gettimeofday tv_interval/;

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

my $Map;
my $newMap;

# x,y,z coordinates - see https://www.redblobgames.com/grids/hexagons/
# these hexes are "pointy", the flat sides are E and W
my %move = (
    e  => sub { [  1, -1,  0 ] },
    ne => sub { [  1,  0, -1 ] },
    se => sub { [  0, -1,  1 ] },
    w  => sub { [ -1,  1,  0 ] },
    sw => sub { [ -1,  0,  1 ] },
    nw => sub { [  0,  1, -1 ] },
);

sub count_map {
    my ($M) = @_;
    my $count = 0;
    for my $x ( keys %{$M} ) {
        for my $y ( keys %{ $M->{$x} } ) {
            for my $z ( keys %{ $M->{$x}->{$y} } ) {
                say "[$x,$y,$z] ", $M->{$x}{$y}{$z} if $debug;
                $count++ if $M->{$x}{$y}{$z} == 1;
            }
        }
    }
    return $count;
}

sub count_neighbors {
    my ( $x, $y, $z ) = @_;

    #    my $p = [$x,$y,$z];
    my $res;
    foreach my $d (qw/e w ne nw se sw/) {
        my $m = $move{$d}->();
        if ( !exists $Map->{ $x + $m->[0] }{ $y + $m->[1] }{ $z + $m->[2] } )
        {    # implicit white
            $res->{white}++;
        }
        elsif ( $Map->{ $x + $m->[0] }{ $y + $m->[1] }{ $z + $m->[2] } == 0 )
        {    # explicit white
            $res->{white}++;
        }
        elsif ( $Map->{ $x + $m->[0] }{ $y + $m->[1] }{ $z + $m->[2] } == 1 )
        {    # explicit black
            $res->{black}++;
        }
        else {    # wut
            die "can't read value at position ["
                . join( ',', $x + $m->[0], $y + $m->[1], $z + $m->[2] )
                . "]\n";
        }
    }
    return $res;
}

### CODE
foreach my $line (@file_contents) {

    #    say $line;
    my @dirs = $line =~ m/(e|w|ne|nw|se|sw)/g;
    my $pos = [ 0, 0, 0 ];
    foreach my $d (@dirs) {
        my $move = $move{$d}->();
        map { $pos->[$_] += $move->[$_] } ( 0 .. 2 );
    }
    if ( !exists $Map->{ $pos->[0] }{ $pos->[1] }{ $pos->[2] } )
    {    # never visited
        $Map->{ $pos->[0] }{ $pos->[1] }{ $pos->[2] } = 1;    # turn black
    }
    elsif ( $Map->{ $pos->[0] }{ $pos->[1] }{ $pos->[2] } == 1 )
    {                                                         # visited, black
        $Map->{ $pos->[0] }{ $pos->[1] }{ $pos->[2] } = 0;    # turn white
    }
    else {                                                    # visited, white
        $Map->{ $pos->[0] }{ $pos->[1] }{ $pos->[2] } = 1     # turn black
    }
}

my $count = count_map($Map);
is( $count, 307, "Part 1: " . $count );

# part 2

$newMap = clone($Map);

#say dump $Map;
my $day = 0;
while ( $day < 100 ) {
    printf( "day %2d: %4d\n", $day, count_map($Map) ) if $day % 10 == 0;
    for my $x ( keys %{$Map} ) {
        for my $y ( keys %{ $Map->{$x} } ) {
            for my $z ( keys %{ $Map->{$x}{$y} } ) {

                # cycle thru current position and neighbors
                no warnings 'uninitialized';
                my @points = ( [ $x, $y, $z ] );

                foreach my $d (qw/e w ne nw se sw/) {
                    my $point = [ $x, $y, $z ];
                    my $m = $move{$d}->();
                    map { $point->[$_] += $m->[$_] } ( 0 .. 2 );
                    push @points, $point;
                }
                foreach my $p (@points) {
                    my $r = count_neighbors(@$p);

                    if ( !defined $Map->{ $p->[0] }{ $p->[1] }{ $p->[2] }
                        or $Map->{ $p->[0] }{ $p->[1] }{ $p->[2] } == 0 )
                    {
                        if ( $r->{black} == 2 ) {
                            $newMap->{ $p->[0] }{ $p->[1] }{ $p->[2] } = 1;
                        }
                        else {
			    # this is a white tile, we don't need to keep it
                            delete $newMap->{ $p->[0] }{ $p->[1] }{ $p->[2] };
                        }
                    }
                    elsif ( $Map->{ $p->[0] }{ $p->[1] }{ $p->[2] } == 1 ) {
                        if ( $r->{black} == 0 or $r->{black} > 2 ) {
			    # turn white -> remove from the set of tiles
                            delete $newMap->{ $p->[0] }{ $p->[1] }{ $p->[2] };
                        }
                    }
                }
            }
        }
    }
    $Map = clone($newMap);

    $day++;
}
my $part2 = count_map($Map);
is( $part2, 3787, "Part 2: " . $part2 );
say "Duration: ", tv_interval($start_time) * 1000, "ms";

127 lines [ Plain text ] [ ^Top ]

Advent of Code 2020 day 25 - Combo Breaker

[ AoC problem link ] [ Discussion ].

Day 25 - complete solution


#! /usr/bin/env perl
use Modern::Perl '2015';

# useful modules
use Test::More tests => 1;
use Time::HiRes qw/gettimeofday tv_interval/;

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

### CODE
my ( $cardkey, $doorkey ) = @file_contents;
my ( $cardval, $doorval ) = ( 1, 1 );
my $subject_nr = 7;
my ( $cardloop, $doorloop ) = ( undef, undef );
my $loop = 1;
while ( !$cardloop and !$doorloop ) {
    if ( !$cardloop ) {
        $cardval = $cardval * $subject_nr;
        $cardval = $cardval % 20201227;

        if ( $cardval == $cardkey ) {
            $cardloop = $loop;
        }
    }
    if ( !$doorloop ) {
        $doorval = $doorval * $subject_nr;
        $doorval = $doorval % 20201227;
        if ( $doorval == $doorkey ) {
            $doorloop = $loop;
        }
    }
    $loop++;
}

$loop       = 1;
$subject_nr = $doorkey;
$cardval    = 1;
while ( $loop <= $cardloop ) {
    $cardval = $cardval * $subject_nr;
    $cardval = $cardval % 20201227;
    $loop++;
}
is( $cardval, 290487, "Answer is: " . $cardval );
done_testing();
say "Duration: ", tv_interval($start_time) * 1000, "ms";

42 lines [ Plain text ] [ ^Top ]

Generated on Thu Dec 31 12:56:03 2020 UTC.