Graph::TransitiveClosure::Matrix - create and query transitive closure of graph

Graph documentation Contained in the Graph distribution.

Index

Code Index:

NAME

Top

Graph::TransitiveClosure::Matrix - create and query transitive closure of graph

SYNOPSIS

Top

    use Graph::TransitiveClosure::Matrix;
    use Graph::Directed; # or Undirected

    my $g  = Graph::Directed->new;
    $g->add_...(); # build $g

    # Compute the transitive closure matrix.
    my $tcm = Graph::TransitiveClosure::Matrix->new($g);

    # Being reflexive is the default,
    # meaning that null transitions are included.
    my $tcm = Graph::TransitiveClosure::Matrix->new($g, reflexive => 1);
    $tcm->is_reachable($u, $v)

    # is_reachable(u, v) is always reflexive.
    $tcm->is_reachable($u, $v)

    # The reflexivity of is_transitive(u, v) depends of the reflexivity
    # of the transitive closure.
    $tcg->is_transitive($u, $v)

    my $tcm = Graph::TransitiveClosure::Matrix->new($g, path_length => 1);
    my $n = $tcm->path_length($u, $v)

    my $tcm = Graph::TransitiveClosure::Matrix->new($g, path_vertices => 1);
    my @v = $tcm->path_vertices($u, $v)

    my $tcm =
        Graph::TransitiveClosure::Matrix->new($g,
                                              attribute_name => 'length');
    my $n = $tcm->path_length($u, $v)

    my @v = $tcm->vertices

DESCRIPTION

Top

You can use Graph::TransitiveClosure::Matrix to compute the transitive closure matrix of a graph and optionally also the minimum paths (lengths and vertices) between vertices, and after that query the transitiveness between vertices by using the is_reachable() and is_transitive() methods, and the paths by using the path_length() and path_vertices() methods.

If you modify the graph after computing its transitive closure, the transitive closure and minimum paths may become invalid.

Methods

Top

Class Methods

new($g)

Construct the transitive closure matrix of the graph $g.

new($g, options)

Construct the transitive closure matrix of the graph $g with options as a hash. The known options are

attribute_name => attribute_name

By default the edge attribute used for distance is w. You can change that by giving another attribute name with the attribute_name attribute to the new() constructor.

reflexive => boolean

By default the transitive closure matrix is not reflexive: that is, the adjacency matrix has zeroes on the diagonal. To have ones on the diagonal, use true for the reflexive option.

NOTE: this behaviour has changed from Graph 0.2xxx: transitive closure graphs were by default reflexive.

path_length => boolean

By default the path lengths are not computed, only the boolean transitivity. By using true for path_length also the path lengths will be computed, they can be retrieved using the path_length() method.

path_vertices => boolean

By default the paths are not computed, only the boolean transitivity. By using true for path_vertices also the paths will be computed, they can be retrieved using the path_vertices() method.

Object Methods

is_reachable($u, $v)

Return true if the vertex $v is reachable from the vertex $u, or false if not.

path_length($u, $v)

Return the minimum path length from the vertex $u to the vertex $v, or undef if there is no such path.

path_vertices($u, $v)

Return the minimum path (as a list of vertices) from the vertex $u to the vertex $v, or an empty list if there is no such path, OR also return an empty list if $u equals $v.

has_vertices($u, $v, ...)

Return true if the transitive closure matrix has all the listed vertices, false if not.

is_transitive($u, $v)

Return true if the vertex $v is transitively reachable from the vertex $u, false if not.

vertices

Return the list of vertices in the transitive closure matrix.

path_predecessor

Return the predecessor of vertex $v in the transitive closure path going back to vertex $u.

RETURN VALUES

Top

For path_length() the return value will be the sum of the appropriate attributes on the edges of the path, weight by default. If no attribute has been set, one (1) will be assumed.

If you try to ask about vertices not in the graph, undefs and empty lists will be returned.

ALGORITHM

Top

The transitive closure algorithm used is Warshall and Floyd-Warshall for the minimum paths, which is O(V**3) in time, and the returned matrices are O(V**2) in space.

SEE ALSO

Top

Graph::AdjacencyMatrix

AUTHOR AND COPYRIGHT

Top

Jarkko Hietaniemi jhi@iki.fi

LICENSE

Top

This module is licensed under the same terms as Perl itself.

Graph documentation Contained in the Graph distribution. 
package Graph::TransitiveClosure::Matrix;

use strict;

use Graph::AdjacencyMatrix;
use Graph::Matrix;

