File Coverage

blib/lib/Graph/AdjacencyMatrix.pm
Criterion Covered Total %
statement 55 55 100.0
branch 17 18 94.4
condition n/a
subroutine 13 13 100.0
pod 6 6 100.0
total 91 92 98.9


line stmt bran cond sub pod time code
1             package Graph::AdjacencyMatrix;
2              
3 7     7   511 use strict;
  7         12  
  7         210  
4 7     7   38 use warnings;
  7         15  
  7         162  
5              
6 7     7   3266 use Graph::BitMatrix;
  7         17  
  7         260  
7 7     7   3646 use Graph::Matrix;
  7         17  
  7         219  
8              
9 7     7   53 use base 'Graph::BitMatrix';
  7         14  
  7         770  
10              
11 7     7   48 use Graph::AdjacencyMap qw(:flags :fields);
  7         14  
  7         5865  
12              
13             sub _AM () { 0 }
14             sub _DM () { 1 }
15             sub _V () { 2 } # Graph::_V
16             sub _E () { 3 } # Graph::_E
17              
18             sub new {
19 75     75 1 262 my ($class, $g, %opt) = @_;
20 75         240 my @V = $g->vertices;
21 75         191 my $want_distance = delete $opt{distance_matrix};
22 75         224 my $d = Graph::_defattr();
23 75 100       213 if (exists $opt{attribute_name}) {
24 1         2 $d = delete $opt{attribute_name};
25 1         4 $want_distance++;
26             }
27 75         112 my $want_transitive = delete $opt{is_transitive};
28 75         197 Graph::_opt_unknown(\%opt);
29 75         283 my $m = Graph::BitMatrix->new($g);
30 75         223 my $self = bless [ $m, undef, \@V ], $class;
31 75 100       201 return $self if !$want_distance;
32 72         308 my $n = $self->[ _DM ] = Graph::Matrix->new($g);
33 72         284 $n->set($_, $_, 0) for @V;
34 72         163 my $n0 = $n->[0];
35 72         122 my $n1 = $n->[1];
36 72         167 my $undirected = $g->is_undirected;
37 72         173 my $multiedged = $g->multiedged;
38 72         190 for my $e ($g->edges) {
39 698         1329 my ($u, $v) = @$e;
40 698 100       1804 $n->set($u, $v, $multiedged
41             ? _multiedged_distances($g, $u, $v, $d)
42             : $g->get_edge_attribute($u, $v, $d)
43             );
44 698 50       1680 $n->set($v, $u, $multiedged
    100          
45             ? _multiedged_distances($g, $v, $u, $d)
46             : $g->get_edge_attribute($v, $u, $d)
47             ) if $undirected;
48             }
49 72         449 $self;
50             }
51              
52             sub _multiedged_distances {
53 12     12   26 my ($g, $u, $v, $attr) = @_;
54 12         16 my %r;
55 12         36 for my $id ($g->get_multiedge_ids($u, $v)) {
56 26         84 my $w = $g->get_edge_attribute_by_id($u, $v, $id, $attr);
57 26 100       93 $r{$id} = $w if defined $w;
58             }
59 12 100       64 keys %r ? \%r : undef;
60             }
61              
62 71     71 1 172 sub adjacency_matrix { $_[0]->[ _AM ] }
63              
64 61     61 1 209 sub distance_matrix { $_[0]->[ _DM ] }
65              
66 1     1 1 6 sub vertices { @{ $_[0]->[ _V ] } }
  1         4  
67              
68             sub is_adjacent {
69 2     2 1 8 my ($m, $u, $v) = @_;
70 2 100       9 $m->[ _AM ]->get($u, $v) ? 1 : 0;
71             }
72              
73             sub distance {
74 10     10 1 46 my ($m, $u, $v) = @_;
75 10 100       52 defined $m->[ _DM ] ? $m->[ _DM ]->get($u, $v) : undef;
76             }
77              
78             1;
79             __END__