Tarjan: Difference between revisions
Content added Content deleted
m (→{{header|Perl}}: fixed Perl code) |
|||
Line 273: | Line 273: | ||
=={{header|Perl}}== |
=={{header|Perl}}== |
||
{{trans|Perl 6}} |
{{trans|Perl 6}} |
||
<lang perl>use |
<lang perl>use 5.016; |
||
use feature 'state'; |
|||
use List::Util qw(min); |
use List::Util qw(min); |
||
use experimental qw(lexical_subs); |
|||
sub tarjan { |
sub tarjan { |
||
my (%k) = @_; |
|||
my (%onstack, %index, %lowlink, @stack, @connected); |
|||
our @connected = (); |
|||
sub strong_connect { |
my sub strong_connect { |
||
my($vertex) = @_; |
my ($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}); |
|||
} |
|||
$lowlink{$vertex} = min($lowlink{$connection},$lowlink{$vertex}); |
|||
elsif ($onstack{$connection}) { |
|||
$lowlink{$vertex} = min($index{$connection}, $lowlink{$vertex}); |
|||
} |
|||
} |
} |
||
if ($lowlink{$vertex} eq $index{$vertex}) { |
if ($lowlink{$vertex} eq $index{$vertex}) { |
||
Line 307: | Line 308: | ||
for (sort keys %k) { |
for (sort keys %k) { |
||
strong_connect($_) unless $index{$_} |
strong_connect($_, 0) unless $index{$_}; |
||
} |
} |
||
@connected |
@connected; |
||
} |
} |
||
my %test1 = ( |
my %test1 = ( |
||
0 => [1], |
0 => [1], |
||
1 => [2], |
1 => [2], |
||
2 => [0], |
2 => [0], |
||
3 => [1, 2, 4], |
3 => [1, 2, 4], |
||
4 => [3, 5], |
4 => [3, 5], |
||
5 => [2, 6], |
5 => [2, 6], |
||
6 => [5], |
6 => [5], |
||
7 => [4, 6, 7] |
7 => [4, 6, 7] |
||
); |
|||
); |
|||
my %test2 = ( |
my %test2 = ( |
||
'Andy' => ['Bart'], |
'Andy' => ['Bart'], |
||
'Bart' => ['Carl'], |
'Bart' => ['Carl'], |
||
'Carl' => ['Andy'], |
'Carl' => ['Andy'], |
||
'Dave' => [qw<Bart Carl Earl>], |
'Dave' => [qw<Bart Carl Earl>], |
||
'Earl' => [qw<Dave Fred>], |
'Earl' => [qw<Dave Fred>], |
||
'Fred' => [qw<Carl Gary>], |
'Fred' => [qw<Carl Gary>], |
||
'Gary' => ['Fred'], |
'Gary' => ['Fred'], |
||
'Hank' => [qw<Earl Gary Hank>] |
'Hank' => [qw<Earl Gary Hank>] |
||
); |
|||
); |
|||
print "Strongly connected components:\n"; |
print "Strongly connected components:\n"; |