File Coverage

blib/lib/SNA/Network/Algorithm/HITS.pm
Criterion Covered Total %
statement 42 42 100.0
branch 4 4 100.0
condition n/a
subroutine 7 7 100.0
pod 1 1 100.0
total 54 54 100.0


line stmt bran cond sub pod time code
1             package SNA::Network::Algorithm::HITS;
2              
3 14     14   75 use strict;
  14         24  
  14         462  
4 14     14   74 use warnings;
  14         27  
  14         507  
5              
6             require Exporter;
7 14     14   69 use base qw(Exporter);
  14         29  
  14         1167  
8             our @EXPORT = qw(calculate_authorities_and_hubs _kleinberg_iteration);
9              
10 14     14   78 use List::Util qw(sum);
  14         27  
  14         7940  
11              
12              
13             =head1 NAME
14              
15             SNA::Network::Algorithm::HITS - implementation of Kleinberg's HITS 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_authorities_and_hubs();
26              
27              
28             =head1 METHODS
29              
30             The following methods are added to L.
31              
32             =head2 calculate_authorities_and_hubs
33              
34             Calculates authority and hub coefficients for all nodes.
35             Stores the coefficients under the hash entries B and B for each node object.
36              
37             =cut
38              
39             sub calculate_authorities_and_hubs {
40 1     1 1 7 my ($self) = @_;
41              
42             # arbitrary start vectors
43 1         6 my $x = [ (1) x int $self->nodes() ];
44 1         5 my $y = [ (1) x int $self->nodes() ];
45            
46             # 20 iterations by default, see paper
47 1         5 for (1 .. 20) {
48 20         45 ($x, $y) = $self->_kleinberg_iteration($x, $y);
49             }
50              
51 1         3 my $index = 0;
52 1         3 foreach my $node ($self->nodes()) {
53 4         6 $node->{authority} = $x->[$index];
54 4         9 $node->{hub} = $y->[$index++];
55             }
56             }
57              
58              
59             sub _kleinberg_iteration {
60 20     20   28 my ($self, $x_in, $y_in) = @_;
61              
62             # calculate new authority coefficients
63 80         217 my @x_new = map {
64 20         47 my $x_node = $self->node_at_index($_);
65 120         415 sum(
66             map {
67 80 100       190 $y_in->[$_->index()] # y's current hub coefficient
68             } $x_node->incoming_nodes()
69             ) || 0
70             } (0 .. int $self->nodes() - 1);
71              
72             # calculate new hub coefficients
73 80         174 my @y_new = map {
74 20         68 my $y_node = $self->node_at_index($_);
75 120         421 sum(
76             map {
77 80 100       178 $x_in->[$_->index()] # x's current authority coefficient
78             } $y_node->outgoing_nodes()
79             ) || 0
80             } (0 .. int $self->nodes() - 1);
81            
82              
83             # _normalise vectors so sum of squares is 1
84 20         42 _normalise(\@x_new);
85 20         46 _normalise(\@y_new);
86            
87 20         70 return (\@x_new, \@y_new);
88             }
89              
90              
91             sub _normalise {
92 40     40   55 my ($vector) = @_;
93 160         276 my $squared_sum = sum(
94 40         42 map { $_ ** 2 } @{$vector}
  40         55  
95             );
96 40         71 my $normalisation = 1 / sqrt $squared_sum;
97 40         42 foreach (@{$vector}) {
  40         67  
98 160         213 $_ *= $normalisation;
99             }
100 40         65 return $vector;
101             }
102              
103              
104             =head1 AUTHOR
105              
106             Darko Obradovic, C<< >>
107              
108             =head1 BUGS
109              
110             Please report any bugs or feature requests to C, or through
111             the web interface at L. I will be notified, and then you'll
112             automatically be notified of progress on your bug as I make changes.
113              
114              
115              
116              
117             =head1 SUPPORT
118              
119             You can find documentation for this module with the perldoc command.
120              
121             perldoc SNA::Network
122              
123              
124             You can also look for information at:
125              
126             =over 4
127              
128             =item * RT: CPAN's request tracker
129              
130             L
131              
132             =item * AnnoCPAN: Annotated CPAN documentation
133              
134             L
135              
136             =item * CPAN Ratings
137              
138             L
139              
140             =item * Search CPAN
141              
142             L
143              
144             =back
145              
146              
147             =head1 ACKNOWLEDGEMENTS
148              
149              
150             =head1 COPYRIGHT & LICENSE
151              
152             Copyright 2009 Darko Obradovic, all rights reserved.
153              
154             This program is free software; you can redistribute it and/or modify it
155             under the same terms as Perl itself.
156              
157              
158             =cut
159              
160             1; # End of SNA::Network::Algorithm::HITS
161