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   649 use strict;
  7         14  
  7         232  
4 7     7   35 use warnings;
  7         13  
  7         174  
5              
6 7     7   3396 use Graph::BitMatrix;
  7         19  
  7         292  
7 7     7   3289 use Graph::Matrix;
  7         17  
  7         225  
8              
9 7     7   49 use base 'Graph::BitMatrix';
  7         17  
  7         783  
10              
11 7     7   46 use Graph::AdjacencyMap qw(:flags :fields);
  7         14  
  7         6135  
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 227 my ($class, $g, %opt) = @_;
20 75         220 my @V = $g->vertices;
21 75         201 my $want_distance = delete $opt{distance_matrix};
22 75         202 my $d = Graph::_defattr();
23 75 100       194 if (exists $opt{attribute_name}) {
24 1         2 $d = delete $opt{attribute_name};
25 1         3 $want_distance++;
26             }
27 75         127 my $want_transitive = delete $opt{is_transitive};
28 75         198 Graph::_opt_unknown(\%opt);
29 75         325 my $m = Graph::BitMatrix->new($g);
30 75         208 my $self = bless [ $m, undef, \@V ], $class;
31 75 100       212 return $self if !$want_distance;
32 72         313 my $n = $self->[ _DM ] = Graph::Matrix->new($g);
33 72         284 $n->set($_, $_, 0) for @V;
34 72         160 my $n0 = $n->[0];
35 72         134 my $n1 = $n->[1];
36 72         200 my $undirected = $g->is_undirected;
37 72         194 my $multiedged = $g->multiedged;
38 72         178 for my $e ($g->edges) {
39 693         1322 my ($u, $v) = @$e;
40 693 100       1910 $n->set($u, $v, $multiedged
41             ? _multiedged_distances($g, $u, $v, $d)
42             : $g->get_edge_attribute($u, $v, $d)
43             );
44 693 50       1764 $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         458 $self;
50             }
51              
52             sub _multiedged_distances {
53 12     12   41 my ($g, $u, $v, $attr) = @_;
54 12         15 my %r;
55 12         42 for my $id ($g->get_multiedge_ids($u, $v)) {
56 26         70 my $w = $g->get_edge_attribute_by_id($u, $v, $id, $attr);
57 26 100       95 $r{$id} = $w if defined $w;
58             }
59 12 100       81 keys %r ? \%r : undef;
60             }
61              
62 71     71 1 159 sub adjacency_matrix { $_[0]->[ _AM ] }
63              
64 61     61 1 195 sub distance_matrix { $_[0]->[ _DM ] }
65              
66 1     1 1 5 sub vertices { @{ $_[0]->[ _V ] } }
  1         4  
67              
68             sub is_adjacent {
69 2     2 1 7 my ($m, $u, $v) = @_;
70 2 100       10 $m->[ _AM ]->get($u, $v) ? 1 : 0;
71             }
72              
73             sub distance {
74 10     10 1 45 my ($m, $u, $v) = @_;
75 10 100       48 defined $m->[ _DM ] ? $m->[ _DM ]->get($u, $v) : undef;
76             }
77              
78             1;
79             __END__