File Coverage

Bio/Tree/NodeI.pm
Criterion Covered Total %
statement 36 70 51.4
branch 9 14 64.2
condition 5 5 100.0
subroutine 8 26 30.7
pod 22 22 100.0
total 80 137 58.3


line stmt bran cond sub pod time code
1             #
2             # BioPerl module for Bio::Tree::NodeI
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::Tree::NodeI - Interface describing a Tree Node
17              
18             =head1 SYNOPSIS
19              
20             # get a Tree::NodeI somehow
21             # like from a TreeIO
22             use Bio::TreeIO;
23             # read in a clustalw NJ in phylip/newick format
24             my $treeio = Bio::TreeIO->new(-format => 'newick', -file => 'file.dnd');
25              
26             my $tree = $treeio->next_tree; # we'll assume it worked for demo purposes
27             # you might want to test that it was defined
28              
29             my $rootnode = $tree->get_root_node;
30              
31             # process just the next generation
32             foreach my $node ( $rootnode->each_Descendent() ) {
33             print "branch len is ", $node->branch_length, "\n";
34             }
35              
36             # process all the children
37             my $example_leaf_node;
38             foreach my $node ( $rootnode->get_all_Descendents() ) {
39             if( $node->is_Leaf ) {
40             print "node is a leaf ... ";
41             # for example use below
42             $example_leaf_node = $node unless defined $example_leaf_node;
43             }
44             print "branch len is ", $node->branch_length, "\n";
45             }
46              
47             # The ancestor() method points to the parent of a node
48             # A node can only have one parent
49              
50             my $parent = $example_leaf_node->ancestor;
51              
52             # parent won't likely have an description because it is an internal node
53             # but child will because it is a leaf
54              
55             print "Parent id: ", $parent->id," child id: ",
56             $example_leaf_node->id, "\n";
57              
58              
59             =head1 DESCRIPTION
60              
61             A NodeI is capable of the basic structure of building a tree and
62             storing the branch length between nodes. The branch length is the
63             length of the branch between the node and its ancestor, thus a root
64             node in a Tree will not typically have a valid branch length.
65              
66             Various implementations of NodeI may extend the basic functions and
67             allow storing of other information (like attatching a species object
68             or full sequences used to build a tree or alternative sequences). If
69             you don't know how to extend a Bioperl object please ask, happy to
70             help, we would also greatly appreciate contributions with improvements
71             or extensions of the objects back to the Bioperl code base so that
72             others don't have to reinvent your ideas.
73              
74              
75             =head1 FEEDBACK
76              
77             =head2 Mailing Lists
78              
79             User feedback is an integral part of the evolution of this and other
80             Bioperl modules. Send your comments and suggestions preferably to
81             the Bioperl mailing list. Your participation is much appreciated.
82              
83             bioperl-l@bioperl.org - General discussion
84             http://bioperl.org/wiki/Mailing_lists - About the mailing lists
85              
86             =head2 Support
87              
88             Please direct usage questions or support issues to the mailing list:
89              
90             I
91              
92             rather than to the module maintainer directly. Many experienced and
93             reponsive experts will be able look at the problem and quickly
94             address it. Please include a thorough description of the problem
95             with code and data examples if at all possible.
96              
97             =head2 Reporting Bugs
98              
99             Report bugs to the Bioperl bug tracking system to help us keep track
100             of the bugs and their resolution. Bug reports can be submitted via
101             the web:
102              
103             https://github.com/bioperl/bioperl-live/issues
104              
105             =head1 AUTHOR - Jason Stajich
106              
107             Email jason@bioperl.org
108              
109             =head1 CONTRIBUTORS
110              
111             Aaron Mackey amackey@virginia.edu
112              
113             =head1 APPENDIX
114              
115             The rest of the documentation details each of the object methods.
116             Internal methods are usually preceded with a _
117              
118             =cut
119              
120             # Let the code begin...
121              
122             package Bio::Tree::NodeI;
123 69     69   5376 use strict;
  69         81  
  69         1702  
