AoC 2024, day 23, part 2 (Perl)

#!/usr/bin/perl

use strict;
use warnings;

use feature         qw(say);
use List::Util      qw(reduce);

# Build undirected graph from input:
my %graph;
foreach my $conx (map {[m/(\w{2})-(\w{2})/]} <>) {
    push( $graph{$conx->[0]}->@*, $conx->[1] );
    push( $graph{$conx->[1]}->@*, $conx->[0] );
}

# Quick and dirty intersection of two lists (ASSUME: sets, so no repeats):
sub intersect ($$) {
    my ($a, $b) = @_;
    return (grep {my $av = $_; grep {$_ eq $av} @$b} @$a);
}

# Find cliques (complete subgraphs) using Bron-Kerbosch
sub recurse_bk {
    my ($r, $p, $x) = @_;                           # result, possibles, excludes
    my @ret;

    return ([@$r]) if (!@$p and !@$x);              # P and X both empty => clique

    # Try each possible vertex:
    foreach my $v (@$p) {
        my @ruv  = (@$r, $v);                       # Union of R with v
        my @pnNv = intersect( $p, $graph{$v} );     # Intersect of P with Neighbours of v
        my @xnNv = intersect( $x, $graph{$v} );     # Intersect of X with Neighbours of v

        push( @ret, &recurse_bk(\@ruv, \@pnNv, \@xnNv) );   # recurse and collect

        @$p = grep {$_ ne $v} @$p;                  # symmetric difference: P \ v
        @$x = (@$x, $v);                            # Union v into eXcludes
    }

    return (@ret);
}

my $max_clique = reduce {(@$b > @$a) ? $b : $a} &recurse_bk([], [keys %graph], []);

say "Part 2: ", join( ',', sort @$max_clique );