File Coverage

blib/lib/Algorithm/SocialNetwork.pm
Criterion Covered Total %
statement 81 81 100.0
branch 16 16 100.0
condition 4 4 100.0
subroutine 10 10 100.0
pod 6 6 100.0
total 117 117 100.0


line stmt bran cond sub pod time code
1             package Algorithm::SocialNetwork;
2 7     7   316546 use Spiffy -Base;
  7         44922  
  7         63  
3 7     7   26421 use Quantum::Superpositions;
  7     7   15  
  7     7   208  
  7         46  
  7         13  
  7         178  
  7         7131  
  7         251900  
  7         49  
4             our $VERSION = '0.07';
5              
6             field graph => {},
7             -init => 'Graph->new()';
8              
9             ### negative value doesn't make sense for Bc
10             ### Un-normlized result.
11 3     3 1 2551 sub BetweenessCentrality {
12 3         76 my @V = $self->graph->vertices;
13 3         180 my %CB; @CB{@V}=map{0}@V;
  3         5  
  9         20  
14 3         7 for my $s (@V) {
15 9         13 my (@S,$P,%sigma,%d,@Q);
16 9         47 $P->{$_} = [] for (@V);
17 9         16 @sigma{@V} = map{0}@V; $sigma{$s} = 1;
  27         50  
  9         14  
18 9         15 @d{@V} = map{-1}@V; $d{$s} = 0;
  27         46  
  9         15  
19 9         16 push @Q,$s;
20 9         20 while(@Q) {
21 27         42 my $v = shift @Q;
22 27         44 push @S,$v;
23 27         630 for my $w ($self->graph->neighbors($v)) {
24 36 100       3929 if($d{$w} < 0) {
25 18         23 push @Q,$w;
26 18         36 $d{$w} = $d{$v} + 1;
27             }
28 36 100       134 if($d{$w} == $d{$v} + 1) {
29 18         26 $sigma{$w} += $sigma{$v};
30 18         18 push @{$P->{$w}},$v;
  18         69  
31             }
32             }
33             }
34 9         12 my %rho; $rho{$_} = 0 for(@V);
  9         40  
35 9         21 while(@S) {
36 27         34 my $w = pop @S;
37 27         31 for my $v (@{$P->{$w}}) {
  27         53  
38 18         58 $rho{$v} += ($sigma{$v}/$sigma{$w})*(1+$rho{$w});
39             }
40 27 100       134 $CB{$w} += $rho{$w} unless $w eq $s;
41             }
42             }
43 3 100       22 return @_? @CB{@_} : \%CB;
44             }
45              
46 6     6 1 1540 sub ClusteringCoefficient {
47 6         12 my $vertex = shift;
48 6         226 my @kv = $self->graph->neighbors($vertex);
49 6 100       1151 return unless @kv > 1;
50 5         17 my $edges = $self->edges(@kv);
51 5         43 return ($edges / ( @kv * (@kv - 1)));
52             }
53              
54 7     7 1 417 sub WeightedClusteringCoefficient {
55 7         13 my $vertex = shift;
56 7         161 my @kv = $self->graph->neighbors($vertex);
57 7 100       1381 return unless @kv > 1;
58 6         7 my $weight = 0;
59 6         20 for($self->edges(@kv)) {
60 6   100     132 $weight += $self->graph->get_edge_weight(@$_) || 1;
61             }
62 6         1397 return ($weight / ( @kv * (@kv - 1)));
63             }
64              
65 4     4 1 1102 sub ClosenessCentrality {
66 4         12 my $vertex = shift;
67 4         119 my $sp = $self->graph->SPT_Dijkstra(first_root => $vertex);
68 4         11550 my $s = 0;
69 4         161 for($self->graph->vertices) {
70 12   100     23540 $s += $sp->path_length($vertex,$_) || 0;
71             }
72 4         174 return 1/$s;
73             }
74              
75             *DistanceCentrality = \&ClosenessCentrality;
76              
77 4     4 1 1120 sub GraphCentrality {
78 4         9 my $vertex = shift;
79 4         94 my $sp = $self->graph->SPT_Dijkstra(first_root => $vertex);
80 4         12459 my $s = -1;
81 4 100       135 for(map { $sp->path_length($vertex,$_) || 0 }
  12         13001  
82             $self->graph->vertices) {
83 12 100       159 $s = $_ if $_ > $s;
84             }
85 4         32 return 1/$s;
86             }
87              
88             ### edges between given nodes.
89 11     11 1 19 sub edges {
90 11         32 my @nodes = @_;
91 31         14422 my @edges = grep {
92 11         339 all(@$_) eq any(@nodes)
93             } $self->graph->edges;
94 11         5358 return @edges;
95             }