Advent of Code 2023: 25x2 coding puzzles for December

It’s (almost)December, which means it’s (almost)time for Advent of Code!

If you’re not familiar, here’s a quick synopsis, courtesy of @gadgetgirl:

More information can be found on their website.

This isn’t the first time we’ve done this, here are links to the previous years’ discussions:

I’ve set up a private leaderboard which can view if you’re logged in and joined. You can be a member in more than one, so don’t worry about that, but be aware that your name will appear as it does on the Advent of Code website. In other words, it could show your real name. I login via GitHub for this group, and via Google for work. If you want to join this leaderboard, the code is 256706-bb2717ff. If you’ve joined in a previous year, you don’t have to join again.

I’ll tag some others that have been active in years past:

Please feel free to include anyone else you think my be interested.

I set up a gitlab repo in 2018, and I am inconsistent at updating it, but feel free to follow along. My goal is for it to be a full CI setup so that I can check in code and it builds it, tests it, and then runs it. It’s mostly working at this point, so check it out if you’re interested in that sort of thing.

I had ambitions to create a yeoman template for my decidedly opinionated way to approach this event, but it’s stalled and unfinished at the moment. Maybe if I can keep up this year, I’ll be motivated to finish it up. I’m likely biting off more than I can chew this year, though, so I’m making no promisies.

