File Coverage

Bio/TreeIO/lintree.pm
Criterion Covered Total %
statement 61 67 91.0
branch 24 30 80.0
condition 1 3 33.3
subroutine 6 6 100.0
pod 2 2 100.0
total 94 108 87.0


line stmt bran cond sub pod time code
1             #
2             # BioPerl module for Bio::TreeIO::lintree
3             #
4             # Please direct questions and support issues to
5             #
6             # Cared for by Jason Stajich
7             #
8             # Copyright Jason Stajich
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::TreeIO::lintree - Parser for lintree output trees
17              
18             =head1 SYNOPSIS
19              
20             # do not use directly, use through Bio::TreeIO
21             use Bio::TreeIO;
22             my $treeio = Bio::TreeIO->new(-format => 'lintree',
23             -file => 't/data/crab.nj');
24             my $tree = $treeio->next_tree;
25              
26             =head1 DESCRIPTION
27              
28             Parser for the lintree output which looks like this
29              
30             13 sequences 1000 bootstraping
31             1 A-salina
32             2 C-vittat
33             3 C-sp.
34             4 L-aequit
35             5 P-camtsc
36             6 E-tenuim
37             7 L-splend
38             8 P-bernha
39             9 P-acadia
40             10 P-p(NE)
41             11 P-p(GU)
42             12 P-l(NE)
43             13 P-l(GU)
44             14 and 2 0.098857 1000
45             14 and 3 0.127932 1000
46             15 and 1 0.197471 1000
47             15 and 14 0.029273 874
48             16 and 10 0.011732 1000
49             16 and 11 0.004529 1000
50             17 and 12 0.002258 1000
51             17 and 13 0.000428 1000
52             18 and 16 0.017512 1000
53             18 and 17 0.010824 998
54             19 and 4 0.006534 1000
55             19 and 5 0.006992 1000
56             20 and 15 0.070461 1000
57             20 and 18 0.030579 998
58             21 and 8 0.003339 1000
59             21 and 9 0.002042 1000
60             22 and 6 0.011142 1000
61             22 and 21 0.010693 983
62             23 and 20 0.020714 996
63             23 and 19 0.020350 1000
64             24 and 23 0.008665 826
65             24 and 22 0.013457 972
66             24 and 7 0.025598 1000
67              
68             See http://www.bio.psu.edu/People/Faculty/Nei/Lab/software.htm for access
69             to the program and N Takezaki, A Rzhetsky, and M Nei, "Phylogenetic test
70             of the molecular clock and linearized trees." Mol Biol Evol 12(5):823-33.
71              
72             =head1 FEEDBACK
73              
74             =head2 Mailing Lists
75              
76             User feedback is an integral part of the evolution of this and other
77             Bioperl modules. Send your comments and suggestions preferably to
78             the Bioperl mailing list. Your participation is much appreciated.
79              
80             bioperl-l@bioperl.org - General discussion
81             http://bioperl.org/wiki/Mailing_lists - About the mailing lists
82              
83             =head2 Support
84              
85             Please direct usage questions or support issues to the mailing list:
86              
87             I
88              
89             rather than to the module maintainer directly. Many experienced and
90             reponsive experts will be able look at the problem and quickly
91             address it. Please include a thorough description of the problem
92             with code and data examples if at all possible.
93              
94             =head2 Reporting Bugs
95              
96             Report bugs to the Bioperl bug tracking system to help us keep track
97             of the bugs and their resolution. Bug reports can be submitted via the
98             web:
99              
100             https://github.com/bioperl/bioperl-live/issues
101              
102             =head1 AUTHOR - Jason Stajich
103              
104             Email jason-at-bioperl-dot-org
105              
106             =head1 CONTRIBUTORS
107              
108             Ideas and discussion from:
109             Alan Christoffels
110             Avril Coghlan
111              
112             =head1 APPENDIX
113              
114             The rest of the documentation details each of the object methods.
115             Internal methods are usually preceded with a _
116              
117             =cut
118              
119              
120             # Let the code begin...
121              
122              
123             package Bio::TreeIO::lintree;
124 3     3   18 use vars qw(%Defaults);
  3         5  
  3         147  
125 3     3   15 use strict;
  3         6  
  3         68  
126              
127              
128 3     3   14 use base qw(Bio::TreeIO);
  3         4  
  3         2181  
