File Coverage

blib/lib/SNA/Network/Algorithm/PageRank.pm
Criterion Covered Total %
statement 37 62 59.6
branch 1 4 25.0
condition 1 4 25.0
subroutine 5 6 83.3
pod 2 2 100.0
total 46 78 58.9


line stmt bran cond sub pod time code
1             package SNA::Network::Algorithm::PageRank;
2              
3 14     14   74 use strict;
  14         30  
  14         539  
4 14     14   74 use warnings;
  14         514  
  14         496  
5              
6             require Exporter;
7 14     14   71 use base qw(Exporter);
  14         23  
  14         1418  
8             our @EXPORT = qw(calculate_pageranks calculate_weighted_pageranks);
9              
10 14     14   98 use List::Util qw(sum);
  14         42  
  14         10659  
11              
12              
13             =head1 NAME
14              
15             SNA::Network::Algorithm::PageRank - implementation of the PageRank algorithm
16              
17              
18             =head1 SYNOPSIS
19              
20             use SNA::Network;
21              
22             my $net = SNA::Network->new();
23             $net->load_from_pajek_net($filename);
24             ...
25             $net->calculate_pageranks();
26              
27              
28             =head1 METHODS
29              
30             The following methods are added to L.
31              
32             =head2 calculate_pageranks
33              
34             Calculates PageRank values for all nodes.
35             Stores the values under the hash entry B for each node object.
36              
37             You can pass named parameters to control the algorithm:
38             B specifies the number of iterations to use, and defaults to 20.
39             B specifies the damping factor of PageRank and defaults to 0.15.
40              
41             =cut
42              
43             sub calculate_pageranks {
44 1     1 1 10 my ($self, %params) = @_;
45            
46 1   50     22 my $iterations = $params{iterations} || 20;
47 1         2 my $damping = $params{damping};
48 1 50       4 $damping = 0.15 unless defined $damping;
49              
50 1         5 my $num_nodes = int $self->nodes;
51              
52             # sink nodes (nodes without successors) result into a random jumo
53 1         3 my @sink_nodes = grep { $_->out_degree == 0 } $self->nodes;
  4         14  
54 1         4 my @non_sinks = grep { $_->out_degree > 0 } $self->nodes;
  4         12  
55            
56             # start with 1.0 for each node
57 1         6 foreach my $node ($self->nodes) {
58 4         19 $node->{pagerank} = 1.0; }
59              
60             # iterative approximation
61 1         6 for (1 .. $iterations) {
62 20         27 my $sinks_pr = sum 0, map { $_->{pagerank} } @sink_nodes;
  20         65  
63 20         28 my $pr_from_sinks = $sinks_pr / $num_nodes;
64 20         20 my $flowing_pr = $num_nodes - $sinks_pr;
65 20         22 my $pr_from_jumps = $flowing_pr * $damping / $num_nodes;
66            
67 20         47 foreach my $node ($self->nodes) {
68 80         160 $node->{new_pr} = $pr_from_jumps + $pr_from_sinks;
69             }
70              
71 20         34 foreach my $node (@non_sinks) {
72 60         166 my $outgoing_pr = (1 - $damping) * $node->{pagerank} / $node->out_degree;
73 60         193 foreach my $successor ($node->outgoing_nodes) {
74 120         276 $successor->{new_pr} += $outgoing_pr;
75             }
76             }
77            
78             # copy new values
79 20         50 foreach my $node ($self->nodes) {
80 80         131 $node->{pagerank} = $node->{new_pr};
81             }
82             }
83             }
84              
85              
86             =head2 calculate_weighted_pageranks
87              
88             Intuitive extension of PageRank to weighted networks.
89              
90             Same as above, but treating edge weights as relative probabilities
91             for the node transitions.
92             Stores the values under the hash entry B for each node object,
93             the same key as above!
94              
95             You can pass the same parameters as above.
96              
97             On a weighted network, you usually want this method's values'.
98              
99             =cut
100              
101             sub calculate_weighted_pageranks {
102 0     0 1   my ($self, %params) = @_;
103            
104 0   0       my $iterations = $params{iterations} || 20;
105 0           my $damping = $params{damping};
106 0 0         $damping = 0.15 unless defined $damping;
107              
108 0           my $num_nodes = int $self->nodes;
109              
110             # sink nodes (nodes without successors) result into a random jumo
111 0           my @sink_nodes = grep { $_->out_degree == 0 } $self->nodes;
  0            
112 0           my @non_sinks = grep { $_->out_degree > 0 } $self->nodes;
  0            
113            
114             # start with 1.0 for each node
115 0           foreach my $node ($self->nodes) {
116 0           $node->{pagerank} = 1.0;
117             }
118              
119             # iterative approximation
120 0           for (1 .. $iterations) {
121 0           my $sinks_pr = sum 0, map { $_->{pagerank} } @sink_nodes;
  0            
122 0           my $pr_from_sinks = $sinks_pr / $num_nodes;
123 0           my $flowing_pr = $num_nodes - $sinks_pr;
124 0           my $pr_from_jumps = $flowing_pr * $damping / $num_nodes;
125            
126 0           foreach my $node ($self->nodes) {
127 0           $node->{new_pr} = $pr_from_jumps + $pr_from_sinks;
128             }
129              
130 0           foreach my $node (@non_sinks) {
131 0           my $outgoing_pr = (1 - $damping) * $node->{pagerank} / $node->weighted_out_degree;
132 0           foreach my $outgoing_link ($node->outgoing_edges) {
133 0           $outgoing_link->target->{new_pr} += $outgoing_pr * $outgoing_link->weight;
134             }
135             }
136            
137             # copy new values
138 0           foreach my $node ($self->nodes) {
139 0           $node->{pagerank} = $node->{new_pr};
140             }
141             }
142             }
143              
144              
145             =head1 AUTHOR
146              
147             Darko Obradovic, C<< >>
148              
149             =head1 BUGS
150              
151             Please report any bugs or feature requests to C, or through
152             the web interface at L. I will be notified, and then you'll
153             automatically be notified of progress on your bug as I make changes.
154              
155              
156              
157              
158             =head1 SUPPORT
159              
160             You can find documentation for this module with the perldoc command.
161              
162             perldoc SNA::Network
163              
164              
165             You can also look for information at:
166              
167             =over 4
168              
169             =item * RT: CPAN's request tracker
170              
171             L
172              
173             =item * AnnoCPAN: Annotated CPAN documentation
174              
175             L
176              
177             =item * CPAN Ratings
178              
179             L
180              
181             =item * Search CPAN
182              
183             L
184              
185             =back
186              
187              
188             =head1 ACKNOWLEDGEMENTS
189              
190              
191             =head1 COPYRIGHT & LICENSE
192              
193             Copyright 2009 Darko Obradovic, all rights reserved.
194              
195             This program is free software; you can redistribute it and/or modify it
196             under the same terms as Perl itself.
197              
198              
199             =cut
200              
201             1; # End of SNA::Network::Algorithm::PageRank
202