/usr/share/perl5/Graph/TransitiveClosure.pm is in libgraph-perl 1:0.96-1.1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 | package Graph::TransitiveClosure;
use strict;
# 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
|