perllib/Graph/AdjacencyMatrix.pm

   1 package Graph::AdjacencyMatrix;
   2
   3 use strict;
   4
   5 use Graph::BitMatrix;
   6 use Graph::Matrix;
   7
   8 use base 'Graph::BitMatrix';
   9
  10 use Graph::AdjacencyMap qw(:flags :fields);
  11
  12 sub _V () { 2 } # Graph::_V
  13 sub _E () { 3 } # Graph::_E
  14
  15 sub new {
  16     my ($class, $g, %opt) = @_;
  17     my $n;
  18     my @V = $g->vertices;
  19     my $want_distance;
  20     if (exists $opt{distance_matrix}) {
  21         $want_distance = $opt{distance_matrix};
  22         delete $opt{distance_matrix};
  23     }
  24     my $d = Graph::_defattr();
  25     if (exists $opt{attribute_name}) {
  26         $d = $opt{attribute_name};
  27         $want_distance++;
  28     }
  29     delete $opt{attribute_name};
  30     my $want_transitive = 0;
  31     if (exists $opt{is_transitive}) {
  32         $want_transitive = $opt{is_transitive};
  33         delete $opt{is_transitive};
  34     }
  35     Graph::_opt_unknown(\%opt);
  36     if ($want_distance) {
  37         $n = Graph::Matrix->new($g);
  38         for my $v (@V) { $n->set($v, $v, 0) }
  39     }
  40     my $m = Graph::BitMatrix->new($g, connect_edges => $want_distance);
  41     if ($want_distance) {
  42         # for my $u (@V) {
  43         #     for my $v (@V) {
  44         #         if ($g->has_edge($u, $v)) {
  45         #             $n->set($u, $v,
  46         #                    $g->get_edge_attribute($u, $v, $d));
  47         #        }
  48         #     }
  49         # }
  50         my $Vi = $g->[_V]->[_i];
  51         my $Ei = $g->[_E]->[_i];
  52         my %V; @V{ @V } = 0 .. $#V;
  53         my $n0 = $n->[0];
  54         my $n1 = $n->[1];
  55         if ($g->is_undirected) {
  56             for my $e (keys %{ $Ei }) {
  57                 my ($i0, $j0) = @{ $Ei->{ $e } };
  58                 my $i1 = $V{ $Vi->{ $i0 } };
  59                 my $j1 = $V{ $Vi->{ $j0 } };
  60                 my $u = $V[ $i1 ];
  61                 my $v = $V[ $j1 ];
  62                 $n0->[ $i1 ]->[ $j1 ] =
  63                     $g->get_edge_attribute($u, $v, $d);
  64                 $n0->[ $j1 ]->[ $i1 ] =
  65                     $g->get_edge_attribute($v, $u, $d);
  66             }
  67         } else {
  68             for my $e (keys %{ $Ei }) {
  69                 my ($i0, $j0) = @{ $Ei->{ $e } };
  70                 my $i1 = $V{ $Vi->{ $i0 } };
  71                 my $j1 = $V{ $Vi->{ $j0 } };
  72                 my $u = $V[ $i1 ];
  73                 my $v = $V[ $j1 ];
  74                 $n0->[ $i1 ]->[ $j1 ] =
  75                     $g->get_edge_attribute($u, $v, $d);
  76             }
  77         }
  78     }
  79     bless [ $m, $n, [ @V ] ], $class;
  80 }
  81
  82 sub adjacency_matrix {
  83     my $am = shift;
  84     $am->[0];
  85 }
  86
  87 sub distance_matrix {
  88     my $am = shift;
  89     $am->[1];
  90 }
  91
  92 sub vertices {
  93     my $am = shift;
  94     @{ $am->[2] };
  95 }
  96
  97 sub is_adjacent {
  98     my ($m, $u, $v) = @_;
  99     $m->[0]->get($u, $v) ? 1 : 0;
 100 }
 101
 102 sub distance {
 103     my ($m, $u, $v) = @_;
 104     defined $m->[1] ? $m->[1]->get($u, $v) : undef;
 105 }
 106
 107 1;
 108 __END__
 109 =pod
 110
 111 =head1 NAME
 112
 113 Graph::AdjacencyMatrix - create and query the adjacency matrix of graph G
 114
 115 =head1 SYNOPSIS
 116
 117     use Graph::AdjacencyMatrix;
 118     use Graph::Directed; # or Undirected
 119
 120     my $g  = Graph::Directed->new;
 121     $g->add_...(); # build $g
 122
 123     my $am = Graph::AdjacencyMatrix->new($g);
 124     $am->is_adjacent($u, $v)
 125
 126     my $am = Graph::AdjacencyMatrix->new($g, distance_matrix => 1);
 127     $am->distance($u, $v)
 128
 129     my $am = Graph::AdjacencyMatrix->new($g, attribute_name => 'length');
 130     $am->distance($u, $v)
 131
 132     my $am = Graph::AdjacencyMatrix->new($g, ...);
 133     my @V  = $am->vertices();
 134
 135 =head1 DESCRIPTION
 136
 137 You can use C<Graph::AdjacencyMatrix> to compute the adjacency matrix
 138 and optionally also the distance matrix of a graph, and after that
 139 query the adjacencyness between vertices by using the C<is_adjacent()>
 140 method, or query the distance between vertices by using the
 141 C<distance()> method.
 142
 143 By default the edge attribute used for distance is C<w>, but you
 144 can change that in new(), see below.
 145
 146 If you modify the graph after creating the adjacency matrix of it,
 147 the adjacency matrix and the distance matrix may become invalid.
 148
 149 =head1 Methods
 150
 151 =head2 Class Methods
 152
 153 =over 4
 154
 155 =item new($g)
 156
 157 Construct the adjacency matrix of the graph $g.
 158
 159 =item new($g, options)
 160
 161 Construct the adjacency matrix of the graph $g with options as a hash.
 162 The known options are
 163
 164 =over 8
 165
 166 =item distance_matrix => boolean
 167
 168 By default only the adjacency matrix is computed.  To compute also the
 169 distance matrix, use the attribute C<distance_matrix> with a true value
 170 to the new() constructor.
 171
 172 =item attribute_name => attribute_name
 173
 174 By default the edge attribute used for distance is C<w>.  You can
 175 change that by giving another attribute name with the C<attribute_name>
 176 attribute to new() constructor.  Using this attribute also implicitly
 177 causes the distance matrix to be computed.
 178
 179 =back
 180
 181 =back
 182
 183 =head2 Object Methods
 184
 185 =over 4
 186
 187 =item is_adjacent($u, $v)
 188
 189 Return true if the vertex $v is adjacent to vertex $u, or false if not.
 190
 191 =item distance($u, $v)
 192
 193 Return the distance between the vertices $u and $v, or C<undef> if
 194 the vertices are not adjacent.
 195
 196 =item adjacency_matrix
 197
 198 Return the adjacency matrix itself (a list of bitvector scalars).
 199
 200 =item vertices
 201
 202 Return the list of vertices (useful for indexing the adjacency matrix).
 203
 204 =back
 205
 206 =head1 ALGORITHM
 207
 208 The algorithm used to create the matrix is two nested loops, which is
 209 O(V**2) in time, and the returned matrices are O(V**2) in space.
 210
 211 =head1 SEE ALSO
 212
 213 L<Graph::TransitiveClosure>, L<Graph::BitMatrix>
 214
 215 =head1 AUTHOR AND COPYRIGHT
 216
 217 Jarkko Hietaniemi F<jhi@iki.fi>
 218
 219 =head1 LICENSE
 220
 221 This module is licensed under the same terms as Perl itself.
 222
 223 =cut