Re: [QUIZ] Perl 'Medium' Quiz: Graph Connected Components (#2006-12-29)
"Zed Lopez" <[email protected]> Fri, 5 Jan 2007 00:37:00 -0800
| Newsgroups | gmane.comp.lang.perl.qotw.discuss |
|---|---|
| Message-ID | <[email protected]> |
Mine has some strategy in common with Bob's, but is less concise,
readable, and efficient. I did enjoy the perversity of values %{{map {
$_ => $_ } (values %network)}}, though.
sub connected {
my $links = shift;
my (%network, %order);
my $i = 0;
LINK: for my $link (@$links) {
my @vertex = @$link;
$order{$vertex[0]}{$vertex[1]} = $i++;
if (exists $network{$vertex[0]} and
exists $network{$vertex[1]}) {
if ($network{$vertex[0]} != $network{$vertex[1]}) {
my @combined_network = (@{$network{$vertex[0]}},
@{$network{$vertex[1]}}, $link);
for my $combined_network_link (@combined_network) {
for my $point (@$combined_network_link) {
$network{$point} = \@combined_network;
}
}
}
else {
push @{$network{$vertex[0]}}, $link;
}
next LINK;
}
for (0..1) {
if (exists $network{$vertex[$_]}) {
push @{$network{$vertex[$_]}}, $link;
$network{$vertex[1-$_]} = $network{$vertex[$_]};
next LINK;
}
}
my $new_network = [$link];
$network{$_} = $new_network for @vertex;
}
my @uniq = values %{{map { $_ => $_ } (values %network)}};
my @sorted = map { [sort { $order{$a->[0]}{$a->[1]} <=>
$order{$b->[0]}{$b->[1]} } @$_] } @uniq;
return [sort {$order{$a->[0][0]}{$a->[0][1]} <=>
$order{$b->[0][0]}{$b->[0][1]}} @sorted];
}