use v5.36;<br><br>sub dist($p1, $p2) {<br>    my $dx = $p1->[0] - $p2->[0];<br>    my $dy = $p1->[1] - $p2->[1];<br>    my $dz = $p1->[2] - $p2->[2];<br>    $dx*$dx + $dy*$dy + $dz*$dz<br>}<br><br>my @points = map [/^(\d+),(\d+),(\d+)$/a], readline;<br><br>my @pairs = map {<br>    my $p1 = $points[$_];<br>    my $i = $_;<br>    map $i >= $_ ? () : [$i, $_, dist($p1, $points[$_])], 0 .. $#[url=https://infosec.exchange/tags/points]points[/url]<br>} 0 .. $#[url=https://infosec.exchange/tags/points]points[/url];<br><br>@pairs = sort { $a->[2] <=> $b->[2] } @pairs;<br><br>my %tbd = map +($_ => 1), 0 .. $#[url=https://infosec.exchange/tags/points]points[/url];<br><br>my (@regions, %r_set);<br>my $representative = sub ($p) {<br>    $regions[$p] //= do {<br>        delete $tbd{$p};<br>        $r_set{$p} = 1;<br>        +{ arity => 1 }<br>    };<br>    my $repr = $p;<br>    while (defined(my $next = $regions[$repr]{repr})) {<br>        $repr = $next;<br>    }<br>    while ($p != $repr) {<br>        my $rr = \$regions[$p]{repr};<br>        ($p, $$rr) = ($$rr, $repr);<br>    }<br>    $repr<br>};<br><br>my $merge = sub ($p, $q) {<br>    $p = $representative->($p);<br>    $q = $representative->($q);<br>    return if $p == $q;<br><br>    if ($regions[$p]{arity} > $regions[$q]{arity}) {<br>        ($p, $q) = ($q, $p);<br>    }<br><br>    my $rp = $regions[$p];<br>    my $rq = $regions[$q];<br>    $rp->{repr} = $q;<br>    $rq->{arity} += $rp->{arity};<br>    delete $r_set{$p};<br>};<br><br>for my $p (@pairs) {<br>    $merge->($p->[0], $p->[1]);<br>    if (!%tbd && %r_set == 1) {<br>        say $points[$p->[0]][0] * $points[$p->[1]][0];<br>        last;<br>    }<br>}<br>

use v5.36;<br><br>sub dist($p1, $p2) {<br>    my $dx = $p1->[0] - $p2->[0];<br>    my $dy = $p1->[1] - $p2->[1];<br>    my $dz = $p1->[2] - $p2->[2];<br>    $dx*$dx + $dy*$dy + $dz*$dz<br>}<br><br>my @points = map [/^(\d+),(\d+),(\d+)$/a], readline;<br><br>my @pairs = map {<br>    my $p1 = $points[$_];<br>    my $i = $_;<br>    map $i >= $_ ? () : [$i, $_, dist($p1, $points[$_])], 0 .. $#[url=https://infosec.exchange/tags/points]points[/url]<br>} 0 .. $#[url=https://infosec.exchange/tags/points]points[/url];<br><br>@pairs = sort { $a->[2] <=> $b->[2] } @pairs;<br><br>my @regions;<br>my $representative = sub ($p) {<br>    $regions[$p] //= { arity => 1 };<br>    my $repr = $p;<br>    while (defined(my $next = $regions[$repr]{repr})) {<br>        $repr = $next;<br>    }<br>    while ($p != $repr) {<br>        my $rr = \$regions[$p]{repr};<br>        ($p, $$rr) = ($$rr, $repr);<br>    }<br>    $repr<br>};<br><br>my $merge = sub ($p, $q) {<br>    $p = $representative->($p);<br>    $q = $representative->($q);<br>    return if $p == $q;<br><br>    if ($regions[$p]{arity} > $regions[$q]{arity}) {<br>        ($p, $q) = ($q, $p);<br>    }<br><br>    my $rp = $regions[$p];<br>    my $rq = $regions[$q];<br>    $rp->{repr} = $q;<br>    $rq->{arity} += $rp->{arity};<br>};<br><br>for my $p (@pairs[0 .. 999]) {<br>    $merge->($p->[0], $p->[1]);<br>}<br><br>my @arities = map $_ && !$_->{repr} ? $_->{arity} : (), @regions;<br>@arities = sort { $b <=> $a } @arities;<br><br>say $arities[0] * $arities[1] * $arities[2];<br>

AoC day 7, part 2. In principle, this problem is eminently regexable: All steps a beam takes can be described by a regex, ^ corresponds to choice/alternative, and the number of ways the regex matches is the solution. In practice, this takes forever. I tried to speed things up with embedded code blocks and a cache, but it quickly gets overly complex and I suspect there may be bugs lurking in the interaction between embedded code blocks, closures, local, and backtracking.

In the end I gave up and rewrote the regex as direct code with manual backtracking. I guess the cache makes it an instance of "dynamic programming".

use v5.36;<br><br>my $grid = do { local $/; readline };<br><br>my $w = index($grid, "\n") + 1;<br><br>$grid .= 'E' x $w . "\n";<br><br>my $p = index $grid, 'S';<br>$p += $w;<br><br>my $count = 0;<br>my (@ alt, @cache);<br>while () {<br>    while (substr($grid, $p, 1) eq '.') {<br>        $p += $w;<br>    }<br>    if (substr($grid, $p, 1) eq '^') {<br>        if (defined(my $c = $cache[$p])) {<br>            $count += $c;<br>        } else {<br>            push @ alt,<br>                [$p, $count],<br>                $p + 1;<br>            $p--;<br>            next;<br>        }<br>    } else {<br>        $count++;<br>    }<br>    while (@ alt && ref $alt[-1]) {<br>        my ($ap, $ac) = @{pop @ alt};<br>        $cache[$ap] = $count - $ac;<br>    }<br>    $p = pop @ alt // last;<br>}<br><br>say $count;<br>

#AdventOfCode #perl

use v5.36;<br><br>my $grid = do { local $/; readline };<br><br>my $w = index($grid, "\n");<br>my $wl = $w - 1;<br><br>#[url=https://infosec.exchange/tags/say]say[/url] $grid;<br><br>1 while $grid =~ s{<br>    [S|] .{$wl}<br>    (<br>        (?= \.\^ )<br>    |<br>        .<br>        \^?<br>    )<br>    \K \.<br>}{|}xsng;<br><br>#[url=https://infosec.exchange/tags/say]say[/url] $grid;<br>say scalar(() = $grid =~ m{ [S|] (?= .{$w} \^ ) }xsg);<br>

use v5.36;<br>use List::Util qw(sum0 product);<br><br>my %fn = (<br>    '+' => \&sum0,<br>    '*' => \&product,<br>);<br><br>my $grid = do { local $/; readline };<br>my $w = index($grid, "\n") + 1;<br>my $h = $grid =~ tr/\n//;<br><br>my $sum = 0;<br><br>my ($op, @vals);<br>for my $i (0 .. $w - 1) {<br>    $op //= substr $grid, ($h - 1) * $w + $i, 1;<br>    my $val = '';<br>    for my $j (0 .. $h - 2) {<br>        my $c = substr $grid, $j * $w + $i, 1;<br>        $val .= $c<br>            if $c =~ /^\d\z/a;<br>    }<br>    if (length $val) {<br>        push @vals, $val;<br>        next;<br>    }<br>    $sum += $fn{$op}(splice @vals);<br>    $op = undef;<br>}<br><br>say $sum;<br>

use v5.36;<br>use List::Util qw(sum0 product zip);<br><br>my %fn = (<br>    '+' => \&sum0,<br>    '*' => \&product,<br>);<br><br>my @input = zip map [split], readline;<br><br>my $sum = 0;<br>for my $col (@input) {<br>    my $op = pop @$col;<br>    $sum += $fn{$op}(@$col);<br>}<br><br>say $sum;<br>

use v5.36;<br>use List::Util qw(sum0 min);<br><br>my @ranges;<br>while (readline) {<br>    chomp;<br>    last if $_ eq '';<br><br>    my ($lo, $hi) = m{^ (\d+) - (\d+) \z}xa<br>        or die "bad input: '$_'";<br><br>    push @ranges, [$lo, $hi + 1];<br>}<br><br>@ranges = sort { $a->[1] <=> $b->[1] } @ranges;<br><br>for my $i (reverse 1 .. $#[url=https://infosec.exchange/tags/ranges]ranges[/url]) {<br>    if ($ranges[$i - 1][1] >= $ranges[$i][0]) {<br>        $ranges[$i - 1][1] = $ranges[$i][1];<br>        $ranges[$i - 1][0] = min $ranges[$i - 1][0], $ranges[$i][0];<br>        splice @ranges, $i, 1;<br>    }<br>}<br><br>say sum0 map $_->[1] - $_->[0], @ranges;<br>

use v5.36;<br><br>my $grid = do { local $/; readline };<br>my $width = index($grid, "\n") + 1;<br><br>my $count = 0;<br>while ($grid =~ /\@/g) {<br>    my $p = $-[0];<br>    my $bad = 0;<br>    for my $o (map +($_, -$_), 1, $width - 1, $width, $width + 1) {<br>        my $q = $p + $o;<br>        $bad++<br>            if 0 <= $q < length($grid)<br>            && substr($grid, $q, 1) eq '@';<br>    }<br>    if ($bad < 4) {<br>        $count++;<br>        substr $grid, $p, 1, '.';<br>    }<br>}<br><br>say $count;<br>

use v5.36;<br><br>my $sum = 0;<br><br>while (readline) {<br>    chomp;<br><br>    my $v = 0;<br>    my $p = 0;<br>    for my $k (reverse 1 .. 12) {<br>        my $d = substr $_, $p, 1;<br>        for my $i ($p + 1 .. length($_) - $k) {<br>            my $x = substr $_, $i, 1;<br>            if ($x gt $d) {<br>                $d = $x;<br>                $p = $i;<br>            }<br>        }<br>        $v .= $d;<br>        $p++;<br>    }<br><br>    $sum += $v;<br>}<br><br>say $sum;<br>

use v5.36;<br><br>my $pos = 50;<br>my $tick1 = my $tick2 = 0;<br><br>while (readline) {<br>    my ($sign, $mag) = /^([LR])(\d+)$/a or die "bad input";<br>    my $flect =<br>        $sign eq 'L'<br>            ? sub ($n) { -$n % 100 }<br>            : sub ($n) { $n };<br>    my $vpos = $flect->($pos) + $mag;<br>    $tick2 += int($vpos / 100);<br>    $pos = $flect->($vpos) % 100<br>        or $tick1++;<br>}<br><br>say "$tick1, $tick2";<br>