summaryrefslogtreecommitdiff
path: root/perllib/Graph/AdjacencyMatrix.pm
blob: 6c648fec0e2c0462ff1b7baf9c2c418d3d7fc1d8 (plain)
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
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
package Graph::AdjacencyMatrix;

use strict;

use Graph::BitMatrix;
use Graph::Matrix;

use base 'Graph::BitMatrix';

use Graph::AdjacencyMap qw(:flags :fields);

sub _V () { 2 } # Graph::_V
sub _E () { 3 } # Graph::_E

sub new {
    my ($class, $g, %opt) = @_;
    my $n;
    my @V = $g->vertices;
    my $want_distance;
    if (exists $opt{distance_matrix}) {
	$want_distance = $opt{distance_matrix};
	delete $opt{distance_matrix};
    }
    my $d = Graph::_defattr();
    if (exists $opt{attribute_name}) {
	$d = $opt{attribute_name};
	$want_distance++;
    }
    delete $opt{attribute_name};
    my $want_transitive = 0;
    if (exists $opt{is_transitive}) {
	$want_transitive = $opt{is_transitive};
	delete $opt{is_transitive};
    }
    Graph::_opt_unknown(\%opt);
    if ($want_distance) {
	$n = Graph::Matrix->new($g);
	for my $v (@V) { $n->set($v, $v, 0) }
    }
    my $m = Graph::BitMatrix->new($g, connect_edges => $want_distance);
    if ($want_distance) {
	# for my $u (@V) {
	#     for my $v (@V) {
	#         if ($g->has_edge($u, $v)) {
	#             $n->set($u, $v,
	#                    $g->get_edge_attribute($u, $v, $d));
        #        }
        #     }
        # }
	my $Vi = $g->[_V]->[_i];
	my $Ei = $g->[_E]->[_i];
	my %V; @V{ @V } = 0 .. $#V;
	my $n0 = $n->[0];
	my $n1 = $n->[1];
	if ($g->is_undirected) {
	    for my $e (keys %{ $Ei }) {
		my ($i0, $j0) = @{ $Ei->{ $e } };
		my $i1 = $V{ $Vi->{ $i0 } };
		my $j1 = $V{ $Vi->{ $j0 } };
		my $u = $V[ $i1 ];
		my $v = $V[ $j1 ];
		$n0->[ $i1 ]->[ $j1 ] = 
		    $g->get_edge_attribute($u, $v, $d);
		$n0->[ $j1 ]->[ $i1 ] =
		    $g->get_edge_attribute($v, $u, $d);
	    }
	} else {
	    for my $e (keys %{ $Ei }) {
		my ($i0, $j0) = @{ $Ei->{ $e } };
		my $i1 = $V{ $Vi->{ $i0 } };
		my $j1 = $V{ $Vi->{ $j0 } };
		my $u = $V[ $i1 ];
		my $v = $V[ $j1 ];
		$n0->[ $i1 ]->[ $j1 ] =
		    $g->get_edge_attribute($u, $v, $d);
	    }
	}
    }
    bless [ $m, $n, [ @V ] ], $class;
}

sub adjacency_matrix {
    my $am = shift;
    $am->[0];
}

sub distance_matrix {
    my $am = shift;
    $am->[1];
}

sub vertices {
    my $am = shift;
    @{ $am->[2] };
}

sub is_adjacent {
    my ($m, $u, $v) = @_;
    $m->[0]->get($u, $v) ? 1 : 0;
}

sub distance {
    my ($m, $u, $v) = @_;
    defined $m->[1] ? $m->[1]->get($u, $v) : undef;
}

1;
__END__
=pod

=head1 NAME

Graph::AdjacencyMatrix - create and query the adjacency matrix of graph G

=head1 SYNOPSIS

    use Graph::AdjacencyMatrix;
    use Graph::Directed; # or Undirected

    my $g  = Graph::Directed->new;
    $g->add_...(); # build $g

    my $am = Graph::AdjacencyMatrix->new($g);
    $am->is_adjacent($u, $v)

    my $am = Graph::AdjacencyMatrix->new($g, distance_matrix => 1);
    $am->distance($u, $v)

    my $am = Graph::AdjacencyMatrix->new($g, attribute_name => 'length');
    $am->distance($u, $v)

    my $am = Graph::AdjacencyMatrix->new($g, ...);
    my @V  = $am->vertices();

=head1 DESCRIPTION

You can use C<Graph::AdjacencyMatrix> to compute the adjacency matrix
and optionally also the distance matrix of a graph, and after that
query the adjacencyness between vertices by using the C<is_adjacent()>
method, or query the distance between vertices by using the
C<distance()> method.

By default the edge attribute used for distance is C<w>, but you
can change that in new(), see below.

If you modify the graph after creating the adjacency matrix of it,
the adjacency matrix and the distance matrix may become invalid.

=head1 Methods

=head2 Class Methods

=over 4

=item new($g)

Construct the adjacency matrix of the graph $g.

=item new($g, options)

Construct the adjacency matrix of the graph $g with options as a hash.
The known options are

=over 8

=item distance_matrix => boolean

By default only the adjacency matrix is computed.  To compute also the
distance matrix, use the attribute C<distance_matrix> with a true value
to the new() constructor.

=item attribute_name => attribute_name

By default the edge attribute used for distance is C<w>.  You can
change that by giving another attribute name with the C<attribute_name>
attribute to new() constructor.  Using this attribute also implicitly
causes the distance matrix to be computed.

=back

=back

=head2 Object Methods

=over 4

=item is_adjacent($u, $v)

Return true if the vertex $v is adjacent to vertex $u, or false if not.

=item distance($u, $v)

Return the distance between the vertices $u and $v, or C<undef> if
the vertices are not adjacent.

=item adjacency_matrix

Return the adjacency matrix itself (a list of bitvector scalars).

=item vertices

Return the list of vertices (useful for indexing the adjacency matrix).

=back

=head1 ALGORITHM

The algorithm used to create the matrix is two nested loops, which is
O(V**2) in time, and the returned matrices are O(V**2) in space.

=head1 SEE ALSO

L<Graph::TransitiveClosure>, L<Graph::BitMatrix>

=head1 AUTHOR AND COPYRIGHT

Jarkko Hietaniemi F<jhi@iki.fi>

=head1 LICENSE

This module is licensed under the same terms as Perl itself.

=cut