File Coverage

Bio/PhyloNetwork/TreeFactory.pm
Criterion Covered Total %
statement 65 66 98.4
branch 13 14 92.8
condition 2 3 66.6
subroutine 6 6 100.0
pod 2 2 100.0
total 88 91 96.7


line stmt bran cond sub pod time code
1             #
2             # Module for Bio::PhyloNetwork::TreeFactory
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::TreeFactory - Module to sequentially generate
17             Phylogenetic Trees
18              
19             =head1 SYNOPSIS
20              
21             use strict;
22             use warnings;
23              
24             use Bio::PhyloNetwork;
25             use Bio::PhyloNetwork::TreeFactory;
26              
27             # Will generate sequentially all the 15 binary phylogetic
28             # trees with 4 leaves
29              
30             my $factory=Bio::PhyloNetwork::TreeFactory->new(-numleaves=>4);
31              
32             my @nets;
33              
34             while (my $net=$factory->next_network()) {
35             push @nets,$net;
36             print "".(scalar @nets).": ".$net->eNewick()."\n";
37             }
38              
39             =head1 DESCRIPTION
40              
41             Sequentially builds a (binary) phylogenetic tree each time
42             next_network is called.
43              
44             =head1 AUTHOR
45              
46             Gabriel Cardona, gabriel(dot)cardona(at)uib(dot)es
47              
48             =head1 SEE ALSO
49              
50             L
51              
52             =head1 APPENDIX
53              
54             The rest of the documentation details each of the object methods.
55              
56             =cut
57              
58             package Bio::PhyloNetwork::TreeFactory;
59              
60 2     2   542 use strict;
  2         2  
  2         54  
61 2     2   10 use warnings;
  2         2  
  2         64  
62              
63 2     2   10 use base qw(Bio::Root::Root);
  2         3  
  2         175  
64              
65 2     2   8 use Bio::PhyloNetwork;
  2         2  
  2         788  
66              
67             =head2 new
68              
69             Title : new
70             Usage : my $factory = new Bio::PhyloNetwork::TreeFactory();
71             Function: Creates a new Bio::PhyloNetwork::TreeFactory
72             Returns : Bio::PhyloNetwork::RandomFactory
73             Args : -numleaves => integer
74             OR
75             -leaves => reference to an array (of leaves names)
76              
77             Returns a Bio::PhyloNetwork::TreeFactory object. Such an object will
78             sequentially create binary phylogenetic trees
79             each time next_network is called.
80              
81             If the parameter -leaves=E\@leaves is given, then the set of leaves of
82             these networks will be @leaves. If it is given the parameter
83             -numleaves=E$numleaves, then the set of leaves will be "l1"..."l$numleaves".
84              
85             =cut
86              
87             sub new {
88 5     5 1 139 my ($pkg,@args)=@_;
89              
90 5         21 my $self=$pkg->SUPER::new(@args);
91              
92 5         20 my ($leavesR,$numleaves,$numhybrids)=
93             $self->_rearrange([qw(LEAVES
94             NUMLEAVES
95             NUMHYBRIDS)],@args);
96              
97 5         6 my @leaves;
98 5 100 66     13 if ((! defined $leavesR) && (defined $numleaves)) {
99 1         3 @leaves=map {"l$_"} (1..$numleaves);
  4         7  
100 1         2 $leavesR=\@leaves;
101             }
102 5 50       11 if (! defined $leavesR) {
103 0         0 $self->throw("No leaves set neither numleaves given");
104             }
105 5         9 @leaves=@$leavesR;
106 5         5 $self->{leaves}=$leavesR;
107              
108 5         6 $numleaves=@leaves;
109 5         6 $self->{numleaves}=$numleaves;
110 5 100       10 if ($numleaves > 2) {
111 3         5 my @leavesparent=@leaves;
112 3         5 my $newleaf=pop @leavesparent;
113 3         4 $self->{newleaf}=$newleaf;
114             $self->{parent}=
115 3         14 new($pkg,-leaves=>\@leavesparent);
116 3         8 my $oldnet=$self->{parent}->next_network();
117 3         4 $self->{oldnet}=$oldnet;
118 3         12 my @candidates=$oldnet->nodes();
119 3         6 $self->{candidates}=\@candidates;
120             }
121 5         8 $self->{index}=0;
122              
123 5         15 bless($self,$pkg);
124             }
125              
126             =head2 next_network
127              
128             Title : next_network
129             Usage : my $net=$factory->next_network()
130             Function: returns a tree
131             Returns : Bio::PhyloNetwork
132             Args : none
133              
134             =cut
135              
136             sub next_network {
137 28     28 1 727 my ($self)=@_;
138              
139 28         31 my $n=$self->{numleaves};
140 28 100       44 if ($self->{numleaves} == 2) {
141 4 100       8 if ($self->{index} == 0) {
142 2         23 my $graph=Graph::Directed->new();
143 2         456 $graph->add_edges("t0",$self->{leaves}->[0],"t0",$self->{leaves}->[1]);
144 2         321 my $net=Bio::PhyloNetwork->new(-graph=>$graph);
145 2         3 $self->{index}++;
146 2         20 return $net;
147             }
148             else {
149 2         6 return 0;
150             }
151             }
152             else {
153 24 100       26 if ($self->{index} == (scalar @{$self->{candidates}})) {
  24         44  
154 5         21 my $oldnet=$self->{parent}->next_network();
155 5 100       10 if (! $oldnet) {
156 3         5 return 0;
157             }
158 2         5 $self->{oldnet}=$oldnet;
159 2         8 my @candidates=$oldnet->nodes();
160 2         4 $self->{candidates}=\@candidates;
161 2         3 $self->{index}=0;
162             }
163 21         57 my $graph=$self->{oldnet}->{graph}->copy();
164 21         10236 my $u=$self->{candidates}->[$self->{index}];
165 21         40 foreach my $w ($graph->predecessors($u)) {
166 16         276 $graph->delete_edge($w,$u);
167 16         746 $graph->add_edge($w,"t$n");
168             }
169 21         705 $graph->add_edge("t$n",$u);
170 21         545 $graph->add_edge("t$n",$self->{newleaf});
171 21         799 my $net=Bio::PhyloNetwork->new(-graph=>$graph);
172 21         31 $self->{index}++;
173 21         187 return $net;
174             }
175             }
176              
177             1;