mirror of
https://github.com/netwide-assembler/nasm.git
synced 2025-03-01 17:35:38 +08:00
156 lines
4.4 KiB
Perl
156 lines
4.4 KiB
Perl
package Graph::TransitiveClosure;
|
|
|
|
# COMMENT THESE OUT FOR TESTING AND PRODUCTION.
|
|
# $SIG{__DIE__ } = sub { use Carp; confess };
|
|
# $SIG{__WARN__} = sub { use Carp; confess };
|
|
|
|
use base 'Graph';
|
|
use Graph::TransitiveClosure::Matrix;
|
|
|
|
sub _G () { Graph::_G() }
|
|
|
|
sub new {
|
|
my ($class, $g, %opt) = @_;
|
|
$g->expect_non_multiedged;
|
|
%opt = (path_vertices => 1) unless %opt;
|
|
my $attr = Graph::_defattr();
|
|
if (exists $opt{ attribute_name }) {
|
|
$attr = $opt{ attribute_name };
|
|
# No delete $opt{ attribute_name } since we need to pass it on.
|
|
}
|
|
$opt{ reflexive } = 1 unless exists $opt{ reflexive };
|
|
my $tcm = $g->new( $opt{ reflexive } ?
|
|
( vertices => [ $g->vertices ] ) : ( ) );
|
|
my $tcg = $g->get_graph_attribute('_tcg');
|
|
if (defined $tcg && $tcg->[ 0 ] == $g->[ _G ]) {
|
|
$tcg = $tcg->[ 1 ];
|
|
} else {
|
|
$tcg = Graph::TransitiveClosure::Matrix->new($g, %opt);
|
|
$g->set_graph_attribute('_tcg', [ $g->[ _G ], $tcg ]);
|
|
}
|
|
my $tcg00 = $tcg->[0]->[0];
|
|
my $tcg11 = $tcg->[1]->[1];
|
|
for my $u ($tcg->vertices) {
|
|
my $tcg00i = $tcg00->[ $tcg11->{ $u } ];
|
|
for my $v ($tcg->vertices) {
|
|
next if $u eq $v && ! $opt{ reflexive };
|
|
my $j = $tcg11->{ $v };
|
|
if (
|
|
# $tcg->is_transitive($u, $v)
|
|
# $tcg->[0]->get($u, $v)
|
|
vec($tcg00i, $j, 1)
|
|
) {
|
|
my $val = $g->_get_edge_attribute($u, $v, $attr);
|
|
$tcm->_set_edge_attribute($u, $v, $attr,
|
|
defined $val ? $val :
|
|
$u eq $v ?
|
|
0 : 1);
|
|
}
|
|
}
|
|
}
|
|
$tcm->set_graph_attribute('_tcm', $tcg);
|
|
bless $tcm, $class;
|
|
}
|
|
|
|
sub is_transitive {
|
|
my $g = shift;
|
|
Graph::TransitiveClosure::Matrix::is_transitive($g);
|
|
}
|
|
|
|
1;
|
|
__END__
|
|
=pod
|
|
|
|
Graph::TransitiveClosure - create and query transitive closure of graph
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
use Graph::TransitiveClosure;
|
|
use Graph::Directed; # or Undirected
|
|
|
|
my $g = Graph::Directed->new;
|
|
$g->add_...(); # build $g
|
|
|
|
# Compute the transitive closure graph.
|
|
my $tcg = Graph::TransitiveClosure->new($g);
|
|
$tcg->is_reachable($u, $v) # Identical to $tcg->has_edge($u, $v)
|
|
|
|
# Being reflexive is the default, meaning that null transitions
|
|
# (transitions from a vertex to the same vertex) are included.
|
|
my $tcg = Graph::TransitiveClosure->new($g, reflexive => 1);
|
|
my $tcg = Graph::TransitiveClosure->new($g, reflexive => 0);
|
|
|
|
# is_reachable(u, v) is always reflexive.
|
|
$tcg->is_reachable($u, $v)
|
|
|
|
# The reflexivity of is_transitive(u, v) depends of the reflexivity
|
|
# of the transitive closure.
|
|
$tcg->is_transitive($u, $v)
|
|
|
|
# You can check any graph for transitivity.
|
|
$g->is_transitive()
|
|
|
|
my $tcg = Graph::TransitiveClosure->new($g, path_length => 1);
|
|
$tcg->path_length($u, $v)
|
|
|
|
# path_vertices is automatically always on so this is a no-op.
|
|
my $tcg = Graph::TransitiveClosure->new($g, path_vertices => 1);
|
|
$tcg->path_vertices($u, $v)
|
|
|
|
# Both path_length and path_vertices.
|
|
my $tcg = Graph::TransitiveClosure->new($g, path => 1);
|
|
$tcg->path_vertices($u, $v)
|
|
$tcg->length($u, $v)
|
|
|
|
my $tcg = Graph::TransitiveClosure->new($g, attribute_name => 'length');
|
|
$tcg->path_length($u, $v)
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
You can use C<Graph::TransitiveClosure> to compute the transitive
|
|
closure graph 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 C<is_reachable()> and
|
|
C<is_transitive()> methods, and the paths by using the
|
|
C<path_length()> and C<path_vertices()> methods.
|
|
|
|
For further documentation, see the L<Graph::TransitiveClosure::Matrix>.
|
|
|
|
=head2 Class Methods
|
|
|
|
=over 4
|
|
|
|
=item new($g, %opt)
|
|
|
|
Construct a new transitive closure object. Note that strictly speaking
|
|
the returned object is not a graph; it is a graph plus other stuff. But
|
|
you should be able to use it as a graph plus a couple of methods inherited
|
|
from the Graph::TransitiveClosure::Matrix class.
|
|
|
|
=back
|
|
|
|
=head2 Object Methods
|
|
|
|
These are only the methods 'native' to the class: see
|
|
L<Graph::TransitiveClosure::Matrix> for more.
|
|
|
|
=over 4
|
|
|
|
=item is_transitive($g)
|
|
|
|
Return true if the Graph $g is transitive.
|
|
|
|
=item transitive_closure_matrix
|
|
|
|
Return the transitive closure matrix of the transitive closure object.
|
|
|
|
=back
|
|
|
|
=head2 INTERNALS
|
|
|
|
The transitive closure matrix is stored as an attribute of the graph
|
|
called C<_tcm>, and any methods not found in the graph class are searched
|
|
in the transitive closure matrix class.
|
|
|
|
=cut
|