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   545 use strict;
  7         14  
  7         181  
4 7     7   33 use warnings;
  7         13  
  7         153  
5              
6 7     7   2817 use Graph::BitMatrix;
  7         18  
  7         279  
7 7     7   3228 use Graph::Matrix;
  7         18  
  7         293  
8              
9 7     7   45 use base 'Graph::BitMatrix';
  7         15  
  7         809  
10              
11 7     7   42 use Graph::AdjacencyMap qw(:flags :fields);
  7         14  
  7         5020  
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 254 my ($class, $g, %opt) = @_;
20 75         285 my @V = $g->vertices;
21 75         165 my $want_distance = delete $opt{distance_matrix};
22 75         175 my $d = Graph::_defattr();
23 75 100       231 if (exists $opt{attribute_name}) {
24 1         2 $d = delete $opt{attribute_name};
25 1         2 $want_distance++;
26             }
27 75         141 my $want_transitive = delete $opt{is_transitive};
28 75         190 Graph::_opt_unknown(\%opt);
29 75         420 my $m = Graph::BitMatrix->new($g);
30 75         215 my $self = bless [ $m, undef, \@V ], $class;
31 75 100       258 return $self if !$want_distance;
32 72         415 my $n = $self->[ _DM ] = Graph::Matrix->new($g);
33 72         320 $n->set($_, $_, 0) for @V;
34 72         131 my $n0 = $n->[0];
35 72         119 my $n1 = $n->[1];
36 72         158 my $undirected = $g->is_undirected;
37 72         194 my $multiedged = $g->multiedged;
38 72         179 for my $e ($g->edges) {
39 688         1253 my ($u, $v) = @$e;
40 688 100       2329 $n->set($u, $v, $multiedged
41             ? _multiedged_distances($g, $u, $v, $d)
42             : $g->get_edge_attribute($u, $v, $d)
43             );
44 688 50       1430 $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         564 $self;
50             }
51              
52             sub _multiedged_distances {
53 12     12   23 my ($g, $u, $v, $attr) = @_;
54 12         14 my %r;
55 12         37 for my $id ($g->get_multiedge_ids($u, $v)) {
56 26         74 my $w = $g->get_edge_attribute_by_id($u, $v, $id, $attr);
57 26 100       80 $r{$id} = $w if defined $w;
58             }
59 12 100       61 keys %r ? \%r : undef;
60             }
61              
62 71     71 1 161 sub adjacency_matrix { $_[0]->[ _AM ] }
63              
64 61     61 1 189 sub distance_matrix { $_[0]->[ _DM ] }
65              
66 1     1 1 4 sub vertices { @{ $_[0]->[ _V ] } }
  1         5  
67              
68             sub is_adjacent {
69 2     2 1 5 my ($m, $u, $v) = @_;
70 2 100       9 $m->[ _AM ]->get($u, $v) ? 1 : 0;
71             }
72              
73             sub distance {
74 10     10 1 36 my ($m, $u, $v) = @_;
75 10 100       39 defined $m->[ _DM ] ? $m->[ _DM ]->get($u, $v) : undef;
76             }
77              
78             1;
79             __END__