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); # Duplicate? 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 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 and C methods, and the paths by using the C and C methods. For further documentation, see the L. =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 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