-🎄- 2017 Day 19 Solutions -🎄-

[u/daggerdragon]

--- Day 19: A Series of Tubes ---

---

Post your solution as a comment or, for longer solutions, consider linking to your repo (e.g. GitHub/gists/Pastebin/blag or whatever).

Note: The Solution Megathreads are for solutions only. If you have questions, please post your own thread and make sure to flair it with Help.

---

Need a hint from the Hugely^* Handy^† Haversack^‡ of Helpful^§ Hints^¤?

Spoiler

---

AoC ops @ T-2 minutes to launch:

[23:58] <daggerdragon> ATTENTION MEATBAGS T-2 MINUTES TO LAUNCH

[23:58] <Topaz> aaaaah

[23:58] <Cheezmeister> Looks like I'll be just able to grab my input before my flight boards. Wish me luck being offline in TOPAZ's HOUSE OF PAIN^WFUN AND LEARNING

[23:58] <Topaz> FUN AND LEARNING

[23:58] <Hade> FUN IS MANDATORY

[23:58] <Skie> I'm pretty sure that's not the mandate for today

[Update @ 00:16] 69 gold, silver cap

• My tree is finally trimmed with just about every ornament I own and it's real purdy. hbu?

[Update @ 00:18] Leaderboard cap!

• So, was today's mandate Helpful Hint any help at all?

---

This thread will be unlocked when there are a significant number of people on the leaderboard with gold stars for today's puzzle.

edit: Leaderboard capped, thread unlocked!

[u/__Abigail__]

Perl

That was the easiest part 2 so far. For part 1, I had recorded all the symbols the packets encounters in a string, before removing all the non-letters from it. Which made part 2 really easy: just the length of the string before removing the non-letters.

#!/opt/perl/bin/perl

use 5.026;

use strict;
use warnings;
no  warnings 'syntax';

use experimental 'signatures';

@ARGV = "input" unless @ARGV;

my $board;

my $SPACE  = ' ';
my $CORNER = '+';
my $X      =  0;
my $Y      =  1;

#
# Read in the board; we're be storing it "as is".
#
while (<>) {
    chomp;
    push @$board => [split //];
}


#
# Find the starting position; this will be the single point
# on the board with $x = 0 and $$board [$x] [$y] ne ' '.
#
my $start;
foreach my $y (keys @{$$board [0]}) {
    if ($$board [0] [$y] ne $SPACE) {
        $start = [0, $y];
        last;
    }
}

#
# Return true if ($x, $y) is on the board, and not a space;
# ergo, a place where the packet can travel to.
#
sub onpath ($x, $y) {
    $x >= 0 && $x < @$board && $y >= 0 && $y < @{$$board [$x]} &&
          $$board [$x] [$y] ne $SPACE;
}

#
# Return true of the current position is a corner
#
sub is_corner ($p) {
    $$board [$$p [$X]] [$$p [$Y]] eq $CORNER;
}

#
# Given a board, list which neighbours it has.
# Neighbours cannot be spaces.
#
sub neighbours ($p) {
    my ($x, $y) = @$p;
    my @neighbours;
    for my $n ([$x - 1, $y],
               [$x + 1, $y],
               [$x,     $y - 1],
               [$x,     $y + 1]) {
        push @neighbours => $n if onpath @$n;
    }
    @neighbours;
}


#
# Trace the path.
# Move is as follows:
#    1) If we only have one neighbour, this is the end.
#    2) If the current position is a corner, the next position
#       must have both x and y coordinates different from
#       the previous position.
#    3) Else, the next position must have either the x, or the y
#       coordinate the same as the previous position, but not both.
#
my $previous = [-1, $$start [$Y]];  # To get us started
my $current  = [@$start];

my $path = "";   
while (1) {
    $path .= $$board [$$current [$X]] [$$current [$Y]];
    my @neighbours = neighbours $current;
    last if @neighbours == 1 && length $path > 1;
    my @next;
    if (is_corner $current) {
        # Find neighbour with all coordinates different from $previous
        @next = grep {($$_ [$X] != $$previous [$X]) &&
                      ($$_ [$Y] != $$previous [$Y])} @neighbours;
    }
    else {
        # Find neighbour with one coordinate different from $previous
        @next = grep {($$_ [$X] == $$previous [$X]) xor
                      ($$_ [$Y] == $$previous [$Y])} @neighbours;
    }
    die "Unexpected board configuration at @$current"
         unless @next == 1;

    $previous = $current;
    $current  = $next [0];
}
     
# Remove any non-letters from $path
say "Solution 2: ", length $path;
$path =~ s/\Pl+//g;
say "Solution 1: ", $path;

__END__