Discussion on: AoC Day 16: Chronal Classification

View post

Fortunately, much easier than yesterday, it would have ruined my Advent otherwise.

I started implementing the dispatch table for the opcodes like this

    addr => sub { $r[ $_[2] ] = $r[ $_[0] ] + $r[ $_[1] ] },
    addi => sub { $r[ $_[2] ] = $r[ $_[0] ] + $_[1] },
    ...

but it was a lot of repetitive typing, so I let Perl generate the code for me from simpler strings.

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

my %opcodes = (
    addr => 'rc=ra+rb',  addi => 'rc=ra+vb',
    mulr => 'rc=ra*rb',  muli => 'rc=ra*vb',
    banr => 'rc=ra&rb',  bani => 'rc=ra&vb',
    borr => 'rc=ra|rb',  bori => 'rc=ra|vb',
    setr => 'rc=ra',     seti => 'rc=va',
    gtir => 'rc=va>rb',  gtri => 'rc=ra>vb',  gtrr => 'rc=ra>rb',
    eqir => 'rc=va==rb', eqri => 'rc=ra==vb', eqrr => 'rc=ra==rb',
);

my @r;
for (values %opcodes) {
    s/v//g;
    s/([abc])/'$_[' . (ord($1) - 97) . ']'/ge;
    s/r([^\]]+\])/\$r[$1]/g;
    $_ = eval "sub{$_}";
}

The rest of part 1 was easy: for each input case, just count how many opcodes modify all the registers in the given way and keep a count of the cases where there were at least 3 such opcodes.

my $count;
local $/ = "";
while (<>) {
    my @registers_before = /Before: \[(\d+), (\d+), (\d+), (\d+)\]/;
    my @registers_after  = /After:  \[(\d+), (\d+), (\d+), (\d+)\]/;
    my @code = /(\d+) (\d+) (\d+) (\d+)/;
    last unless @registers_before;

    my $number_of_opcodes = 0;
    for my $opcode (keys %opcodes) {
        @r = @registers_before;
        $opcodes{$opcode}->(@code[1, 2, 3]);
        my $same = grep $r[$_] == $registers_after[$_], 0 .. $#r;
        ++$number_of_opcodes if @r == $same;
    }
    ++$count if $number_of_opcodes >= 3;
}

say $count;

For part 2, I collected all the guesses for each instruction number, and kept removing those that only had one solution until I knew all of them. Then I just translated each instruction number to the opcode and ran it.

my %guess;
$guess{$_} = { map +($_ => undef), keys %opcodes }
    for 0 .. (keys %opcodes) - 1;
my $program;
local $/ = "";
while (<>) {
    my @registers_before = /Before: \[(\d+), (\d+), (\d+), (\d+)\]/;
    my @registers_after  = /After:  \[(\d+), (\d+), (\d+), (\d+)\]/;
    my @code = /(\d+) (\d+) (\d+) (\d+)/;
    $program = $_, last unless @registers_before;

    my $number_of_opcodes = 0;
    for my $opcode (keys %opcodes) {
        @r = @registers_before;
        $opcodes{$opcode}->(@code[1, 2, 3]);
        my $same = grep $r[$_] == $registers_after[$_], 0 .. $#r;
        delete $guess{ $code[0] }{$opcode} unless $same == @r;
    }
}

my %know;
while (grep keys %$_ > 1, values %guess) {
    my @single = grep 1 == keys %{ $guess{$_} }, keys %guess;
    for my $single (@single) {
        $know{$single} = (keys %{ $guess{$single} })[0];
        delete $_->{ $know{$single}  } for values %guess;
    }
}
keys %{ $guess{$_} } or delete $guess{$_} for keys %guess;
for my $left (keys %guess) {
    $know{$left} = (keys %{ $guess{$left} })[0];
}

@r = (0) x 4;
while ($program =~ /(\d+) (\d+) (\d+) (\d+)/g) {
    $opcodes{ $know{$1} }->($2, $3, $4);
}
say $r[0];