File Coverage

blib/lib/SNA/Network/Generator/ByDensity.pm
Criterion Covered Total %
statement 19 19 100.0
branch 4 4 100.0
condition 2 3 66.6
subroutine 4 4 100.0
pod 1 1 100.0
total 30 31 96.7


line stmt bran cond sub pod time code
1             package SNA::Network::Generator::ByDensity;
2              
3 14     14   56 use strict;
  14         20  
  14         438  
4 14     14   55 use warnings;
  14         17  
  14         383  
5              
6             require Exporter;
7 14     14   78 use base qw(Exporter);
  14         18  
  14         2941  
8             our @EXPORT = qw(generate_by_density);
9              
10              
11             =head1 NAME
12              
13             SNA::Network::Generator::ByDensity - Generate random networks by density
14              
15              
16             =head1 SYNOPSIS
17              
18             use SNA::Network;
19              
20             my $net = SNA::Network->new();
21             $net->generate_by_density( nodes => 100, density => 0.05);
22             # or
23             $net->generate_by_density( nodes => 100, edges => 445);
24             ...
25              
26              
27             =head1 METHODS
28              
29             The following methods are added to L.
30              
31              
32             =head2 generate_by_density
33              
34             Generates a network with the given number of nodes
35             and the given density OR number of edges.
36             The network is not guaranteed to have the resulting number of edges,
37             but it it stochasticly expected to have them.
38             Expected Degrees are the same for all nodes.
39              
40             =cut
41              
42             sub generate_by_density {
43 2     2 1 19 my ($self, %params) = @_;
44              
45 2         8 for (0 .. $params{nodes} - 1) {
46 200         278 $self->create_node_at_index(index => $_);
47             }
48            
49 2         5 my $density = $params{density};
50 2   66     12 $density ||= $params{edges} / ($params{nodes} ** 2 - $params{nodes});
51            
52 2         5 for my $s (0 .. $params{nodes} - 1) {
53 200         299 for my $t (0 .. $params{nodes} - 1) {
54 20000 100       24998 next if $s == $t;
55 19800 100       27254 if ( rand() < $density ) {
56 942         1517 $self->create_edge( source_index => $s, target_index => $t );
57             }
58             }
59             }
60             }
61              
62              
63              
64             =head1 AUTHOR
65              
66             Darko Obradovic, C<< >>
67              
68             =head1 BUGS
69              
70             Please report any bugs or feature requests to C, or through
71             the web interface at L. I will be notified, and then you'll
72             automatically be notified of progress on your bug as I make changes.
73              
74              
75              
76              
77             =head1 SUPPORT
78              
79             You can find documentation for this module with the perldoc command.
80              
81             perldoc SNA::Network
82              
83              
84             You can also look for information at:
85              
86             =over 4
87              
88             =item * RT: CPAN's request tracker
89              
90             L
91              
92             =item * AnnoCPAN: Annotated CPAN documentation
93              
94             L
95              
96             =item * CPAN Ratings
97              
98             L
99              
100             =item * Search CPAN
101              
102             L
103              
104             =back
105              
106              
107             =head1 ACKNOWLEDGEMENTS
108              
109              
110             =head1 COPYRIGHT & LICENSE
111              
112             Copyright 2009 Darko Obradovic, all rights reserved.
113              
114             This program is free software; you can redistribute it and/or modify it
115             under the same terms as Perl itself.
116              
117              
118             =cut
119              
120             1; # End of SNA::Network::Generator::ByDensity
121