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
|
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
|
