Some time later, my own home-rolled hack, using a breadth first search:
package Algorithm::Graph; use strict; use Util qw(unique); # dedupes an array sub connected_components { my ($g) = @_; die "g must be arrayref" unless ref $g eq 'ARRAY'; die "empty graph?" unless @$g>0; my $adj; foreach my $pair (@$g) { die "g must be arrayref of arrayrefs" unless ref $pair eq 'ARR +AY'; die "g must be arrayref of 2-elem arrayrefs" unless @$pair == +2; my ( $x, $y ) = @$pair; $adj->{$x}{$y} = 1; $adj->{$y}{$x} = 1; } my %comp; for my $node ( keys %$adj ) { next if $comp{$node}; $comp{$node} = $node; my @neighbors = keys %{ $adj->{$node} }; while ( my $n = pop@ neighbors ) { die "set diff?" if $comp{$n} && $comp{$n} ne $node; $comp{$n} = $node; push( @neighbors, grep {! exists($comp{$_})} keys %{ $adj- +>{$n} } ); } } return [ map { my $c = $_; [ sort grep { $comp{$_} eq $c } keys %comp ]; } (sort (unique(values %comp))) ]; } 1;
And the tests
use strict; use warnings FATAL => 'all'; use Test::Exception; use Test::More tests => 12; use_ok('Algorithm::Graph'); my %graphs = ( '1,2' => [ [ 1, 2 ] ], 'a|b|c|d' => [ [qw(a a)], [qw(b b)], [qw(c c)], [qw(d d)] ], '1,2,3,4,99|a,b,c,d,e,f,g,z' => [ [qw(a b)], [qw(b c)], [qw(d c)], [qw(d e)], [qw(d f)], [qw(g d +)], [qw(z g)], [ 1, 2 ], [ 3, 2 ], [ 4, 3 ], [ 99, 1 ] ], '1,2,3,4,99|apple,kiwi,pear|a,b,c,d,e,f,g,z' => [ [qw(a b)], [qw(b c)], [qw(d c)], [qw(d e)], [qw(d f)], [qw(g d)], [qw(z g)], [ 1, 2 ], [ 3, 2 ], [ 4, 3 ], [ 99, 1 ], [ 'apple', 'pear' ], [ 'apple', 'kiwi' ] ], ); foreach my $result ( keys %graphs ) { my $cc = Algorithm::Graph::connected_components( $graphs{$result} +); my $cc2 = join( "|", map { join( ",", @$_ ) } @$cc ); is( $cc2, $result, $cc2 ); } throws_ok { Algorithm::Graph::connected_components() } qr/arrayref/, ' +empty'; throws_ok { Algorithm::Graph::connected_components('fish') } qr/arrayr +ef/, 'fish'; throws_ok { Algorithm::Graph::connected_components( {} ) } qr/arrayref +/, 'hash'; throws_ok { Algorithm::Graph::connected_components( [] ) } qr/empty/, +'[]'; throws_ok { Algorithm::Graph::connected_components( [ [] ] ) } qr/arra +yref/, '[[]]'; throws_ok { Algorithm::Graph::connected_components( [ [ 1, 2, 3 ] ] ) +} qr/2-elem/, '[[1,2,3]]'; throws_ok { Algorithm::Graph::connected_components( [ [ 1, 2 ], [] ] ) + } qr/2-elem/, '[[1,2],[]]';
Your mileage may vary.

water


In reply to Re: connected component by water
in thread connected component by water

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.