sub _new {
    my ($g, $class, $opt, $want_transitive, $want_reflexive, $want_path, $want_path_vertices) = @_;
    my $m = Graph::AdjacencyMatrix->new($g, %$opt);
    my @V = $g->vertices;
    my $am = $m->adjacency_matrix;
    my $dm; # The distance matrix.
    my $pm; # The predecessor matrix.
    my @di;
    my %di; @di{ @V } = 0..$#V;
    my @ai = @{ $am->[0] };
    my %ai = %{ $am->[1] };
    my @pi;
    my %pi;
    unless ($want_transitive) {
	$dm = $m->distance_matrix;
	@di = @{ $dm->[0] };
	%di = %{ $dm->[1] };
	$pm = Graph::Matrix->new($g);
	@pi = @{ $pm->[0] };
	%pi = %{ $pm->[1] };
	for my $u (@V) {
	    my $diu = $di{$u};
	    my $aiu = $ai{$u};
	    for my $v (@V) {
		my $div = $di{$v};
		my $aiv = $ai{$v};
		next unless
		    # $am->get($u, $v)
		    vec($ai[$aiu], $aiv, 1)
			;
		# $dm->set($u, $v, $u eq $v ? 0 : 1)
		$di[$diu]->[$div] = $u eq $v ? 0 : 1
		    unless
			defined
			    # $dm->get($u, $v)
			    $di[$diu]->[$div]
			    ;
		$pi[$diu]->[$div] = $v unless $u eq $v;
	    }
	}
    }
    # XXX (see the bits below): sometimes, being nice and clean is the
    # wrong thing to do.  In this case, using the public API for graph
    # transitive matrices and bitmatrices makes things awfully slow.
    # Instead, we go straight for the jugular of the data structures.
    for my $u (@V) {
	my $diu = $di{$u};
	my $aiu = $ai{$u};
	my $didiu = $di[$diu];
	my $aiaiu = $ai[$aiu];
	for my $v (@V) {
	    my $div = $di{$v};
	    my $aiv = $ai{$v};
	    my $didiv = $di[$div];
	    my $aiaiv = $ai[$aiv];
	    if (
		# $am->get($v, $u)
		vec($aiaiv, $aiu, 1)
		|| ($want_reflexive && $u eq $v)) {
		my $aivivo = $aiaiv;
		if ($want_transitive) {
		    if ($want_reflexive) {
			for my $w (@V) {
			    next if $w eq $u;
			    my $aiw = $ai{$w};
			    return 0
				if  vec($aiaiu, $aiw, 1) &&
				   !vec($aiaiv, $aiw, 1);
			}
			# See XXX above.
			# for my $w (@V) {
			#    my $aiw = $ai{$w};
			#    if (
			#	# $am->get($u, $w)
			#	vec($aiaiu, $aiw, 1)
			#	|| ($u eq $w)) {
			#	return 0
			#	    if $u ne $w &&
			#		# !$am->get($v, $w)
			#		!vec($aiaiv, $aiw, 1)
			#		    ;
			#	# $am->set($v, $w)
			#	vec($aiaiv, $aiw, 1) = 1
			#	    ;
			#     }
			# }
		    } else {
			# See XXX above.
			# for my $w (@V) {
			#     my $aiw = $ai{$w};
			#     if (
			#	# $am->get($u, $w)
			#	vec($aiaiu, $aiw, 1)
			#       ) {
			#	return 0
			#	    if $u ne $w &&
			#		# !$am->get($v, $w)
			#		!vec($aiaiv, $aiw, 1)
			#		    ;
			# 	# $am->set($v, $w)
			# 	vec($aiaiv, $aiw, 1) = 1
			# 	    ;
			#     }
			# }
			$aiaiv |= $aiaiu;
		    }
		} else {
		    if ($want_reflexive) {
			$aiaiv |= $aiaiu;
			vec($aiaiv, $aiu, 1) = 1;
			# See XXX above.
			# for my $w (@V) {
			#     my $aiw = $ai{$w};
			#     if (
			# 	# $am->get($u, $w)
			#	vec($aiaiu, $aiw, 1)
			#	|| ($u eq $w)) {
			#	# $am->set($v, $w)
			#	vec($aiaiv, $aiw, 1) = 1
			#	    ;
			#     }
			# }
		    } else {
			$aiaiv |= $aiaiu;
			# See XXX above.
			# for my $w (@V) {
			#    my $aiw = $ai{$w};
			#    if (
			#	# $am->get($u, $w)
			#	vec($aiaiu, $aiw, 1)
			#       ) {
			#	# $am->set($v, $w)
			#	vec($aiaiv, $aiw, 1) = 1
			#	    ;
			#     }
			# }
		    }
		}
		if ($aiaiv ne $aivivo) {
		    $ai[$aiv] = $aiaiv;
		    $aiaiu = $aiaiv if $u eq $v;
		}
	    }
	    if ($want_path && !$want_transitive) {
		for my $w (@V) {
		    my $aiw = $ai{$w};
		    next unless
			# See XXX above.
			# $am->get($v, $u)
			vec($aiaiv, $aiu, 1)
			    &&
			# See XXX above.
			# $am->get($u, $w)
			vec($aiaiu, $aiw, 1)
			    ;
		    my $diw = $di{$w};
		    my ($d0, $d1a, $d1b);
		    if (defined $dm) {
			# See XXX above.
			# $d0  = $dm->get($v, $w);
			# $d1a = $dm->get($v, $u) || 1;
			# $d1b = $dm->get($u, $w) || 1;
			$d0  = $didiv->[$diw];
			$d1a = $didiv->[$diu] || 1;
			$d1b = $didiu->[$diw] || 1;
		    } else {
			$d1a = 1;
			$d1b = 1;
		    }
		    my $d1 = $d1a + $d1b;
		    if (!defined $d0 || ($d1 < $d0)) {
			# print "d1 = $d1a ($v, $u) + $d1b ($u, $w) = $d1 ($v, $w) (".(defined$d0?$d0:"-").")\n";
			# See XXX above.
			# $dm->set($v, $w, $d1);
			$didiv->[$diw] = $d1;
			$pi[$div]->[$diw] = $pi[$div]->[$diu]
			    if $want_path_vertices;
		    }
		}
		# $dm->set($u, $v, 1)
		$didiu->[$div] = 1
		    if $u ne $v &&
		       # $am->get($u, $v)
		       vec($aiaiu, $aiv, 1)
			   &&
		       # !defined $dm->get($u, $v);
		       !defined $didiu->[$div];
	    }
	}
    }
    return 1 if $want_transitive;
    my %V; @V{ @V } = @V;
    $am->[0] = \@ai;
    $am->[1] = \%ai;
    if (defined $dm) {
	$dm->[0] = \@di;
	$dm->[1] = \%di;
    }
    if (defined $pm) {
	$pm->[0] = \@pi;
	$pm->[1] = \%pi;
    }
    bless [ $am, $dm, $pm, \%V ], $class;
}

