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
|
|
|
|
|
|
|
} |