Tarjan

#!/usr/local/bin/perl
#u# http://rosettacode.org/wiki/Tarjan
#c# 2018-11-19 >RC, 2020-03-09 <RC
#p# OK
#n# use of the lexical subroutine required else the variables will not be shared

my @res;

use v5.36.0;

use List::Util qw(min);

sub tarjan (%k) {
    my (%onstack, %index, %lowlink, @stack, @connected);

    my sub strong_connect ($vertex, $i) {
        $index{$vertex}   = $i;
        $lowlink{$vertex} = $i + 1;
        $onstack{$vertex} = 1;
        push @stack, $vertex;
        for my $connection (@{$k{$vertex}}) {
            if (not defined $index{$connection}) {
                __SUB__->($connection, $i + 1);
                $lowlink{$vertex} = min($lowlink{$connection}, $lowlink{$vertex});
            }
            elsif ($onstack{$connection}) {
                $lowlink{$vertex} = min($index{$connection}, $lowlink{$vertex});
            }
        }
        if ($lowlink{$vertex} eq $index{$vertex}) {
            my @node;
            do {
                push @node, pop @stack;
                $onstack{$node[-1]} = 0;
            } while $node[-1] ne $vertex;
            push @connected, [@node];
        }
    }

    for (sort keys %k) {
        strong_connect($_, 0) unless $index{$_};
    }
    @connected;
}

my %test1 = (
             0 => [1],
             1 => [2],
             2 => [0],
             3 => [1, 2, 4],
             4 => [3, 5],
             5 => [2, 6],
             6 => [5],
             7 => [4, 6, 7]
            );

my %test2 = (
             'Andy' => ['Bart'],
             'Bart' => ['Carl'],
             'Carl' => ['Andy'],
             'Dave' => [qw<Bart Carl Earl>],
             'Earl' => [qw<Dave Fred>],
             'Fred' => [qw<Carl Gary>],
             'Gary' => ['Fred'],
             'Hank' => [qw<Earl Gary Hank>]
            );

print "Strongly connected components:\n";
push @res, join ', ', sort @$_ for tarjan(%test1);
print "\nStrongly connected components:\n";
push @res, join ', ', sort @$_ for tarjan(%test2);

say my $result = join "\n", @res;

my $ref = <<'EOD';
0, 1, 2
5, 6
3, 4
7
Andy, Bart, Carl
Fred, Gary
Dave, Earl
Hank
EOD

use Test::More;
chop $ref;
is($result, $ref);
done_testing;