sub new {
    my ($class, $g, %opt) = @_;
    my %am_opt = (distance_matrix => 1);
    if (exists $opt{attribute_name}) {
	$am_opt{attribute_name} = $opt{attribute_name};
	delete $opt{attribute_name};
    }
    if ($opt{distance_matrix}) {
	$am_opt{distance_matrix} = $opt{distance_matrix};
    }
    delete $opt{distance_matrix};
    if (exists $opt{path}) {
	$opt{path_length}   = $opt{path};
	$opt{path_vertices} = $opt{path};
	delete $opt{path};
    }
    my $want_path_length;
    if (exists $opt{path_length}) {
	$want_path_length = $opt{path_length};
	delete $opt{path_length};
    }
    my $want_path_vertices;
    if (exists $opt{path_vertices}) {
	$want_path_vertices = $opt{path_vertices};
	delete $opt{path_vertices};
    }
    my $want_reflexive;
    if (exists $opt{reflexive}) {
	$want_reflexive = $opt{reflexive};
	delete $opt{reflexive};
    }
    my $want_transitive;
    if (exists $opt{is_transitive}) {
	$want_transitive = $opt{is_transitive};
	$am_opt{is_transitive} = $want_transitive;
	delete $opt{is_transitive};
    }
    die "Graph::TransitiveClosure::Matrix::new: Unknown options: @{[map { qq['$_' => $opt{$_}]} keys %opt]}"
	if keys %opt;
    $want_reflexive = 1 unless defined $want_reflexive;
    my $want_path = $want_path_length || $want_path_vertices;
    # $g->expect_dag if $want_path;
    _new($g, $class,
	 \%am_opt,
	 $want_transitive, $want_reflexive,
	 $want_path, $want_path_vertices);
}

sub has_vertices {
    my $tc = shift;
    for my $v (@_) {
	return 0 unless exists $tc->[3]->{ $v };
    }
    return 1;
}

sub is_reachable {
    my ($tc, $u, $v) = @_;
    return undef unless $tc->has_vertices($u, $v);
    return 1 if $u eq $v;
    $tc->[0]->get($u, $v);
}

sub is_transitive {
    if (@_ == 1) {	# Any graph.
	__PACKAGE__->new($_[0], is_transitive => 1);	# Scary.
    } else {		# A TC graph.
	my ($tc, $u, $v) = @_;
	return undef unless $tc->has_vertices($u, $v);
	$tc->[0]->get($u, $v);
    }
}

sub vertices {
    my $tc = shift;
    values %{ $tc->[3] };
}

sub path_length {
    my ($tc, $u, $v) = @_;
    return undef unless $tc->has_vertices($u, $v);
    return 0 if $u eq $v;
    $tc->[1]->get($u, $v);
}

sub path_predecessor {
    my ($tc, $u, $v) = @_;
    return undef if $u eq $v;
    return undef unless $tc->has_vertices($u, $v);
    $tc->[2]->get($u, $v);
}

sub path_vertices {
    my ($tc, $u, $v) = @_;
    return unless $tc->is_reachable($u, $v);
    return wantarray ? () : 0 if $u eq $v;
    my @v = ( $u );
    while ($u ne $v) {
	last unless defined($u = $tc->path_predecessor($u, $v));
	push @v, $u;
    }
    $tc->[2]->set($u, $v, [ @v ]) if @v;
    return @v;
}

1;
__END__