view release on metacpan or  search on metacpan

lib/Algorithm/Graphs/TransitiveClosure.pm  view on Meta::CPAN

    if (ref $graph eq 'HASH') {
        my @vertices = keys %{$graph};

        foreach my $k (@vertices) {
            foreach my $i (@vertices) {
                foreach my $j (@vertices) {
                    # Don't use ||= here, to avoid autovivication.
                    $graph -> {$i} -> {$j} = 1 if $graph -> {$k} -> {$j} &&
                                                  $graph -> {$i} -> {$k};
                }
            }
        }
    }
    elsif (ref $graph eq 'ARRAY') {
        my $count = @{$graph};
        for (my $k = 0; $k < $count; $k ++) {
            for (my $i = 0; $i < $count; $i ++) {
                for (my $j = 0; $j < $count; $j ++) {
                    $graph -> [$i] -> [$j] ||= $graph -> [$k] -> [$j] &&
                                               $graph -> [$i] -> [$k];
                }
            }
        }
    }

    $graph;
}

1;

__END__


=head1 NAME

Algorithm::Graphs::TransitiveClosure - Calculate the transitive closure.

=head1 SYNOPSIS

    use Algorithm::Graphs::TransitiveClosure qw /floyd_warshall/;

    my $graph = [[1, 0, 0, 0], [0, 1, 1, 1], [0, 1, 1, 0], [1, 0, 1, 1]];
    floyd_warshall $graph;
    print "There is a path from 2 to 0.\n" if $graph -> [2] -> [0];

    my $graph2 = {one   => {one => 1},
                  two   => {two => 1, three => 1, four => 1},
                  three => {two => 1, three => 1},
                  four  => {one => 1, four  => 1}};
    floyd_warshall $graph2;
    print "There is a path from three to one.\n" if
        $graph2 -> {three} -> {one};

=head1 DESCRIPTION

This is an implementation of the well known I<Floyd-Warshall> algorithm. [1,2]

The subroutine C<floyd_warshall> takes a directed graph, and calculates
its transitive closure, which will be returned. The given graph is
actually modified, so be sure to pass a copy of the graph to the routine
if you need to keep the original graph.

The subroutine takes graphs in one of the two following formats:

=over

=item floyd_warshall ARRAYREF

The graph I<G = (V, E)> is described with a list of lists, C<$graph>,
representing I<V x V>. If there is an edge between vertices C<$i> and
C<$j> (or if C<$i == $j>), then C<$graph -E<gt> [$i] -E<gt> [$j] == 1>. For all
other pairs C<($k, $l)> from I<V x V>, C<$graph -E<gt> [$k] -E<gt> [$l] == 0>.

The resulting C<$graph> will have C<$graph -E<gt> [$i] -E<gt> [$j] == 1> iff
C<$i == $j> or there is a path in I<G> from C<$i> to C<$j>, and
C<$graph -E<gt> [$i] -E<gt> [$j] == 0> otherwise.

=item floyd_warshall HASHREF

The graph I<G = (V, E)>, with labeled vertices, is described with
a hash of hashes, C<$graph>, representing I<V x V>. If there is an
edge between vertices C<$label1> and C<$label2> (or if C<$label1 eq $label2>),
then C<$graph -E<gt> {$label1} -E<gt> {$label2} == 1>. For all other pairs
C<($label3, $label4)> from I<V x V>, C<$graph -E<gt> {$label3} -E<gt> {$label4}>
does not exist.

The resulting C<$graph> will have
C<$graph -E<gt> {$label1} -E<gt> {$label2} == 1>
iff C<$label1 eq $label2> or there is a path in I<G> from
C<$label1> to C<$label2>, and C<$graph -E<gt> {$label1} -E<gt> {$label2}>
does not exist otherwise.

=back

=head1 EXAMPLES

    my $graph = [[1, 0, 0, 0],
                 [0, 1, 1, 1],
                 [0, 1, 1, 0],
                 [1, 0, 1, 1]];
    floyd_warshall $graph;
    foreach my $row (@$graph) {print "@$row\n"}

    1 0 0 0
    1 1 1 1
    1 1 1 1
    1 1 1 1

    my $graph = {one   => {one => 1},
                 two   => {two => 1, three => 1, four => 1},
                 three => {two => 1, three => 1},
                 four  => {one => 1, three => 1, four => 1}};
    floyd_warshall $graph;
    foreach my $l1 (qw /one two three four/) {
        print "$l1: ";
        foreach my $l2 (qw /one two three four/) {
            next if $l1 eq $l2;
            print "$l2 " if $graph -> {$l1} -> {$l2};
        }
        print "\n";
    }