Tarjan: Difference between revisions
Added Perl example
SqrtNegInf (talk | contribs) (Added Perl example) |
|||
Line 251:
[7]
</pre>
=={{header|Perl}}==
{{trans|Perl 6}}
<lang perl>use feature 'state';
use List::Util qw(min);
sub tarjan {
our(%k) = @_;
our(%onstack, %index, %lowlink, @stack);
our @connected = ();
sub strong_connect {
my($vertex) = @_;
state $index = 0;
$index{$vertex} = $index;
$lowlink{$vertex} = $index++;
push @stack, $vertex;
$onstack{$vertex} = 1;
for my $connection (@{$k{$vertex}}) {
if (not $index{$connection}) {
strong_connect($connection);
$lowlink{$vertex} = min($lowlink{$connection},$lowlink{$vertex});
} elsif ($onstack{$connection}) {
$lowlink{$vertex} = min($lowlink{$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($_) 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";
print join(', ', sort @$_) . "\n" for tarjan(%test1);
print "\nStrongly connected components:\n";
print join(', ', sort @$_) . "\n" for tarjan(%test2);</lang>
{{out}}
<pre>Strongly connected components:
0, 1, 2
5, 6
3, 4
7
Strongly connected components:
Andy, Bart, Carl
Fred, Gary
Dave, Earl
Hank</pre>
=={{header|Perl 6}}==
| |||