Re: [QUIZ] Perl 'Medium' Quiz: Graph Connected Components (#2006-12-29)

qotwdiscuss-rAR/[email protected] (Ton Hospel) Thu, 18 Jan 2007 12:38:14 +0000 (UTC)
Newsgroups gmane.comp.lang.perl.qotw.discuss
Organization lunix confusion services
Message-ID <[email protected]>
Fast Union Find seems the obvious way to do this.
So the following code is essentially equivalent to Julien's union find, but:

- I combined the loops for initializing and unioning
- To simplify that I assumed no node scalars will be (not equal) perl false.
  (once perl has the defined-or patches replace the ||= by //= )
- In the root finder (which by the way is also a loop collapser)
  At first I though that not collapsing the whole path to the root
  made it not fast union find, but each collapse halves the path length, so
  the cost of multiple calls to the same node is n+n/2+n/4+.. = 2n, so it's
  still linear. And if the extra calls never happen, it avoids the unneeded
  assigns. For the same reason I skip "current" more aggressively and made
  the component lookup use the root of $_->[1] instead of $_->[0] since due
  to the construction method it tends to be closer to the root, so it might
  get lucky and avoid an unneeded collapse.
- I streamlined the component collector a bit

sub connected {
   my ($edges) = @_;

   my (%uf, %components);
   $uf{root(\%uf, $uf{$_->[0]} ||= $_->[0])} = $uf{$_->[1]} ||= $_->[1] for
       @$edges;
   push @{$components{root(\%uf, $_->[1])}}, $_ for @$edges;
   return [values %components];
}

sub root {
   my ($uf, $u) = @_;
   $u = $uf->{$u} = $uf->{$uf->{$u}} while $uf->{$u} ne $u;
   return $u;
}