Configure tests to be performed automatically
[nasm.git] / perllib / Graph / BitMatrix.pm
blobde9137635ead074d04858b9948ea7a18762e4073
1 package Graph::BitMatrix;
3 use strict;
5 # $SIG{__DIE__ } = sub { use Carp; confess };
6 # $SIG{__WARN__} = sub { use Carp; confess };
8 sub _V () { 2 } # Graph::_V()
9 sub _E () { 3 } # Graph::_E()
10 sub _i () { 3 } # Index to path.
11 sub _s () { 4 } # Successors / Path to Index.
13 sub new {
14 my ($class, $g, %opt) = @_;
15 my @V = $g->vertices;
16 my $V = @V;
17 my $Z = "\0" x (($V + 7) / 8);
18 my %V; @V{ @V } = 0 .. $#V;
19 my $bm = bless [ [ ( $Z ) x $V ], \%V ], $class;
20 my $bm0 = $bm->[0];
21 my $connect_edges;
22 if (exists $opt{connect_edges}) {
23 $connect_edges = $opt{connect_edges};
24 delete $opt{connect_edges};
26 $connect_edges = 1 unless defined $connect_edges;
27 Graph::_opt_unknown(\%opt);
28 if ($connect_edges) {
29 # for (my $i = 0; $i <= $#V; $i++) {
30 # my $u = $V[$i];
31 # for (my $j = 0; $j <= $#V; $j++) {
32 # vec($bm0->[$i], $j, 1) = 1 if $g->has_edge($u, $V[$j]);
33 # }
34 # }
35 my $Vi = $g->[_V]->[_i];
36 my $Ei = $g->[_E]->[_i];
37 if ($g->is_undirected) {
38 for my $e (keys %{ $Ei }) {
39 my ($i0, $j0) = @{ $Ei->{ $e } };
40 my $i1 = $V{ $Vi->{ $i0 } };
41 my $j1 = $V{ $Vi->{ $j0 } };
42 vec($bm0->[$i1], $j1, 1) = 1;
43 vec($bm0->[$j1], $i1, 1) = 1;
45 } else {
46 for my $e (keys %{ $Ei }) {
47 my ($i0, $j0) = @{ $Ei->{ $e } };
48 vec($bm0->[$V{ $Vi->{ $i0 } }], $V{ $Vi->{ $j0 } }, 1) = 1;
52 return $bm;
55 sub set {
56 my ($m, $u, $v) = @_;
57 my ($i, $j) = map { $m->[1]->{ $_ } } ($u, $v);
58 vec($m->[0]->[$i], $j, 1) = 1 if defined $i && defined $j;
61 sub unset {
62 my ($m, $u, $v) = @_;
63 my ($i, $j) = map { $m->[1]->{ $_ } } ($u, $v);
64 vec($m->[0]->[$i], $j, 1) = 0 if defined $i && defined $j;
67 sub get {
68 my ($m, $u, $v) = @_;
69 my ($i, $j) = map { $m->[1]->{ $_ } } ($u, $v);
70 defined $i && defined $j ? vec($m->[0]->[$i], $j, 1) : undef;
73 sub set_row {
74 my ($m, $u) = splice @_, 0, 2;
75 my $m0 = $m->[0];
76 my $m1 = $m->[1];
77 my $i = $m1->{ $u };
78 return unless defined $i;
79 for my $v (@_) {
80 my $j = $m1->{ $v };
81 vec($m0->[$i], $j, 1) = 1 if defined $j;
85 sub unset_row {
86 my ($m, $u) = splice @_, 0, 2;
87 my $m0 = $m->[0];
88 my $m1 = $m->[1];
89 my $i = $m1->{ $u };
90 return unless defined $i;
91 for my $v (@_) {
92 my $j = $m1->{ $v };
93 vec($m0->[$i], $j, 1) = 0 if defined $j;
97 sub get_row {
98 my ($m, $u) = splice @_, 0, 2;
99 my $m0 = $m->[0];
100 my $m1 = $m->[1];
101 my $i = $m1->{ $u };
102 return () x @_ unless defined $i;
103 my @r;
104 for my $v (@_) {
105 my $j = $m1->{ $v };
106 push @r, defined $j ? (vec($m0->[$i], $j, 1) ? 1 : 0) : undef;
108 return @r;
111 sub vertices {
112 my ($m, $u, $v) = @_;
113 keys %{ $m->[1] };
117 __END__
118 =pod
120 =head1 NAME
122 Graph::BitMatrix - create and manipulate a V x V bit matrix of graph G
124 =head1 SYNOPSIS
126 use Graph::BitMatrix;
127 use Graph::Directed;
128 my $g = Graph::Directed->new;
129 $g->add_...(); # build $g
130 my $m = Graph::BitMatrix->new($g, %opt);
131 $m->get($u, $v)
132 $m->set($u, $v)
133 $m->unset($u, $v)
134 $m->get_row($u, $v1, $v2, ..., $vn)
135 $m->set_row($u, $v1, $v2, ..., $vn)
136 $m->unset_row($u, $v1, $v2, ..., $vn)
137 $a->vertices()
139 =head1 DESCRIPTION
141 This class enables creating bit matrices that compactly describe
142 the connected of the graphs.
144 =head2 Class Methods
146 =over 4
148 =item new($g)
150 Create a bit matrix from a Graph $g. The C<%opt>, if present,
151 can have the following options:
153 =over 8
155 =item *
157 connect_edges
159 If true or if not present, set the bits in the bit matrix that
160 correspond to edges. If false, do not set any bits. In either
161 case the bit matrix of V x V bits is allocated.
163 =back
165 =back
167 =head2 Object Methods
169 =over 4
171 =item get($u, $v)
173 Return true if the bit matrix has a "one bit" between the vertices
174 $u and $v; in other words, if there is (at least one) a vertex going from
175 $u to $v. If there is no vertex and therefore a "zero bit", return false.
177 =item set($u, $v)
179 Set the bit between the vertices $u and $v; in other words, connect
180 the vertices $u and $v by an edge. The change does not get mirrored
181 back to the original graph. Returns nothing.
183 =item unset($u, $v)
185 Unset the bit between the vertices $u and $v; in other words, disconnect
186 the vertices $u and $v by an edge. The change does not get mirrored
187 back to the original graph. Returns nothing.
189 =item get_row($u, $v1, $v2, ..., $vn)
191 Test the row at vertex C<u> for the vertices C<v1>, C<v2>, ..., C<vn>
192 Returns a list of I<n> truth values.
194 =item set_row($u, $v1, $v2, ..., $vn)
196 Sets the row at vertex C<u> for the vertices C<v1>, C<v2>, ..., C<vn>,
197 in other words, connects the vertex C<u> to the vertices C<vi>.
198 The changes do not get mirrored back to the original graph.
199 Returns nothing.
201 =item unset_row($u, $v1, $v2, ..., $vn)
203 Unsets the row at vertex C<u> for the vertices C<v1>, C<v2>, ..., C<vn>,
204 in other words, disconnects the vertex C<u> from the vertices C<vi>.
205 The changes do not get mirrored back to the original graph.
206 Returns nothing.
208 =item vertices
210 Return the list of vertices in the bit matrix.
212 =back
214 =head1 ALGORITHM
216 The algorithm used to create the matrix is two nested loops, which is
217 O(V**2) in time, and the returned matrices are O(V**2) in space.
219 =head1 AUTHOR AND COPYRIGHT
221 Jarkko Hietaniemi F<jhi@iki.fi>
223 =head1 LICENSE
225 This module is licensed under the same terms as Perl itself.
227 =cut