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

On 12/29/06, Shlomi Fish <shlomif-ik1l9ssToec+JF/[email protected]> wrote:
> You should implement a function called "connected" that will receive such an
> input and return its connected components, where a connected component is such
> that for every two nodes in it, there's a path from one to the other. So for
> the graph above the function will return:
>
> [
>     [[$A,$B],[$B,$E],[$B,$F],[$F,$E]],
>     [[$D,$C]],
> ]
>
> One constraint is that the output should be ordered according to the order
> of the links in the input. I.e: 1) the order of each link in each connected
> component correspondence to their order in the input, and 2) the order of
> the first links from each connected components corresponds to their order
> in the input.
>
> Input:
> ------
>
> connected($list), where $list = \@list, and @list is made entirely of [$i,$j]
> where $i and $j are integers.
>
> Output:
> -------
>
> $ret = connected($list) where:
>
>     @comp1 = [ [$i1,$j1], [$i2, $j2], [$i3, $j3] ];
>     @comp2 = [ [$k1,$l1], [$k2, $l2],... ];
>     @components = ( \@comp1, \@comp2,... );
>     $ret = [ @components ];
>
> ---------------------------
>
> Have fun!

Hi, below is my solution.

It wasnt clear to me what should happen for input like [[1,2],[2,1]]
and [[1,2],[1,2]] so I made it output [[[1,2],[2,1]]] and
[[[1,2],[1,2]]] respectively in such cases.

Cheers,
Yves

#!perl
use strict;
use warnings;

# $AoAoT = connected($AoT)
#
# Take an array of tuples representing edges in a graph.
# Returns an array of arrays of connected tuples, with the tuples
# being in equivelent order to their order in the input.
#
#-
#
# Loop through the elements, building up a record of the vertexes
# we have seen and which array we have put their edges into, merging
# the lists as necessary when an edge results in a join.
#
# @groups stores the different groups of connected edges.
#
# %node2group is a map of node to the group that holds its edges.
# The values are references to scalars which in turn point at an
# array stored in @groups. When merging the value of the referenced
# scalar is updated to point at the new list, allowing efficient
# update of the mapping for all of the nodes involved.
#
# %must_sort tells us which lists must be sorted later due to merging.
#
# %id is used to track the order the tuples occur in. We have to support
# things like $x=[1,2]; connected([$x,[2,3],$x,[3,4],$x]]);
#
# Once all of the edge tuples have been inserted into an array contained
# by @groups we sort those lists that require it, sort @groups itself if
# necessary and then return a reference to @groups.
#
# The tuples returned will be *COPIES* of the input.

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

    # the connected lists
    my @groups;

    # Key is node, val is scalar ref to index of @groups containing node
    my %node2group;

    # Key is idx into @groups, if val is true list must be sorted if defined
    my %must_sort;

    my ( $id, %id ) = ( 0 ); #For tracking when we encountered a given path

    foreach my $r ( @$input ) {
        # Duplicate links are not prohibited so we need to copy $r
        $r = [ @$r ];
        $id{ 0 + $r } = ++$id;
        my $x = $node2group{$r->[0]};
        my $y = $node2group{$r->[1]};
        if ( !$x && !$y ) {
            # totally new - create a new list
            my $sref = [];
            push @groups, $sref;
            $x = \$sref;
        }
        elsif ( !$x || !$y ) {
            # only a single list - use whichever it was
            $x ||= $y;
        }
        elsif ( $$x != $$y ) {
            # different - join the lists before insertion
            push @{$$x}, splice @{$$y}; # move the elments from one to the other
            delete $must_sort{0 + $$y}; # we don't need to sort an empty list
            $must_sort{0 + $$x} = $$x;  # we must sort the merged list
            $$y = $$x;                  # point the nodes to the merged list
        }
        # else the two lists same so theres nothing special to do

        push @{$$x}, $r;                # insert the new edge
        $node2group{$_} = $x for @$r;   # update the node mapping
    }

    # remove any empty lists
    @groups = grep { @$_ } @groups;

    # Did we do any merges requiring us to sort the results?
    if ( %must_sort ) {
        # sort the tuples in the groups
        for my $v (values %must_sort) {
            @$v = sort { $id{0+$a} <=> $id{0+$b} } @$v;
        }
        # then sort the groups so they are in the right order as well
        @groups = sort { $id{0+$a->[0]} <=> $id{0 + $b->[0]} } @groups;
    }

    # return the list of groups of edges.
    return \@groups;
}


-- 
perl -Mre=debug -e "/just|another|perl|hacker/"