1package Graph::TransitiveClosure; 2 3use strict; 4 5# COMMENT THESE OUT FOR TESTING AND PRODUCTION. 6# $SIG{__DIE__ } = sub { use Carp; confess }; 7# $SIG{__WARN__} = sub { use Carp; confess }; 8 9use base 'Graph'; 10use Graph::TransitiveClosure::Matrix; 11 12sub _G () { Graph::_G() } 13 14sub new { 15 my ($class, $g, %opt) = @_; 16 $g->expect_non_multiedged; 17 %opt = (path_vertices => 1) unless %opt; 18 my $attr = Graph::_defattr(); 19 if (exists $opt{ attribute_name }) { 20 $attr = $opt{ attribute_name }; 21 # No delete $opt{ attribute_name } since we need to pass it on. 22 } 23 $opt{ reflexive } = 1 unless exists $opt{ reflexive }; 24 my $tcm = $g->new( $opt{ reflexive } ? 25 ( vertices => [ $g->vertices ] ) : ( ) ); 26 my $tcg = $g->get_graph_attribute('_tcg'); 27 if (defined $tcg && $tcg->[ 0 ] == $g->[ _G ]) { 28 $tcg = $tcg->[ 1 ]; 29 } else { 30 $tcg = Graph::TransitiveClosure::Matrix->new($g, %opt); 31 $g->set_graph_attribute('_tcg', [ $g->[ _G ], $tcg ]); 32 } 33 my $tcg00 = $tcg->[0]->[0]; 34 my $tcg11 = $tcg->[1]->[1]; 35 for my $u ($tcg->vertices) { 36 my $tcg00i = $tcg00->[ $tcg11->{ $u } ]; 37 for my $v ($tcg->vertices) { 38 next if $u eq $v && ! $opt{ reflexive }; 39 my $j = $tcg11->{ $v }; 40 if ( 41 # $tcg->is_transitive($u, $v) 42 # $tcg->[0]->get($u, $v) 43 vec($tcg00i, $j, 1) 44 ) { 45 my $val = $g->_get_edge_attribute($u, $v, $attr); 46 $tcm->_set_edge_attribute($u, $v, $attr, 47 defined $val ? $val : 48 $u eq $v ? 49 0 : 1); 50 } 51 } 52 } 53 $tcm->set_graph_attribute('_tcm', $tcg); 54 bless $tcm, $class; 55} 56 57sub is_transitive { 58 my $g = shift; 59 Graph::TransitiveClosure::Matrix::is_transitive($g); 60} 61 621; 63__END__ 64=pod 65 66Graph::TransitiveClosure - create and query transitive closure of graph 67 68=head1 SYNOPSIS 69 70 use Graph::TransitiveClosure; 71 use Graph::Directed; # or Undirected 72 73 my $g = Graph::Directed->new; 74 $g->add_...(); # build $g 75 76 # Compute the transitive closure graph. 77 my $tcg = Graph::TransitiveClosure->new($g); 78 $tcg->is_reachable($u, $v) # Identical to $tcg->has_edge($u, $v) 79 80 # Being reflexive is the default, meaning that null transitions 81 # (transitions from a vertex to the same vertex) are included. 82 my $tcg = Graph::TransitiveClosure->new($g, reflexive => 1); 83 my $tcg = Graph::TransitiveClosure->new($g, reflexive => 0); 84 85 # is_reachable(u, v) is always reflexive. 86 $tcg->is_reachable($u, $v) 87 88 # The reflexivity of is_transitive(u, v) depends of the reflexivity 89 # of the transitive closure. 90 $tcg->is_transitive($u, $v) 91 92 # You can check any graph for transitivity. 93 $g->is_transitive() 94 95 my $tcg = Graph::TransitiveClosure->new($g, path_length => 1); 96 $tcg->path_length($u, $v) 97 98 # path_vertices is automatically always on so this is a no-op. 99 my $tcg = Graph::TransitiveClosure->new($g, path_vertices => 1); 100 $tcg->path_vertices($u, $v) 101 102 # Both path_length and path_vertices. 103 my $tcg = Graph::TransitiveClosure->new($g, path => 1); 104 $tcg->path_vertices($u, $v) 105 $tcg->length($u, $v) 106 107 my $tcg = Graph::TransitiveClosure->new($g, attribute_name => 'length'); 108 $tcg->path_length($u, $v) 109 110=head1 DESCRIPTION 111 112You can use C<Graph::TransitiveClosure> to compute the transitive 113closure graph of a graph and optionally also the minimum paths 114(lengths and vertices) between vertices, and after that query the 115transitiveness between vertices by using the C<is_reachable()> and 116C<is_transitive()> methods, and the paths by using the 117C<path_length()> and C<path_vertices()> methods. 118 119For further documentation, see the L<Graph::TransitiveClosure::Matrix>. 120 121=head2 Class Methods 122 123=over 4 124 125=item new($g, %opt) 126 127Construct a new transitive closure object. Note that strictly speaking 128the returned object is not a graph; it is a graph plus other stuff. But 129you should be able to use it as a graph plus a couple of methods inherited 130from the Graph::TransitiveClosure::Matrix class. 131 132=back 133 134=head2 Object Methods 135 136These are only the methods 'native' to the class: see 137L<Graph::TransitiveClosure::Matrix> for more. 138 139=over 4 140 141=item is_transitive($g) 142 143Return true if the Graph $g is transitive. 144 145=item transitive_closure_matrix 146 147Return the transitive closure matrix of the transitive closure object. 148 149=back 150 151=head2 INTERNALS 152 153The transitive closure matrix is stored as an attribute of the graph 154called C<_tcm>, and any methods not found in the graph class are searched 155in the transitive closure matrix class. 156 157=cut 158