I did 2018’s puzzles in Python (and C#?) and I did 2019’s puzzles in C#. I’m pretty sure I only did 2020 in Python, and definitely did 2021 and 2022 in Python. I’ve used PyCharm in the past, but switched over to Visual Studio Code since 2021, and I’d recommend it for anyone who hasn’t tried it yet, both for Python as well as many other uses.

One of the things I like about Advent of Code is that it is language agnostic, so you can work in whatever you’re most comfortable with. The puzzles are oriented around programming, but people have been known to use spreadsheets in the past.

Feel free to post questions and solutions in this thread, but please be kind and blur out any spoilers.

Please note that this year they’ve added a request regarding AI/LLMs:

Can I use AI to get on the global leaderboard? Please don’t use AI / LLMs (like GPT) to automatically solve a day’s puzzles until that day’s global leaderboards are full. By “automatically”, I mean using AI to do most or all of the puzzle solving, like handing the puzzle text directly to an LLM. The leaderboards are for human competitors; if you want to compare the speed of your AI solver with others, please do so elsewhere. (If you want to use AI to help you solve puzzles, I can’t really stop you, but I feel like it’s harder to get better at programming if you ask an AI to do the programming for you.)

It’s pretty much their same policy regarding streaming your solutions.

There’s also a very active subreddit, but I probably don’t need to tell you that.

2 Likes

Ok… Day 1, and I’ve already simultaneously overthought and underthought the puzzle.

Implied, but not really spelled out by the puzzle: if there is only one digit, double it to be both first and last.

Then, when nothing I did would work, I naively jumped to conclusions and made additional work for myself that wasn’t needed in part 1.

:man_facepalming:

My day 1 part 2 perl code result

(Part 1 is identical, but without the lines that replace words with digits)

 my @input = <>;
chomp @input;

my $result = 0;
foreach $line (@input) {
    my $value = 0;

    $line =~ s/one/o1e/g;
    $line =~ s/two/t2o/g;
    $line =~ s/three/t3e/g;
    $line =~ s/four/4/g;
    $line =~ s/five/5e/g;
    $line =~ s/six/6/g;
    $line =~ s/seven/7n/g;
    $line =~ s/eight/e8t/g;
    $line =~ s/nine/n9e/g;
    $line =~ s/zero/0o/g;

    $line =~ s/\D//g;
    $value = substr($line, 0, 1) . substr($line, -1, 1);

    $result += $value;
}

print $result;

My method for getting the first and last digit was actually inspired by hearing my SO thinking through the problem after I’d completed it. Once you remove everything that’s not a digit, you can just grab the start and end of that string, and it’ll take care of the number doubling if there’s only one digit. Much cleaner than the regex-and-special-case-test that I started with! If I were being a stickler I’d add error checking for things like the possibility of no digits, but I can’t be bothered.

2 Likes

That’s a very clever and perl-like (is there a equivalent for pythonic?) solution.

It never occurred to me to modify the string before parsing it, either by replacing the number words or removing the alphas afterwards and then just grabbing the first and last.

Here's my relatively simple solution to part one:
    def decode_numeric(self, coded_value):
        digits = ''.join(filter(str.isdigit, coded_value))
        return int(''.join([digits[0],digits[-1]]))

    def calibration_sum_numeric(self, coded_values):
        decoded_values = [self.decode_numeric(v) for v in coded_values]
        return sum(decoded_values)

Actually, it does look a lot like your solution. I’m filtering out any non-digits and then grabbing the first and last. I spent so much time on part two that I forgot how simple it could be.

Here's my overly complicated solution to part two:
    digit_table = {'one': '1', 'two': '2', 'three': '3', 'four': '4', 'five': '5', 'six': '6', 'seven': '7', 'eight': '8', 'nine': '9'}

    def decode_alphanumeric(self, coded_value):
        numerics = [*self.digit_table.values()]
        alphas = [*self.digit_table]
        alphaNumerics = alphas + numerics
        results = {}
        for a in alphaNumerics:
            for k in Utility.find_all(coded_value, a):
                results = results | {k : a}
        if len(results.items()) == 1:
            first_index = last_index = min([*results])
        else:
            first_index = min(*results)
            last_index = max(*results)
        return int(''.join([self.get_digit(results[first_index]), self.get_digit(results[last_index])]))
    
    def get_digit(self, proposed_digit):
        return proposed_digit if str.isdigit(proposed_digit) else self.digit_table[proposed_digit]
  
    def calibration_sum_alphanumeric(self, coded_values):
        decoded_values = [self.decode_alphanumeric(v) for v in coded_values]
        return sum(decoded_values)

By not just replacing any words with their numeric equivalent, I created a way more complicated parsing scenario. If I had just done a replacement pass, I could have just used the existing code for the remaining. Oh well…
The two edge cases that caught me in this implementation were handling inputs where only a single digit was present (abc5def = 55), and when there were duplicate matches (five1five = 55). Since the built-in find method in Python only finds the first match, I ended up using a find_all implementation I found on SO.

On to day 2…

1 Like

Oh, wow, I don’t think I was aware of the “hide details” thing… that makes for a much cleaner post!

Yet again, I really need to dig into python more - your examples always seem much more compact than mine.

Day 2 seemed pretty straightforward, shouldn’t have anything crazy.

Day 3 reminded me of how rusty my coding skills are, I had to refresh my memory on array/hash handling, and then spent a silly amount of time wrapping my head around what I was trying to do. Now that it’s done I’m thinking there’s much better ways to do it, I think I need to revive an earlier project I was doing of building utility functions for some of the things they like to put into these…

My day 3 part 1

The blob of hard-coded stuff to look at the cells around a specified cell always makes me cringe, but I couldn’t think of a better way. I did at least realize partway through that bounds checking would be far cleaner if I abstracted the test into its own sub.

my @input = <>;
chomp @input;

my $result = 0;
my @array;

foreach $line (@input) {
    my @vals = split(//, $line);
    push(@array, \@vals);
}

for($y = 0; $y <= $#array; $y++) {
    for($x = 0; $x <= $#{@array[$y]}; $x++) {
        my($add) = 0;
        my($num) = "";
        while($array[$y][$x] =~ /\d/){
            $num = $num . $array[$y][$x];
            if($add == 0) {
                $add += symbolcheck($y, $x-1);
                $add += symbolcheck($y-1, $x-1);
                $add += symbolcheck($y+1, $x-1);
                $add += symbolcheck($y-1, $x);
                $add += symbolcheck($y+1, $x);
                $add += symbolcheck($y-1, $x+1);
                $add += symbolcheck($y+1, $x+1);
                $add += symbolcheck($y, $x+1);
            }
            $x = $x+1;
            if($x > $#{@array[$y]}) { last; }
        }
        if($add > 0) { $result += $num;}
    }
}

print "Total part numbers: $result\n";

sub symbolcheck {
    my($y, $x) = @_;
    if(($y < 0) || ($y > $#array)) { return 0; }
    if(($x < 0) || ($x > $#{@array[$y]})) { return 0; }
    if(! (($array[$y][$x] =~ /\d/) || ($array[$y][$x] eq "."))) { return 1; }
    return 0;
}
My day 3 part 2

This got messy because I didn’t want to re-write things completely to focus on the symbols first. Tracking things with a hash was my quick-and-dirty solution to just get it over with.

my @input = <>;
chomp @input;

my $result = 0;
my @array;
my %gears;

foreach $line (@input) {
    my @vals = split(//, $line);
    push(@array, \@vals);
}

for($y = 0; $y <= $#array; $y++) {
    for($x = 0; $x <= $#{@array[$y]}; $x++) {
        my($add) = 0;
        my($gear) = "";
        my($num) = "";
        while($array[$y][$x] =~ /\d/){
            $num = $num . $array[$y][$x];
            if(symbolcheck($y, $x-1)) { $gear = $y . ":" . ($x-1); }
            if(symbolcheck($y-1, $x-1)) { $gear = ($y-1) . ":" . ($x-1); }
            if(symbolcheck($y+1, $x-1)) { $gear = ($y+1) . ":" . ($x-1); }
            if(symbolcheck($y-1, $x)) { $gear = ($y-1) . ":" . $x; }
            if(symbolcheck($y+1, $x)) { $gear = ($y+1) . ":" . $x; }
            if(symbolcheck($y-1, $x+1)) { $gear = ($y-1) . ":" . ($x+1); }
            if(symbolcheck($y+1, $x+1)) { $gear = ($y+1) . ":" . ($x+1); }
            if(symbolcheck($y, $x+1)) { $gear = $y . ":" . ($x+1); }
            $x = $x+1;
            if($x > $#{@array[$y]}) { last; }
        }
        if($gear ne "") { $gears{$gear}{$num} = 1; }
    }
}

foreach my $gear (keys %gears){
    if(keys %{$gears{$gear}} == 2){
        my($first, $second) = keys %{$gears{$gear}};
        my $ratio = $first * $second;
        $result += $ratio;
    }
}
print "Total of ratios: $result\n";

sub symbolcheck {
    my($y, $x) = @_;
    if(($y < 0) || ($y > $#array)) { return 0; }
    if(($x < 0) || ($x > $#{@array[$y]})) { return 0; }
    if($array[$y][$x] eq "*") { return 1; }
    return 0;
}

I may throw together a utility function to take a cell location and a length, and return a small slice with just those cells and the ones immediately around them. AoC seems to really like puzzles that require testing just those surrounds, and if I’d just isolated the block each number was in I could have done a quick search of three strings rather than doing 8 tests for each digit and wastefully repeating tests.

While doing some refresher reading, I stumbled on something that simplified my day 3 a lot.

Simplified day 3 part 1

Apparently it’s pretty easy to capture matches and their location in a string with regex, and I’ve never run across it before. My bounds checking is a little ugly, but better than the mess I had before.

my @input = <>;
chomp @input;

my $result = 0;

for($y = 0; $y <= $#input; $y++) {
    #Search for each group of numbers in each line and capture the group and position
    while($input[$y] =~ /(\d+)\D*/g) {
        my($num, $pos) = ($1, $-[0]);

        #Search area around number (being aware of array bounds) for a symbol
        for(my $ay = ($y > 0 ? $y - 1 : 0); $ay <= ($y + 1 <= $#input ? $y + 1 : $y); $ay++) {
            if(findchar($input[$ay], $pos - 1, $pos + length($num))) { $result += $num; last; }
        }
    }
}

print "Total sum of part numbers: $result\n";

#search line for non-digit, non-"." that is within range
sub findchar {
    my($line, $start, $end) = @_;
    while($line =~ /([^\d\.])/g) {
        if($-[0] >= $start && $-[0] <= $end) { return 1; }
    }
}
1 Like

Also, if you put a language after your starting code fence, it does syntax highlighting.

c:

#include <stdio.h>

int main() {
printf("Hello World");
return 0;
}

c#:

namespace HelloWorld
{
	class Hello {		 
		static void Main(string[] args)
		{
			System.Console.WriteLine("Hello World");
		}
	}
}

Python:

print("Hello World")

Perl:

#!/usr/bin/perl
print "Hello World";

Examples taken from "Hello World" In 30 Different Languages - GeeksforGeeks

1 Like

I’m not entirely sure I know what you mean there… Originally I tried adding a class to the code tag based on a Disqus help article on syntax highlighting, but that didn’t seem to do anything.

Sorry. It looks like this:

```perl
#!/usr/bin/perl
print "Hello World";
```
1 Like

Ah, gotcha. When I was searching around for info on how to post code, all I found was
<pre><code>code here</code></pre>.
The backticks is much easier. :slight_smile:

1 Like

Day 4… part 1 seemed pretty easy, but I ran into some stupid bugs.
Part 2… the description is pretty convoluted, and there is a ton of data to chew through.

Once I finally got something written, it worked fine for the test data but wouldn’t work for the full input. Turned out I had a really silly bug in my parsing of card numbers, which somehow caused no issues on the test input? I’m still trying to work out why. A word of caution: the numbers in the input are all fixed size and right-justified to make the input a fixed width, and the field sizes can change between test input and full input.

Day 4 part 1
my @input = <>;
chomp @input;

my $result = 0;

foreach $line (@input) {
    my %winners;
    my $cardtotal = 0;

    my ($card, $nums) = split(/:/, $line);
    if($card =~ /^Card\s+(\d+)$/) { $card = $1; }
    my($wins, $have) = split(/\|/, $nums);
    while($wins =~ /(\d+)\D*/g) {
        $winners{$1} = 1;
    }
    while($have =~ /(\d+)\D*/g) {
        if($winners{$1} == 1) {
            if($cardtotal == 0) { $cardtotal = 1; }
            else { $cardtotal = $cardtotal * 2; }
        }
    }
    $result += $cardtotal;
}

print "Total of all cards: $result\n";
Day 4 part 2

I resorted to recursion for this one… I felt like it might be possible to calculate this at the same time as reading the input, but I’m not sure.

my @input = <>;
chomp @input;

my $result = 0;
my %cards;
my $numcards = 0;

foreach $line (@input) {
    my %winners;
    my $cardtotal = 0;

    my ($card, $nums) = split(/:/, $line);
    if($card =~ /^Card\s+(\d+)$/) { $card = $1; }

    my($wins, $have) = split(/\|/, $nums);

    while($wins =~ /(\d+)\D*/g) {
        $cards{$card}{wins}{$1} = 1;
    }

    while($have =~ /(\d+)\D*/g) {
        $cards{$card}{have}{$1} = 1;
        if($cards{$card}{wins}{$1} == 1) {
            $cards{$card}{totalwin} += 1;
        }
    }
    $numcards = $card;
}

for(my $card = 1; $card <= $numcards; $card++){
    $result += totalcards($card);
}

print "Total of all cards: $result\n";

sub totalcards {
    my($cardnum) = @_;
    my $total = 1;

    my $copystop = $cardnum + $cards{$cardnum}{totalwin};
    if($copystop > $numcards) { $copystop = $numcards; }

    for(my $i = $cardnum + 1; $i <= $copystop; $i++) {
        $total += totalcards($i);
    }

    return $total;
}
Simplified day 4 part 2

Yep, it’s easily possible to calculate the answer while reading through the input, and far faster than iterating through afterwards.

my @input = <>;
chomp @input;

my $result = 0;
my %cards;

foreach $line (@input) {
    my ($card, $nums) = split(/:/, $line);
    if($card =~ /^Card\s+(\d+)$/) { $card = $1; }
    $cards{$card}{copies}++;

    my($wins, $have) = split(/\|/, $nums);

    while($wins =~ /(\d+)\D*/g) {
        $cards{$card}{wins}{$1} = 1;
    }

    while($have =~ /(\d+)\D*/g) {
        if($cards{$card}{wins}{$1} == 1) { $cards{$card}{totalwin} += 1; }
    }

    for(my $i = $card + 1; $i <= ($card + $cards{$card}{totalwin}); $i++) {
        $cards{$i}{copies} += $cards{$card}{copies};
    }
    $result += $cards{$card}{copies};
}

print "Total of all cards: $result\n";
1 Like

Day 5… I got part 1, but I still haven’t figured out a non-brute-force method for part 2, and it’s doing my head in. I keep getting code that works fine with any test input I’ve tried, but the full input throws out bad results.

Day 5 part 1
my @input = <>;
chomp @input;

my $result = "";
my @seeds;
my %maps;
my($source, $dest, $block) = ("", "", "");

foreach $line (@input) {
   if($line =~ s/seeds:\s+//){
       @seeds = split(/ /, $line);
   }
   elsif($line =~ /^(\w+)-to-(\w+) map:/) {
       $source = $1;
       $dest = $2;
       $block = 1;
   }
   elsif($line =~ /(\d+) (\d+) (\d+)/ ) {
       my($drange, $srange, $len) = ($1, $2, $3);
       $maps{$source}{$dest}{$srange}{drange} = $drange;
       $maps{$source}{$dest}{$srange}{len} = $len;
   }
   else{ $block = 0; }
}

foreach $seed (@seeds){
   my ($soil, $fertilizer, $water, $light, $temperature, $humidity, $location);
   $soil = checkmap("seed", "soil", $seed);
   $fertilizer = checkmap("soil", "fertilizer", $soil);
   $water = checkmap("fertilizer", "water", $fertilizer);
   $light = checkmap("water", "light", $water);
   $temperature = checkmap("light", "temperature", $light);
   $humidity = checkmap("temperature", "humidity", $temperature);
   $location = checkmap("humidity", "location", $humidity);

   if($result eq "" || $result > $location) { $result = $location; }
}

print $result;

sub checkmap {
   my($source, $dest, $val) = @_;

   foreach $srange (keys %{$maps{$source}{$dest}}) {
       if($val >= $srange) {
           if($val <= ($srange + $maps{$source}{$dest}{$srange}{len})) {
               return($maps{$source}{$dest}{$srange}{drange} + ($val-$srange));
           }
       }
   }
   return $val;
}

Day 6 was MUCH easier, thank goodness. I feel like there’s probably a really easy way to just calculate the answer, but dumb brute force worked fine.

Day 6 part 1
my @input = <>;
chomp @input;

my $result = 1;
my $wins;

if(@input[0] =~ /(\d+)\s+(\d+)\s+(\d+)\s+(\d+)/) {
    @times = ($1, $2, $3, $4);
}
if(@input[1] =~ /(\d+)\s+(\d+)\s+(\d+)\s+(\d+)/) {
    @distance = ($1, $2, $3, $4);
}

for(my $race = 0; $race <= 3; $race++) {
    for(my $ms = 1; $ms < $times[$race]; $ms++) {
        if($ms * ($times[$race] - $ms) > $distance[$race]) { $wins++; }
    }
    $result *= $wins;
    $wins = 0;
}

print $result;
Day 6 part 2
my @input = <>;
chomp @input;

my $result = 1;
my $wins;

if(@input[0] =~ /(\d+)\s+(\d+)\s+(\d+)\s+(\d+)/) {
    $time = $1 . $2 . $3 . $4;
}
if(@input[1] =~ /(\d+)\s+(\d+)\s+(\d+)\s+(\d+)/) {
    $distance = $1 . $2 . $3 . $4;
}

for(my $ms = 1; $ms < $time; $ms++) {
    if($ms * ($time - $ms) > $distance) { $wins++; }
}
$result = $wins;

print $result;

Day 7… not exactly hard, but the number of combinations made it a little brain-twisting. And one very stupid bug in part 1 skewed my results and took ages to realize where the problem was (I accidentally classified 5-of-a-kind as a full house due to a copy/paste I missed updating)

Day 7 part 1
my @input = <>;
chomp @input;

my $result = 0;
my(%hands);
my @types = ("high", "one", "two", "three", "full", "four", "five");
my @vals = ("2", "3", "4", "5", "6", "7", "8", "9", "T", "J", "Q", "K", "A");
my %cardval;
for(my $i = 0; $i <= $#vals; $i++) {
    $cardval{$vals[$i]} = $i;
}

foreach my $line (@input) {
    my($hand, $bid) = split(/ /, $line);

    my %cards;
    foreach my $card (split(//, $hand)){
        $cards{$card}++;
    }
    my $groups = keys %cards;

    if($groups == 5) { push(@{$hands{"high"}}, [$hand, $bid]); next;}
    if($groups == 4) { push(@{$hands{"one"}}, [$hand, $bid]); next;}
    if($groups == 1) { push(@{$hands{"five"}}, [$hand, $bid]); next;}

    foreach my $card (keys %cards) {
        if($cards{$card} == 4) { push(@{$hands{"four"}}, [$hand, $bid]); last;}
        if($cards{$card} == 3) {
            if($groups == 2) { push(@{$hands{"full"}}, [$hand, $bid]); last;}
            push(@{$hands{"three"}}, [$hand, $bid]); last;
        }
        if($cards{$card} == 2 && $groups == 3) { push(@{$hands{"two"}}, [$hand, $bid]); last; }
    }
}

my $rank = 1;
for(my $i = 0; $i <= $#types; $i++) {
    foreach my $hand (sort hand_sort @{$hands{$types[$i]}}){
        $result += ($rank * @{$hand}[1]);
        $rank++;
    }
}

print "Total winnings: $result\n";

sub hand_sort {
    my(@hand1) = split(//, @{$a}[0]);
    my(@hand2) = split(//, @{$b}[0]);
    for(my $i = 0; $i <= 5; $i++) {
        if($hand1[$i] eq $hand2[$i]) { next; }
        return $cardval{$hand1[$i]} <=> $cardval{$hand2[$i]}
    }
}
Day 7 part 2
my @input = <>;
chomp @input;

my $result = 0;
my(%hands);
my @types = ("high", "one", "two", "three", "full", "four", "five");
my @vals = ("J", "2", "3", "4", "5", "6", "7", "8", "9", "T", "Q", "K", "A");
my %cardval;
for(my $i = 0; $i <= $#vals; $i++) {
    $cardval{$vals[$i]} = $i;
}

foreach my $line (@input) {
    my($hand, $bid) = split(/ /, $line);

    my %cards;
    my $jokers = 0;
    foreach my $card (split(//, $hand)){
        if($card eq "J") { $jokers++; }
        else { $cards{$card}++; }
    }
    my($hval, $high) = (0,0);
    foreach my $card (keys %cards) {
        if($cards{$card} > $hval) { $hval = $cards{$card}; $high = $card };
    }
    $cards{$high} += $jokers;

    my $groups = keys %cards;

    if($groups == 5) { push(@{$hands{"high"}}, [$hand, $bid]); next;}
    if($groups == 4) { push(@{$hands{"one"}}, [$hand, $bid]); next;}
    if($groups == 1) { push(@{$hands{"five"}}, [$hand, $bid]); next;}

    foreach my $card (keys %cards) {
        if($cards{$card} == 4) { push(@{$hands{"four"}}, [$hand, $bid]); last;}
        if($cards{$card} == 3) {
            if($groups == 2) { push(@{$hands{"full"}}, [$hand, $bid]); last;}
            push(@{$hands{"three"}}, [$hand, $bid]); last;
        }
        if($cards{$card} == 2 && $groups == 3) { push(@{$hands{"two"}}, [$hand, $bid]); last; }
    }
}

my $rank = 1;
for(my $i = 0; $i <= $#types; $i++) {
    foreach my $hand (sort hand_sort @{$hands{$types[$i]}}){
        $result += ($rank * @{$hand}[1]);
        $rank++;
    }
}

print "Total winnings: $result\n";

sub hand_sort {
    my(@hand1) = split(//, @{$a}[0]);
    my(@hand2) = split(//, @{$b}[0]);
    for(my $i = 0; $i <= 5; $i++) {
        if($hand1[$i] eq $hand2[$i]) { next; }
        return $cardval{$hand1[$i]} <=> $cardval{$hand2[$i]}
    }
}
1 Like

I definitely have a problem with the way day 8 is presented. And I recognize the puzzle, and realized partway through that I have had problems with it in previous AoCs also.

Part 1 is pretty easy, and doesn’t take much time to run.

Day 8 part 1
my @input = <>;
chomp @input;

my $result = 0;
my @instruct = split(//, shift @input);
my %nodes;

my $current = "AAA";

foreach $line (@input) {
    if($line =~ /(\w+)\s+=\s+\((\w+), (\w+)\)/) {
        $nodes{$1}{L} = $2;
        $nodes{$1}{R} = $3;
    }
}

while(! ($current eq "ZZZ")) {
    foreach my $move (@instruct) {
        $current = $nodes{$current}{$move};
        $result++;
        if($current eq "ZZZ") { last; }
    }
}

print "Number of steps: $result";

Part 2… (speaking vaguely to avoid spoilers) this is one that’s specifically constructed to take an inordinate amount of time unless you take certain shortcuts. The problem I have, is that those shortcuts are only possible for certain input values - if you write the code to solve for any input values, you waste a bunch of time unless you also special-case inputs that can be shortcut. And the puzzle text only gives the vaguest whiff of a hint at this.

Day 8 part 2

The shortcut: If the path from the start to the first time you reach the end is the same length as the loop from the end back around to the end, then calculate the least common multiple of all the loops. But, if the initial path and the loop aren’t the same, then calculating the lcm will fail to account for the initial path’s length.

I tried to write a solution that takes into account both possibilities, but I haven’t really tested the non-shortcut code.

my @input = <>;
chomp @input;

my $result = 0;
my @instruct = split(//, shift @input);
my %nodes;

my @current;

foreach $line (@input) {
    if($line =~ /(\w+)\s+=\s+\((\w+), (\w+)\)/) {
        $nodes{$1}{L} = $2;
        $nodes{$1}{R} = $3;
        if(substr($1, -1, 1) eq "A") { push @current, $1; }
    }
}

my $stop = 0;
my @loopstart;
my @looplength;

#for each path, find both the length of the initial path, and the length of the next loop
while(! $stop) {
    foreach my $move (@instruct) {
        $stop = 1;
        for(my $i = 0; $i <= $#current; $i++) {
            if( $looplength[$i] == 0) {
                $current[$i] = $nodes{$current[$i]}{$move};
                if((substr($current[$i], -1, 1) eq "Z")) {
                    if($loopstart[$i] == 0) { $loopstart[$i] = $result + 1; next; }
                    else { $looplength[$i] = ($result + 1) - $loopstart[$i]; next; }
                }
                else { $stop = 0; }
            }
        }
        $result++;
        if($stop) { last; }
    }
}

my $lcm = 1;
for(my $i = 0; $i <= $#loopstart; $i++) {
    if($loopstart[$i] != $looplength[$i]) { $lcm = 0; last; }
}

#if every path's initial path and next loop are the same length, shortcut with lcm. Else, do it the long way
if($lcm) { print "Total steps: " . lcm_list(@loopstart) . "\n"; }
else {
    $stop = 0;
    my $smallest = 0;
    while(! $stop){
        $stop = 1;
        #find the smallest loop number
        for(my $i = 0; $i <= $#loopstart; $i++) {
            if($loopstart[$i] != $loopstart[$smallest]) { $stop = 0; }
        }
        #if there is a smallest loop, then increment that loop by its looplength
        if(! $stop) {
            $loopstart[$smallest] += $looplength[$smallest];
        }
        #if all loops are the same length, we're done, and that length is the answer
    }

    print "Total steps: " . $loopstart[0] . "\n";
}

#Least common multiple calcs
sub lcm($$) {
    my ($a, $b) = @_;
    return $a * $b / gcd($a, $b);
}

sub gcd($$) {
    my ($a, $b) = @_;
    return $a if $b == 0;
    return gcd($b, $a % $b);
}

sub lcm_list (@) {
    my $lcm = shift;
    foreach my $n (@_) {
        $lcm = lcm($lcm, $n);
    }
    return $lcm;
}

Personally, I feel like a solution that only works with the specific input you have (or similar specific cases) seems… lacking. It kind of makes sense within the “story” of the puzzles, but it just feels kinda unsatisfying. Especially when you have to first analyze a huge input set just to spot the special case solution, unless you’ve seen the the thing before and already know the trick.

1 Like

Doesn’t seem like there’s much interest, but I may as well keep writing my own thoughts…

Day 9: This was an easy one to code, but it took ages for me to wrap my brain around the description of what you were supposed to do. And then after I finished part 1 with a correct answer, I noticed that my data during processing wasn’t matching up with what the problem description said it should, so I wasted about an hour just troubleshooting that before moving on to part 2, even though it turned out that it didn’t really matter to the result. :man_facepalming:

Day 9 part 1

My bug ended up being that I wasn’t actually adding values to the last two rows of the pyramid, so my calculations were working on the wrong value locations. It turned out that the math still worked, but out of an abundance of caution I worked on it until things matched in case it mattered in part 2… which, of course, it didn’t.

my @input = <>;
chomp @input;

my $result = 0;

my @values;
foreach my $line (@input) {
    @values = ();

    push(@values, [split(/ /, $line)]);
    sequence(0);
    $result += $values[0][$#{$values[0]}];
}

print "Total: $result\n";

sub sequence {
    my($row) = @_;
    my $stop = 1;

    for(my $val = 1; $val <= $#{$values[$row]}; $val++) {
        my $tmp = $values[$row][$val] - $values[$row][$val-1];
        if($tmp != 0) { $stop = 0; }
        push(@{$values[$row+1]}, $tmp);
    }
    if(!$stop) { sequence($row + 1); }
    else {
        push(@{@values[$row+1]}, 0);
        push(@{@values[$row]}, ($values[$row][$#{$values[$row]}] + $values[$row+1][$#{$values[$row+1]}]));
        return;
    }

    push(@{@values[$row]}, ($values[$row][$#{$values[$row]}] + $values[$row+1][$#{$values[$row+1]}]));
}
Day 9 part 2

Basically the same as part 1, except using “unshift” instead of “push”. Figuring out what math was needing to be done to find the values to add took longer than I’d have expected, though.

my @input = <>;
chomp @input;

my $result = 0;

my @values;
foreach my $line (@input) {
    @values = ();

    push(@values, [split(/ /, $line)]);
    sequence(0);
    $result += $values[0][0];
}

print "Total: $result\n";

sub sequence {
    my($row) = @_;
    my $stop = 1;

    for(my $val = 1; $val <= $#{$values[$row]}; $val++) {
        my $tmp = $values[$row][$val] - $values[$row][$val-1];
        if($tmp != 0) { $stop = 0; }
        push(@{$values[$row+1]}, $tmp);
    }
    if(!$stop) { sequence($row + 1); }
    else {
        push(@{@values[$row+1]}, 0);
        unshift(@{@values[$row]}, ($values[$row][0] - $values[$row+1][0]));
        return;
    }

    unshift(@{@values[$row]}, ($values[$row][0] - $values[$row+1][0]));
}

Day 10: This one would have been fun, except that I kept faceplanting with stupid bug after stupid bug. I finally gave up on part 1 until after some sleep, which helped a little. My code’s very verbose, and I made things hard on myself by using a hash so I could store extra data and then never actually using that capability.
If you do a display of the data for troubleshooting/etc, I highly recommend translating the symbols used to ascii block drawing characters (“═”, “║”, “╔”, “╚”, “╝”, “╗”,). It makes the examples and the input data look SO much nicer and easier to understand what’s going on.
Part 2 had me stumped until I realized you could count the number of times you passed over parts of the loop in order to tell if you were inside or outside it. Have to be careful with handling corners, though, and the start location.

Day 10 part 1
my @input = <>;
chomp @input;

my $result = 0;
my @startloc;
my $i = 0;
my %map;
my %ascii = ("-" => "═", "|" => "║",
             "F" => "╔", "L" => "╚",
             "J" => "╝", "7" => "╗",
             "." => " ");

foreach $line (@input) {
    if($line =~ /S/) { @startloc = ($-[0], $i); }

    $line = [split(//, $line)];
    for(my $x = 0; $x <= $#{$line}; $x++) {
        $map{$x . "-" . $i}{symbol} = @{$line}[$x];
    }

    $i++;
}

my @current;
my @next;
push(@current, \@startloc);
my $distance = 0;
my $stop = 0;

printmap(3);
print "\n";

while(! $stop) {
    foreach my $curr (@current) {
        if(exists $map{@{$curr}[0] . "-" . @{$curr}[1]}{distance}) {
            print "distance found: " . @{$curr}[0] . ", " . @{$curr}[1] . "\n";
            $stop = 1; last;
        }
        $map{@{$curr}[0] . "-" . @{$curr}[1]}{distance} = $distance;
        surrounds(@{$curr}[0], @{$curr}[1]);
    }
    if(! $stop) {
        $distance++;
        @current = @next;
        @next = ();
    }
    if($#current < 0) { print "Ran out of locations\n"; exit; }
}

print "Distance to farthest point in loop: $distance\n";

sub printmap {
    my($type) = @_;

    for(my $y = 0; $y <= $#input; $y++) {
        for(my $x = 0; $x <= $#{$input[$y]}; $x++) {
            if($type == 1 && exists $map{$x . "-" . $y}{distance}) { print $map{$x . "-" . $y}{distance}; }
            elsif($type == 2 && exists $map{$x . "-" . $y}{distance}) { print " "; }
            elsif($type == 3 && exists $ascii{$map{$x . "-" . $y}{symbol}}) { print $ascii{$map{$x . "-" . $y}{symbol}}; }
            else { print $map{$x . "-" . $y}{symbol} }
    }
    print "\n";
    }
}

sub surrounds {
    my($x, $y) = @_;
    my $sym = $map{$x . "-" . $y}{symbol};

    my $up, $down, $left, $right;
    if($y > 0) { $up = $map{$x . "-" . ($y-1)}{symbol}; }
    if($y <= $#input) { $down = $map{$x . "-" . ($y+1)}{symbol}; }
    if($x > 0) { $left = $map{($x-1) . "-" . $y}{symbol}; }
    if($x <= $#{$input[$y]}) { $right = $map{($x+1) . "-" . $y}{symbol}; }

    if(($up eq "|" || $up eq "7" || $up eq "F") && ($sym eq "|" || $sym eq "L" || $sym eq "J" || $sym eq "S")) {
        if(! exists $map{$x . "-" . ($y-1)}{distance}) {
            push(@next, [$x, ($y-1)]);
        }
    }
    if(($down eq "|" || $down eq "L" || $down eq "J") && ($sym eq "|" || $sym eq "7" || $sym eq "F" || $sym eq "S")) {
        if(! exists $map{$x . "-" . ($y+1)}{distance}) {
            push(@next, [$x, ($y+1)]);
        }
    }
    if(($left eq "-" || $left eq "L" || $left eq "F") && ($sym eq "-" || $sym eq "J" || $sym eq "7" || $sym eq "S")) {
        if(! exists $map{($x-1) . "-" . $y}{distance}) {
            push(@next, [($x-1), $y]);
        }
    }
    if(($right eq "-" || $right eq "7" || $right eq "J") && ($sym eq "-" || $sym eq "L" || $sym eq "F" || $sym eq "S")) {
        if(! exists $map{($x+1) . "-" . $y}{distance}) {
            push(@next, [($x+1), $y]);
        }
    }
}
Day 10 part 2
my @input = <>;
chomp @input;

my $result = 0;
my @startloc;
my $i = 0;
my %map;
my %ascii = ("-" => "═", "|" => "║",
             "F" => "╔", "L" => "╚",
             "J" => "╝", "7" => "╗",
             "." => " ");

foreach $line (@input) {
    if($line =~ /S/) { @startloc = ($-[0], $i); }

    $line = [split(//, $line)];
    for(my $x = 0; $x <= $#{$line}; $x++) {
        $map{$x . "-" . $i}{symbol} = @{$line}[$x];
    }
    $i++;
}

my @current;
my @next;
push(@current, \@startloc);
my $distance = 0;
my $stop = 0;

printmap(3);
print "\n";

while(! $stop) {
    foreach my $curr (@current) {
        if(exists $map{@{$curr}[0] . "-" . @{$curr}[1]}{distance}) {
            print "Farthest location found: " . @{$curr}[0] . ", " . @{$curr}[1] . "\n";
            $stop = 1; last;
        }
        $map{@{$curr}[0] . "-" . @{$curr}[1]}{distance} = $distance;
        surrounds(@{$curr}[0], @{$curr}[1]);
    }
    if(! $stop) {
        $distance++;
        @current = @next;
        @next = ();
    }
    if($#current < 0) { print "Ran out of locations\n"; exit; }
}

print "Distance to farthest point in loop: $distance\n";

for(my $y = 0; $y <= $#input; $y++) {
    my $cross = 0;
    my $angle = "";
    for(my $x = 0; $x <= $#{$input[$y]}; $x++) {
        my $sym = $map{$x . "-" . $y}{symbol};
        if(exists $map{$x . "-" . $y}{distance}) {
            if($sym eq "|") { $cross++; }
            if($sym eq "F" || $sym eq "L") { $angle = $sym; }
            if($sym eq "7" || $sym eq "J") {
                if(! $angle eq "") {
                    if(($angle eq "L" && $sym eq "7") || ($angle eq "F" && $sym eq "J")) { $cross++; }
                    $angle = "";
                }
            }
        }
        elsif($cross % 2) {
            $map{$x . "-" . $y}{symbol} = "X"; $result++;
        }
        else { $map{$x . "-" . $y}{symbol} = " "; }
    }
}
printmap(3);
print "Enclosed cells: $result\n";

sub printmap {
    my($type) = @_;

    for(my $y = 0; $y <= $#input; $y++) {
        for(my $x = 0; $x <= $#{$input[$y]}; $x++) {
            if($type == 1 && exists $map{$x . "-" . $y}{distance}) { print $map{$x . "-" . $y}{distance}; }
            elsif($type == 2 && exists $map{$x . "-" . $y}{distance}) { print " "; }
            elsif($type == 3 && exists $ascii{$map{$x . "-" . $y}{symbol}}) { print $ascii{$map{$x . "-" . $y}{symbol}}; }
            else { print $map{$x . "-" . $y}{symbol} }
    }
    print "\n";
    }
}

sub surrounds {
    my($x, $y) = @_;
    my $sym = $map{$x . "-" . $y}{symbol};

    my $up, $down, $left, $right;
    if($y > 0) { $up = $map{$x . "-" . ($y-1)}{symbol}; }
    if($y <= $#input) { $down = $map{$x . "-" . ($y+1)}{symbol}; }
    if($x > 0) { $left = $map{($x-1) . "-" . $y}{symbol}; }
    if($x <= $#{$input[$y]}) { $right = $map{($x+1) . "-" . $y}{symbol}; }

    if(($up eq "|" || $up eq "7" || $up eq "F") && ($sym eq "|" || $sym eq "L" || $sym eq "J" || $sym eq "S")) {
        if(! exists $map{$x . "-" . ($y-1)}{distance}) {
            push(@next, [$x, ($y-1)]);
            $up = 1;
        }
    }
    if(($down eq "|" || $down eq "L" || $down eq "J") && ($sym eq "|" || $sym eq "7" || $sym eq "F" || $sym eq "S")) {
        if(! exists $map{$x . "-" . ($y+1)}{distance}) {
            push(@next, [$x, ($y+1)]);
            $down = 1;
        }
    }
    if(($left eq "-" || $left eq "L" || $left eq "F") && ($sym eq "-" || $sym eq "J" || $sym eq "7" || $sym eq "S")) {
        if(! exists $map{($x-1) . "-" . $y}{distance}) {
            push(@next, [($x-1), $y]);
            $left = 1;
        }
    }
    if(($right eq "-" || $right eq "7" || $right eq "J") && ($sym eq "-" || $sym eq "L" || $sym eq "F" || $sym eq "S")) {
        if(! exists $map{($x+1) . "-" . $y}{distance}) {
            push(@next, [($x+1), $y]);
            $right = 1;
        }
    }
    if($sym eq "S") {
        if($up == 1) {
            if($down == 1) { $map{$x . "-" . $y}{symbol} = "|"; }
            if($left == 1) { $map{$x . "-" . $y}{symbol} = "J"; }
            if($right == 1) { $map{$x . "-" . $y}{symbol} = "L"; }
        }
        if($down == 1) {
            if($left == 1) { $map{$x . "-" . $y}{symbol} = "7"; }
            if($right == 1) { $map{$x . "-" . $y}{symbol} = "F"; }
        }
        if($right == 1 && $left == 1) { $map{$x . "-" . $y}{symbol} = "-"; }

    }
}

Day 11: A nice, straightforward one. Basic array processing, taxicab distances. I’m pretty sure I could have made my code a lot more compact, but it worked.

Day 11 part 1
my @input = <>;
chomp @input;

my $result = 0;
my %double;
my @gals;
my %dists;

my $i = 0;
foreach $line (@input) {
    my $count = 0;
    while($line =~ /#/g) {
        push(@gals, $i . "-" . $-[0]);
        $count++;
    }
    if($count == 0) { $double{row}{$i} = 1; }
    $line = [split(//, $line)];
    $i++
}

for(my $x = 0; $x <= $#{$input[0]}; $x++) {
    my $count = 0;
    for(my $y = 0; $y <= $#input; $y++) {
        if($input[$y][$x] eq "#") {
            $count++;
        }
    }
    if($count == 0) { $double{col}{$x} = 1; }
}

for(my $gal = 0; $gal < $#gals; $gal++) {
    for(my $gal2 = $gal + 1; $gal2 <= $#gals; $gal2++) {
        if(! exists $dists{$gal}{$gal2}) {
            my $distance;
            my($g1y, $g1x) = split(/-/, $gals[$gal]);
            my($g2y, $g2x) = split(/-/, $gals[$gal2]);
            my ($a, $b) = ($g1x > $g2x ? ($g1x, $g2x) : ($g2x, $g1x));
            $distance += $a - $b;
            foreach my $dbl (keys %{$double{col}}) {
                if($dbl < $a && $dbl > $b) { $distance++; }
            }
            ($a, $b) = ($g1y > $g2y ? ($g1y, $g2y) : ($g2y, $g1y));
            $distance += $a - $b;
            foreach my $dbl (keys %{$double{row}}) {
                if($dbl < $a && $dbl > $b) { $distance++; }
            }
            $result += $distance;
        }
    }
}

print "Total shortest path between pairs: $result\n";
Day 11 part 2

Love it when you have almost nothing to change to do the next part.

my @input = <>;
chomp @input;

my $result = 0;
my %double;
my @gals;
my %dists;

my $i = 0;
foreach $line (@input) {
    my $count = 0;
    while($line =~ /#/g) {
        push(@gals, $i . "-" . $-[0]);
        $count++;
    }
    if($count == 0) { $double{row}{$i} = 1; }
    $line = [split(//, $line)];
    $i++
}

for(my $x = 0; $x <= $#{$input[0]}; $x++) {
    my $count = 0;
    for(my $y = 0; $y <= $#input; $y++) {
        if($input[$y][$x] eq "#") {
            $count++;
        }
    }
    if($count == 0) { $double{col}{$x} = 1; }
}

for(my $gal = 0; $gal < $#gals; $gal++) {
    for(my $gal2 = $gal + 1; $gal2 <= $#gals; $gal2++) {
        if(! exists $dists{$gal}{$gal2}) {
            my $distance;
            my($g1y, $g1x) = split(/-/, $gals[$gal]);
            my($g2y, $g2x) = split(/-/, $gals[$gal2]);
            my ($a, $b) = ($g1x > $g2x ? ($g1x, $g2x) : ($g2x, $g1x));
            $distance += $a - $b;
            foreach my $dbl (keys %{$double{col}}) {
                if($dbl < $a && $dbl > $b) { $distance += 999999; }
            }
            ($a, $b) = ($g1y > $g2y ? ($g1y, $g2y) : ($g2y, $g1y));
            $distance += $a - $b;
            foreach my $dbl (keys %{$double{row}}) {
                if($dbl < $a && $dbl > $b) { $distance += 999999; }
            }
            $result += $distance;
        }
    }
}

print "Total shortest paths between pairs: $result\n";

Went back and revisited day 11, and was able to streamline it and bring it from 52 lines down to 44. Could probably be cut down some more, but I think it’d take either some tricks I don’t know or making the code harder to read (or both) in order to make much difference.

Day 11 part 1 streamlined
my @input = <>;
chomp @input;

my $result = 0;
my %double;
my @gals;

my $i = 0;
foreach $line (@input) {
    $line = [split(//, $line)];
    $double{row}{$i} = 1;
    for(my $x = 0; $x <= $#{$line}; $x++) {
        if($double{col}{$x} != -1) { $double{col}{$x} = 1; }
        if(@{$line}[$x] eq "#") {
            push(@gals, $i . "-" . $x);
            $double{col}{$x} = -1;
            delete $double{row}{$i};
        }
    }
    $i++
}
foreach my $dbl (keys %{$double{col}}) {
    if($double{col}{$dbl} == -1) { delete $double{col}{$dbl}; }
}

for(my $gal = 0; $gal < $#gals; $gal++) {
    for(my $gal2 = $gal + 1; $gal2 <= $#gals; $gal2++) {
        my($g1y, $g1x) = split(/-/, $gals[$gal]);
        my($g2y, $g2x) = split(/-/, $gals[$gal2]);
        $result += calc($g1x, $g2x, "col");
        $result += calc($g1y, $g2y, "row");
    }
}
sub calc {
    my($a, $b, $dir) = @_;
    if($a < $b) { ($a, $b) = ($b, $a); }
    my $dist = $a - $b;
    foreach my $dbl (keys %{$double{$dir}}) {
        if($dbl < $a && $dbl > $b) { $dist++; }
    }
    return $dist;
}

print "Total shortest path between pairs: $result\n";
1 Like

I can’t speak for anyone else, but I remain interested, just short on time and/or energy.

I’m still on day 3. Part one took me some time to come to a conclusion, further delayed by mistakenly indexing the matrix backwards. I have an idea for part 2, but I haven’t implemented it yet.

1 Like

I apologize, that was badly worded… I meant something more along the lines of “I hope bumping the thread to the top isn’t annoying anyone”. I’ve been batching up days to limit that. :wink:

That one’s always fun to realize.

1 Like

I feel like such a slacker this year but I’ve been too busy with work to do AoC thus far. Maybe I’ll catch up after it’s all over.

3 Likes

I got hung up on day 12 - I had a relatively straightforward idea for solving but the nested cases it was requiring got out of hand, and sleep deprivation (after an emergency kept me up until dawn, and my body decided it was going to just try to stick to that schedule) caught up to me on top of it. Haven’t found time to get back on the wagon yet.

2 Likes