perllib/Graph/TransitiveClosure.pm

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