124 69     69   224 no warnings 'recursion';
  69         178  
  69         2380  
125              
126 69     69   218 use base qw(Bio::Root::RootI);
  69         74  
  69         45670  
127              
128             =head2 add_Descendent
129              
130             Title : add_Descendent
131             Usage : $node->add_Descendent($node);
132             Function: Adds a descendent to a node
133             Returns : number of current descendents for this node
134             Args : Bio::Node::NodeI
135              
136              
137             =cut
138              
139             sub add_Descendent{
140 0     0 1 0 my ($self,@args) = @_;
141              
142 0         0 $self->throw_not_implemented();
143             }
144              
145              
146             =head2 each_Descendent
147              
148             Title : each_Descendent
149             Usage : my @nodes = $node->each_Descendent;
150             Function: all the descendents for this Node (but not their descendents
151             i.e. not a recursive fetchall)
152             Returns : Array of Bio::Tree::NodeI objects
153             Args : none
154              
155             =cut
156              
157             sub each_Descendent{
158 0     0 1 0 my ($self) = @_;
159 0         0 $self->throw_not_implemented();
160             }
161              
162             =head2 Decorated Interface methods
163              
164             =cut
165              
166             =head2 get_all_Descendents
167              
168             Title : get_all_Descendents($sortby)
169             Usage : my @nodes = $node->get_all_Descendents;
170             Function: Recursively fetch all the nodes and their descendents
171             *NOTE* This is different from each_Descendent
172             Returns : Array or Bio::Tree::NodeI objects
173             Args : $sortby [optional] "height", "creation", "alpha", "revalpha",
174             or a coderef to be used to sort the order of children nodes.
175              
176             =cut
177              
178             sub get_all_Descendents{
179 14146     14146 1 10767 my ($self, $sortby) = @_;
180 14146   100     15405 $sortby ||= 'none';
181 14146         8163 my @nodes;
182 14146         15337 foreach my $node ( $self->each_Descendent($sortby) ) {
183 13126         13694 push @nodes, ($node,$node->get_all_Descendents($sortby));
184             }
185 14146         22971 return @nodes;
186             }
187              
188             *get_Descendents = \&get_all_Descendents;
189              
190             =head2 is_Leaf
191              
192             Title : is_Leaf
193             Usage : if( $node->is_Leaf )
194             Function: Get Leaf status
195             Returns : boolean
196             Args : none
197              
198             =cut
199              
200             sub is_Leaf{
201 0     0 1 0 my ($self) = @_;
202 0         0 $self->throw_not_implemented();
203             }
204              
205             =head2 descendent_count
206              
207             Title : descendent_count
208             Usage : my $count = $node->descendent_count;
209             Function: Counts the number of descendents a node has
210             (and all of their subnodes)
211             Returns : integer
212             Args : none
213              
214             =cut
215              
216             sub descendent_count{
217 1334     1334 1 894 my ($self) = @_;
218 1334         791 my $count = 0;
219            
220 1334         1386 foreach my $node ( $self->each_Descendent ) {
221 1210         823 $count += 1;
222 1210 50       2399 $node->can('descendent_count') ? $count += $node->descendent_count : next;
223             }
224 1334         1734 return $count;
225             }
226              
227             =head2 to_string
228              
229             Title : to_string
230             Usage : my $str = $node->to_string()
231             Function: For debugging, provide a node as a string
232             Returns : string
233             Args : none
234              
235              
236             =cut
237              
238             sub to_string{
239 20278     20278 1 14033 my ($self) = @_;
240 20278 100       19772 return join('',defined $self->id_output ? $self->id_output : '',
    100          
241             defined $self->branch_length ? ':' . $self->branch_length
242             : ' ')
243             }
244              
245             =head2 height
246              
247             Title : height
248             Usage : my $len = $node->height
249             Function: Returns the height of the tree starting at this
250             node. Height is the maximum branchlength to get to the tip.
251             Returns : The longest length (weighting branches with branch_length) to a leaf
252             Args : none
253              
254             =cut
255              
256             sub height{
257 0     0 1 0 my ($self) = @_;
258              
259 0 0       0 return 0 if( $self->is_Leaf );
260            
261 0         0 my $max = 0;
262 0         0 foreach my $subnode ( $self->each_Descendent ) {
263 0         0 my $s = $subnode->height + $subnode->branch_length;;
264 0 0       0 if( $s > $max ) { $max = $s; }
  0         0  
265             }
266 0         0 return $max;
267             }
268              
269             =head2 depth
270              
271             Title : depth
272             Usage : my $len = $node->depth
273             Function: Returns the depth of the tree starting at this
274             node. Depth is the distance from this node to the root.
275             Returns : The branch length to the root.
276             Args : none
277              
278             =cut
279              
280             sub depth{
281 1     1 1 1 my ($self) = @_;
282            
283 1         2 my $depth = 0;
284 1         1 my $node = $self;
285 1         2 while( defined $node->ancestor ) {
286 2         4 $depth += $node->branch_length;
287 2         4 $node = $node->ancestor;
288             }
289 1         3 return $depth;
290             }
291              
292             =head2 Get/Set methods
293              
294             =cut
295              
296             =head2 branch_length
297              
298             Title : branch_length
299             Usage : $obj->branch_length()
300             Function: Get/Set the branch length
301             Returns : value of branch_length
302             Args : newvalue (optional)
303              
304              
305             =cut
306              
307             sub branch_length{
308 0     0 1 0 my ($self)= @_;
309 0         0 $self->throw_not_implemented();
310             }
311              
312             =head2 id
313              
314             Title : id
315             Usage : $obj->id($newval)
316             Function: The human readable identifier for the node
317             Returns : value of human readable id
318             Args : newvalue (optional)
319              
320              
321             =cut
322              
323             sub id{
324 0     0 1 0 my ($self)= @_;
325 0         0 $self->throw_not_implemented();
326             }
327              
328             =head2 internal_id
329              
330             Title : internal_id
331             Usage : my $internalid = $node->internal_id
332             Function: Returns the internal unique id for this Node
333             Returns : unique id
334             Args : none
335              
336             =cut
337              
338             sub internal_id{
339 0     0 1 0 my ($self) = @_;
340 0         0 $self->throw_not_implemented();
341             }
342              
343             =head2 description
344              
345             Title : description
346             Usage : $obj->description($newval)
347             Function: Get/Set the description string
348             Returns : value of description
349             Args : newvalue (optional)
350              
351              
352             =cut
353              
354             sub description{
355 0     0 1 0 my ($self) = @_;
356 0         0 $self->throw_not_implemented();
357             }
358              
359             =head2 bootstrap
360              
361             Title : bootstrap
362             Usage : $obj->bootstrap($newval)
363             Function: Get/Set the bootstrap value
364             Returns : value of bootstrap
365             Args : newvalue (optional)
366              
367              
368             =cut
369              
370             sub bootstrap{
371 0     0   0 my ($self) = @_;
372 0         0 $self->throw_not_implemented();
373             }
374              
375             =head2 ancestor
376              
377             Title : ancestor
378             Usage : my $node = $node->ancestor;
379             Function: Get/Set the ancestor node pointer for a Node
380             Returns : Null if this is top level node
381             Args : none
382              
383             =cut
384              
385              
386             sub ancestor{
387 0     0 1 0 my ($self,@args) = @_;
388 0         0 $self->throw_not_implemented();
389             }
390              
391             =head2 invalidate_height
392              
393             Title : invalidate_height
394             Usage : private helper method
395             Function: Invalidate our cached value of the node height in the tree
396             Returns : nothing
397             Args : none
398              
399             =cut
400              
401             sub invalidate_height {
402 0     0 1 0 shift->throw_not_implemented();
403             }
404              
405             =head2 Methods for associating Tag/Values with a Node
406              
407             These methods associate tag/value pairs with a Node
408              
409             =head2 set_tag_value
410              
411             Title : set_tag_value
412             Usage : $node->set_tag_value($tag,$value)
413             $node->set_tag_value($tag,@values)
414             Function: Sets a tag value(s) to a node. Replaces old values.
415             Returns : number of values stored for this tag
416             Args : $tag - tag name
417             $value - value to store for the tag
418              
419             =cut
420              
421             sub set_tag_value{
422 0     0 1 0 shift->throw_not_implemented();
423             }
424              
425             =head2 add_tag_value
426              
427             Title : add_tag_value
428             Usage : $node->add_tag_value($tag,$value)
429             Function: Adds a tag value to a node
430             Returns : number of values stored for this tag
431             Args : $tag - tag name
432             $value - value to store for the tag
433              
434              
435             =cut
436              
437             sub add_tag_value{
438 0     0 1 0 shift->throw_not_implemented();
439             }
440              
441             =head2 remove_tag
442              
443             Title : remove_tag
444             Usage : $node->remove_tag($tag)
445             Function: Remove the tag and all values for this tag
446             Returns : boolean representing success (0 if tag does not exist)
447             Args : $tag - tagname to remove
448              
449              
450             =cut
451              
452             sub remove_tag {
453 0     0 1 0 shift->throw_not_implemented();
454             }
455              
456             =head2 remove_all_tags
457              
458             Title : remove_all_tags
459             Usage : $node->remove_all_tags()
460             Function: Removes all tags
461             Returns : None
462             Args : None
463              
464              
465             =cut
466              
467             sub remove_all_tags{
468 0     0 1 0 shift->throw_not_implemented();
469             }
470              
471             =head2 get_all_tags
472              
473             Title : get_all_tags
474             Usage : my @tags = $node->get_all_tags()
475             Function: Gets all the tag names for this Node
476             Returns : Array of tagnames
477             Args : None
478              
479              
480             =cut
481              
482             sub get_all_tags {
483 0     0 1 0 shift->throw_not_implemented();
484             }
485              
486             =head2 get_tag_values
487              
488             Title : get_tag_values
489             Usage : my @values = $node->get_tag_values($tag)
490             Function: Gets the values for given tag ($tag)
491             Returns : Array of values or empty list if tag does not exist
492             Args : $tag - tag name
493              
494              
495             =cut
496              
497             sub get_tag_values{
498 0     0 1 0 shift->throw_not_implemented();
499             }
500              
501             =head2 has_tag
502              
503             Title : has_tag
504             Usage : $node->has_tag($tag)
505             Function: Boolean test if tag exists in the Node
506             Returns : Boolean
507             Args : $tag - tagname
508              
509              
510             =cut
511              
512             sub has_tag{
513 0     0 1 0 shift->throw_not_implemented();
514             }
515              
516              
517             =head2 Helper Functions
518              
519             =cut
520              
521             =head2 id_output
522              
523             Title : id_output
524             Usage : my $id = $node->id_output;
525             Function: Return an id suitable for output in format like newick
526             so that if it contains spaces or ():; characters it is properly
527             quoted
528             Returns : $id string if $node->id has a value
529             Args : none
530              
531              
532             =cut
533              
534             sub id_output{
535 30260     30260 1 18850 my $node = shift;
536 30260         31269 my $id = $node->id;
537 30260 100 100     75541 return unless( defined $id && length($id ) );
538             # single quotes must become double quotes
539             # $id =~ s/'/''/g;
540 19964 100       30568 if( $id =~ /[\(\);:,\s]/ ) {
541 36         43 $id = '"'.$id.'"';
542             }
543 19964         32294 return $id;
544             }
545              
546             1;