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];
}