129             $Defaults{'NodeType'} = "Bio::Tree::Node";
130              
131             =head2 new
132              
133             Title : new
134             Usage : my $obj = Bio::TreeIO::lintree->new();
135             Function: Builds a new Bio::TreeIO::lintree object
136             Returns : an instance of Bio::TreeIO::lintree
137             Args : -nodetype => Node type to create [default Bio::Tree::Node]
138              
139              
140             =cut
141              
142             sub _initialize {
143 9     9   24 my ($self,@args) = @_;
144 9         43 $self->SUPER::_initialize(@args);
145 9         30 my ($nodetype) = $self->_rearrange([qw(NODETYPE)],@args);
146 9   33     53 $nodetype ||= $Defaults{'NodeType'};
147 9         23 $self->nodetype($nodetype);
148             }
149              
150             =head2 next_tree
151              
152             Title : next_tree
153             Usage : my $tree = $treeio->next_tree
154             Function: Gets the next tree in the stream
155             Returns : Bio::Tree::TreeI
156             Args : none
157              
158              
159             =cut
160              
161             sub next_tree {
162 12     12 1 1380 my ($self) = @_;
163 12         20 my $seentop = 0;
164 12         19 my ($tipcount,%data,@nodes) = (0);
165 12         26 my $nodetype = $self->nodetype;
166              
167 12         52 while( defined( $_ = $self->_readline) ) {
168 375 100       1728 if( /^\s*(\d+)\s+sequences/ox ) {
    100          
    100          
    50          
    100          
    100          
169 9 50       23 if( $seentop ) {
170 0         0 $self->_pushback($_);
171 0         0 last;
172             }
173 9         21 $tipcount = $1;
174 9         19 $seentop = 1;
175             } elsif( /^(\d+)\s+(\S+)\s*$/ox ) {
176             # deal with setting an outgroup
177 117 100       182 unless( defined $data{'outgroup'} ) {
178 9         31 $data{'outgroup'} = [$1,$2];
179             }
180 117         373 $nodes[$1 - 1] = { '-id' => $2 };
181             } elsif( m/^\s*(\d+)\s+and\s+(\d+)\s+(\-?\d+\.\d+)(?:\s+(\d+))?/ox ) {
182 207         504 my ($node,$descend,$blength,$bootstrap) = ( $1, $2, $3, $4 );
183             # need to -- descend and node because
184             # array is 0 based
185 207         307 $node--;$descend--;
  207         189  
186 207         308 $nodes[$descend]->{'-branch_length'} = $blength;
187 207         257 $nodes[$descend]->{'-bootstrap'} = $bootstrap; #? here
188 207         271 $nodes[$node]->{'-id'} = $node+1;
189 207         189 push @{$nodes[$node]->{'-d'}}, $descend;
  207         559  
190            
191             } elsif( /\s+(\S+)\-distance was used\./ox ) {
192 0         0 $data{'method'} = $1;
193             } elsif( /\s*seed=(\d+)/ox ) {
194 6         19 $data{'seed'} = $1;
195             } elsif( m/^outgroup:\s+(\d+)\s+(\S+)/ox ) {
196 3         13 $data{'outgroup'} = [$1,$2];
197             }
198             }
199 12 100       30 if( @nodes ) {
200 9         15 my @treenodes;
201 9         20 foreach my $n ( @nodes ) {
202 216         251 push @treenodes, $nodetype->new(%{$n});
  216         623  
203             }
204            
205 9         20 foreach my $tn ( @treenodes ) {
206 216         254 my $n = shift @nodes;
207 216 100       204 for my $ptr ( @{ $n->{'-d'} || [] } ) {
  216         533  
208 207         330 $tn->add_Descendent($treenodes[$ptr]);
209             }
210             }
211 9         104 my $T = Bio::Tree::Tree->new(-root => (pop @treenodes) );
212 9 50       28 if( $data{'outgroup'} ) {
213 9         30 my ($outgroup) = $treenodes[$data{'outgroup'}->[0]];
214 9 50       25 if( ! defined $outgroup) {
215 0         0 $self->warn("cannot find '". $data{'outgroup'}->[1]. "'\n");
216             } else {
217 9         30 $T->reroot($outgroup->ancestor);
218             }
219             }
220 9         73 return $T;
221             }
222 3         18 return; # if there are no more trees, return undef
223            
224             }
225              
226             =head2 nodetype
227              
228             Title : nodetype
229             Usage : $obj->nodetype($newval)
230             Function:
231             Example :
232             Returns : value of nodetype (a scalar)
233             Args : on set, new value (a scalar or undef, optional)
234              
235              
236             =cut
237              
238             sub nodetype{
239 21     21 1 37 my ($self,$value) = @_;
240 21 100       40 if( defined $value) {
241 9         465 eval "require $value";
242 9 50       34 if( $@ ) { $self->throw("$@: Unrecognized Node type for ".ref($self).
  0         0  
243             "'$value'");}
244            
245 9         21 my $a = bless {},$value;
246 9 50       67 unless( $a->isa('Bio::Tree::NodeI') ) {
247 0         0 $self->throw("Must provide a valid Bio::Tree::NodeI or child class to SeqFactory Not $value");
248             }
249 9         40 $self->{'nodetype'} = $value;
250             }
251 21         54 return $self->{'nodetype'};
252             }
253              
254             1;