Discussion on: AoC Day 20: A Regular Map

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

use List::Util qw{ min max };

chomp( my $regex = <> );

my ($x, $y) = (0, 0);
my %grid = ($x => { $y => 'X' });

sub show {
    my $min_x = min(keys %grid);
    my $max_x = max(keys %grid);
    my $min_y = min(map keys %$_, values %grid);
    my $max_y = max(map keys %$_, values %grid);
    for my $y ($min_y .. $max_y) {
        for my $x ($min_x .. $max_x) {
            print $grid{$x}{$y} //= "#";
        }
        print "\n";
    }
}

sub draw {
    my ($pos, $stack) = @_;
    my $current = substr $regex, $pos, 1;
    my $done;
    {'^' => sub { die if $pos },
     E   => sub {
         $grid{$x + 1}{$y} = '|'; $grid{$x + 2}{$y} = '.';
         $_ = '#' for $grid{$x + 1}{$y - 1}, $grid{$x + 1}{$y + 1};
         $x += 2;
     },
     W   => sub {
         $grid{$x - 1}{$y} = '|'; $grid{$x - 2}{$y} = '.';
         $_ = '#' for $grid{$x - 1}{$y - 1}, $grid{$x - 1}{$y + 1};
         $x -= 2;
     },
     N   => sub {
         $grid{$x}{$y - 1} = '-'; $grid{$x}{$y - 2} = '.';
         $_ = '#' for $grid{$x + 1}{$y - 1}, $grid{$x - 1}{$y - 1};
         $y -= 2;
     },
     S   => sub {
         $grid{$x}{$y + 1} = '-'; $grid{$x}{$y + 2} = '.';
         $_ = '#' for $grid{$x + 1}{$y + 1}, $grid{$x - 1}{$y + 1};
         $y += 2;
     },
     '(' => sub { push @$stack, [$x, $y] },
     '|' => sub { ($x, $y) = @{ $stack->[-1] } },
     ')' => sub { pop @$stack },
     '$' => sub { show(); $done = 1 },
 }->{$current}->();
    no warnings 'recursion';
    draw($pos + 1, $stack) unless $done;
}

sub walk {
    my @process = [0, 0];
    my $distance = 0;
    while (@process) {
        my @next;
        while (my $coords = shift @process) {
            my ($x, $y) = @$coords;
            $grid{$x}{$y} = 'x';
            for ([0, 1], [1, 0], [-1, 0], [0, -1]) {
                if ($grid{ $x + $_->[0] }{ $y + $_->[1] } =~ /[-|]/
                    && $grid{ $x + 2 * $_->[0] }{ $y + 2 * $_->[1] } ne 'x'
                ) {
                    push @next, [ $x + 2 * $_->[0], $y + 2 * $_->[1] ];
                }
            }
        }
        @process = @next;
        ++$distance;
    }
    say $distance - 1;
}

draw(0, []);
walk();

sub walk {
    my $count = 0;
    my @process = [0, 0];
    my $distance = 0;
    while (@process) {
        my @next;
        while (my $coords = shift @process) {
            ++$count if $distance >= 1000;
            my ($x, $y) = @$coords;
            $grid{$x}{$y} = 'x';
            for ([0, 1], [1, 0], [-1, 0], [0, -1]) {
                if ($grid{ $x + $_->[0] }{ $y + $_->[1] } =~ /[-|]/
                    && $grid{ $x + 2 * $_->[0] }{ $y + 2 * $_->[1] } ne 'x'
                ) {
                    push @next, [ $x + 2 * $_->[0], $y + 2 * $_->[1] ];
                }
            }
        }
        @process = @next;
        ++$distance;
    }
    say $count;
}