File Coverage

Bio/PhyloNetwork/RandomFactory.pm
Criterion Covered Total %
statement 62 64 96.8
branch 7 12 58.3
condition 2 5 40.0
subroutine 8 8 100.0
pod 2 3 66.6
total 81 92 88.0


line stmt bran cond sub pod time code
1             #
2             # Module for Bio::PhyloNetwork::RandomFactory
3             #
4             # Please direct questions and support issues to
5             #
6             # Cared for by Gabriel Cardona
7             #
8             # Copyright Gabriel Cardona
9             #
10             # You may distribute this module under the same terms as perl itself
11              
12             # POD documentation - main docs before the code
13              
14             =head1 NAME
15              
16             Bio::PhyloNetwork::RandomFactory - Module to generate random
17             Phylogenetic Networks
18              
19             =head1 SYNOPSIS
20              
21             use strict;
22             use warnings;
23              
24             use Bio::PhyloNetwork;
25             use Bio::PhyloNetwork::RandomFactory;
26              
27             # Will generate at random all the 66 binary tree-child phylogenetic
28             # networks with 3 leaves
29              
30             my $factory=Bio::PhyloNetwork::RandomFactory->new(-numleaves=>3,-norepeat=>1);
31              
32             my @nets;
33              
34             for (my $i=0; $i<66; $i++) {
35             my $net=$factory->next_network();
36             push @nets,$net;
37             print "".(scalar @nets).": ".$net->eNewick()."\n";
38             }
39              
40             =head1 DESCRIPTION
41              
42             Builds a random (binary tree-child) phylogenetic network each time
43             next_network is called.
44              
45             =head1 AUTHOR
46              
47             Gabriel Cardona, gabriel(dot)cardona(at)uib(dot)es
48              
49             =head1 SEE ALSO
50              
51             L
52              
53             =head1 APPENDIX
54              
55             The rest of the documentation details each of the object methods.
56              
57             =cut
58              
59             package Bio::PhyloNetwork::RandomFactory;
60              
61 1     1   503 use strict;
  1         2  
  1         25  
62 1     1   4 use warnings;
  1         1  
  1         23  
63              
64 1     1   3 use base qw(Bio::Root::Root);
  1         1  
  1         56  
65              
66 1     1   5 use Bio::PhyloNetwork;
  1         1  
  1         130  
67 1     1   13 use Bio::Tree::RandomFactory;
  1         2  
  1         454  
68              
69             =head2 new
70              
71             Title : new
72             Usage : my $factory = new Bio::PhyloNetwork::RandomFactory();
73             Function: Creates a new Bio::PhyloNetwork::RandomFactory
74             Returns : Bio::PhyloNetwork::RandomFactory
75             Args : -numleaves => integer
76             OR
77             -leaves => reference to an array (of leaves names)
78             -numhybrids => integer [optional]
79             -norepeat => boolean [optional]
80              
81             Returns a Bio::PhyloNetwork::RandomFactory object. Such an object will create
82             random binary tree-child phylogenetic networks each time next_network
83             is called.
84              
85             If the parameter -leaves=E\@leaves is given, then the set of leaves of
86             these networks will be @leaves. If it is given the parameter
87             -numleaves=E$numleaves, then the set of leaves will be "l1"..."l$numleaves".
88              
89             If the parameter -numhybrids=E$numhybrids is given, then the generated
90             networks will have exactly $numhybrids hybrid nodes. Note that, necessarily,
91             $numhybrids E $numleaves. Otherwise, the number of hybrid nodes will be chosen
92             at random for each call of next_network.
93              
94             If the parameter -norepeat=E1 is given, then successive calls of next_network
95             will give non-isomorphic networks.
96              
97             =cut
98              
99             sub new {
100 1     1 1 128 my ($pkg,@args)=@_;
101              
102 1         9 my $self=$pkg->SUPER::new(@args);
103              
104 1         7 my ($leavesR,$numleaves,$numhybrids,$norepeat)=
105             $self->_rearrange([qw(LEAVES
106             NUMLEAVES
107             NUMHYBRIDS
108             NOREPEAT)],@args);
109 1         2 my @leaves;
110 1 50 33     5 if ((! defined $leavesR) && (defined $numleaves)) {
111 1         3 @leaves=map {"l$_"} (1..$numleaves);
  3         6  
112 1         2 $leavesR=\@leaves;
113             }
114 1 50       2 if (! defined $leavesR) {
115 0         0 $self->throw("No leaves set neither numleaves given");
116             }
117 1   50     3 $norepeat ||= 0;
118              
119 1         2 $self->{leaves}=\@leaves;
120 1         1 $self->{numleaves}=$numleaves;
121 1 50       3 $self->{numhybrids}=$numhybrids if defined $numhybrids;
122 1         1 $self->{norepeat}=$norepeat;
123 1         2 $self->{found}=[];
124 1         8 $self->{tree_factory}=Bio::Tree::RandomFactory->new(-taxa => \@leaves);
125 1         3 bless($self,$pkg);
126             }
127              
128             =head2 next_network
129              
130             Title : next_network
131             Usage : my $net=$factory->next_network()
132             Function: returns a random network
133             Returns : Bio::PhyloNetwork
134             Args : none
135              
136             =cut
137              
138             sub next_network {
139 66     66 1 708 my ($self)=@_;
140              
141 66         83 my $numleaves=$self->{numleaves};
142 66         55 my @found=@{$self->{found}};
  66         246  
143 66         53 my $numhybrids;
144             START:
145 493 50       992 if (! defined $self->{numhybrids}) {
146 493         1089 $numhybrids=int(rand($numleaves));
147             }
148             else {
149 0         0 $numhybrids=$self->{numhybrids};
150             }
151 493         473 my $tf=$self->{tree_factory};
152 493         1431 my $tree=$tf->next_tree;
153 493         1107 my $net=Bio::PhyloNetwork->new(-tree=>$tree);
154 493         729 for (my $i=1; $i<=$numhybrids; $i++) {
155 502         722 $net=random_attack($net,$i);
156             }
157 493 50       1048 if ($self->{norepeat}) {
158 493         610 foreach my $ant (@found) {
159 11172 100       12322 goto START if $net->is_mu_isomorphic($ant);
160             }
161 66         146 push @found,$net;
162 66         101 $self->{found}=\@found;
163             }
164 66         356 return $net;
165             }
166              
167             sub random_attack {
168 502     502 0 461 my ($net,$lbl)=@_;
169              
170 502         517 my $graph=$net->{graph};
171 502         350 my ($u1,$v1,$u2,$v2);
172 502         358 do {
173 2159         3994 my $e1=$graph->random_edge;
174 2159         160514 my $e2=$graph->random_edge;
175 2159         150128 $u1=$e1->[0];
176 2159         1725 $v1=$e1->[1];
177 2159         1424 $u2=$e2->[0];
178 2159         6067 $v2=$e2->[1];
179             } while (! $net->is_attackable($u1,$v1,$u2,$v2,$lbl));
180 502         882 $net->do_attack($u1,$v1,$u2,$v2,$lbl);
181 502         10634 return $net;
182             }
183              
184             1;