|
0
|
1 # $Id: NodeI.pm,v 1.19.2.2 2003/09/14 19:00:35 jason Exp $
|
|
|
2 #
|
|
|
3 # BioPerl module for Bio::Tree::NodeI
|
|
|
4 #
|
|
|
5 # Cared for by Jason Stajich <jason@bioperl.org>
|
|
|
6 #
|
|
|
7 # Copyright Jason Stajich
|
|
|
8 #
|
|
|
9 # You may distribute this module under the same terms as perl itself
|
|
|
10
|
|
|
11 # POD documentation - main docs before the code
|
|
|
12
|
|
|
13 =head1 NAME
|
|
|
14
|
|
|
15 Bio::Tree::NodeI - Interface describing a Tree Node
|
|
|
16
|
|
|
17 =head1 SYNOPSIS
|
|
|
18
|
|
|
19 # get a Tree::NodeI somehow
|
|
|
20 # like from a TreeIO
|
|
|
21 use Bio::TreeIO;
|
|
|
22 # read in a clustalw NJ in phylip/newick format
|
|
|
23 my $treeio = new Bio::TreeIO(-format => 'newick', -file => 'file.dnd');
|
|
|
24
|
|
|
25 my $tree = $treeio->next_tree; # we'll assume it worked for demo purposes
|
|
|
26 # you might want to test that it was defined
|
|
|
27
|
|
|
28 my $rootnode = $tree->get_root_node;
|
|
|
29
|
|
|
30 # process just the next generation
|
|
|
31 foreach my $node ( $rootnode->each_Descendent() ) {
|
|
|
32 print "branch len is ", $node->branch_length, "\n";
|
|
|
33 }
|
|
|
34
|
|
|
35 # process all the children
|
|
|
36 my $example_leaf_node;
|
|
|
37 foreach my $node ( $rootnode->get_all_Descendents() ) {
|
|
|
38 if( $node->is_Leaf ) {
|
|
|
39 print "node is a leaf ... ";
|
|
|
40 # for example use below
|
|
|
41 $example_leaf_node = $node unless defined $example_leaf_node;
|
|
|
42 }
|
|
|
43 print "branch len is ", $node->branch_length, "\n";
|
|
|
44 }
|
|
|
45
|
|
|
46 # The ancestor() method points to the parent of a node
|
|
|
47 # A node can only have one parent
|
|
|
48
|
|
|
49 my $parent = $example_leaf_node->ancestor;
|
|
|
50
|
|
|
51 # parent won't likely have an description because it is an internal node
|
|
|
52 # but child will because it is a leaf
|
|
|
53
|
|
|
54 print "Parent id: ", $parent->id," child id: ",
|
|
|
55 $example_leaf_node->id, "\n";
|
|
|
56
|
|
|
57
|
|
|
58 =head1 DESCRIPTION
|
|
|
59
|
|
|
60 A NodeI is capable of the basic structure of building a tree and
|
|
|
61 storing the branch length between nodes. The branch length is the
|
|
|
62 length of the branch between the node and its ancestor, thus a root
|
|
|
63 node in a Tree will not typically have a valid branch length.
|
|
|
64
|
|
|
65 Various implementations of NodeI may extend the basic functions and
|
|
|
66 allow storing of other information (like attatching a species object
|
|
|
67 or full sequences used to build a tree or alternative sequences). If
|
|
|
68 you don't know how to extend a Bioperl object please ask, happy to
|
|
|
69 help, we would also greatly appreciate contributions with improvements
|
|
|
70 or extensions of the objects back to the Bioperl code base so that
|
|
|
71 others don't have to reinvent your ideas.
|
|
|
72
|
|
|
73
|
|
|
74 =head1 FEEDBACK
|
|
|
75
|
|
|
76 =head2 Mailing Lists
|
|
|
77
|
|
|
78 User feedback is an integral part of the evolution of this and other
|
|
|
79 Bioperl modules. Send your comments and suggestions preferably to
|
|
|
80 the Bioperl mailing list. Your participation is much appreciated.
|
|
|
81
|
|
|
82 bioperl-l@bioperl.org - General discussion
|
|
|
83 http://bioperl.org/MailList.shtml - About the mailing lists
|
|
|
84
|
|
|
85 =head2 Reporting Bugs
|
|
|
86
|
|
|
87 Report bugs to the Bioperl bug tracking system to help us keep track
|
|
|
88 of the bugs and their resolution. Bug reports can be submitted via
|
|
|
89 the web:
|
|
|
90
|
|
|
91 http://bugzilla.bioperl.org/
|
|
|
92
|
|
|
93 =head1 AUTHOR - Jason Stajich
|
|
|
94
|
|
|
95 Email jason@bioperl.org
|
|
|
96
|
|
|
97 =head1 CONTRIBUTORS
|
|
|
98
|
|
|
99 Aaron Mackey amackey@virginia.edu
|
|
|
100
|
|
|
101 =head1 APPENDIX
|
|
|
102
|
|
|
103 The rest of the documentation details each of the object methods.
|
|
|
104 Internal methods are usually preceded with a _
|
|
|
105
|
|
|
106 =cut
|
|
|
107
|
|
|
108 # Let the code begin...
|
|
|
109
|
|
|
110 package Bio::Tree::NodeI;
|
|
|
111 use vars qw(@ISA);
|
|
|
112 use strict;
|
|
|
113 use Bio::Root::RootI;
|
|
|
114 @ISA = qw(Bio::Root::RootI);
|
|
|
115
|
|
|
116
|
|
|
117 =head2 add_Descendent
|
|
|
118
|
|
|
119 Title : add_Descendent
|
|
|
120 Usage : $node->add_Descendant($node);
|
|
|
121 Function: Adds a descendent to a node
|
|
|
122 Returns : number of current descendents for this node
|
|
|
123 Args : Bio::Node::NodeI
|
|
|
124
|
|
|
125
|
|
|
126 =cut
|
|
|
127
|
|
|
128 sub add_Descendent{
|
|
|
129 my ($self,@args) = @_;
|
|
|
130
|
|
|
131 $self->throw_not_implemented();
|
|
|
132 }
|
|
|
133
|
|
|
134
|
|
|
135 =head2 each_Descendent
|
|
|
136
|
|
|
137 Title : each_Descendent
|
|
|
138 Usage : my @nodes = $node->each_Descendent;
|
|
|
139 Function: all the descendents for this Node (but not their descendents
|
|
|
140 i.e. not a recursive fetchall)
|
|
|
141 Returns : Array of Bio::Tree::NodeI objects
|
|
|
142 Args : none
|
|
|
143
|
|
|
144 =cut
|
|
|
145
|
|
|
146 sub each_Descendent{
|
|
|
147 my ($self) = @_;
|
|
|
148 $self->throw_not_implemented();
|
|
|
149 }
|
|
|
150
|
|
|
151 =head2 Decorated Interface methods
|
|
|
152
|
|
|
153 =cut
|
|
|
154
|
|
|
155 =head2 get_all_Descendents
|
|
|
156
|
|
|
157 Title : get_all_Descendents($sortby)
|
|
|
158 Usage : my @nodes = $node->get_all_Descendents;
|
|
|
159 Function: Recursively fetch all the nodes and their descendents
|
|
|
160 *NOTE* This is different from each_Descendent
|
|
|
161 Returns : Array or Bio::Tree::NodeI objects
|
|
|
162 Args : $sortby [optional] "height", "creation" or coderef to be used
|
|
|
163 to sort the order of children nodes.
|
|
|
164
|
|
|
165 =cut
|
|
|
166
|
|
|
167 sub get_all_Descendents{
|
|
|
168 my ($self, $sortby) = @_;
|
|
|
169 $sortby ||= 'height';
|
|
|
170 my @nodes;
|
|
|
171 foreach my $node ( $self->each_Descendent($sortby) ) {
|
|
|
172 push @nodes, ($node->get_all_Descendents($sortby), $node);
|
|
|
173 }
|
|
|
174 return @nodes;
|
|
|
175 }
|
|
|
176
|
|
|
177 *get_Descendents = \&get_all_Descendents;
|
|
|
178
|
|
|
179 =head2 is_Leaf
|
|
|
180
|
|
|
181 Title : is_Leaf
|
|
|
182 Usage : if( $node->is_Leaf )
|
|
|
183 Function: Get Leaf status
|
|
|
184 Returns : boolean
|
|
|
185 Args : none
|
|
|
186
|
|
|
187 =cut
|
|
|
188
|
|
|
189 sub is_Leaf{
|
|
|
190 my ($self) = @_;
|
|
|
191 $self->throw_not_implemented();
|
|
|
192 }
|
|
|
193
|
|
|
194 =head2 descendent_count
|
|
|
195
|
|
|
196 Title : descendent_count
|
|
|
197 Usage : my $count = $node->descendent_count;
|
|
|
198 Function: Counts the number of descendents a node has
|
|
|
199 (and all of their subnodes)
|
|
|
200 Returns : integer
|
|
|
201 Args : none
|
|
|
202
|
|
|
203 =cut
|
|
|
204
|
|
|
205 sub descendent_count{
|
|
|
206 my ($self) = @_;
|
|
|
207 my $count = 0;
|
|
|
208
|
|
|
209 foreach my $node ( $self->each_Descendent ) {
|
|
|
210 $count += 1;
|
|
|
211 $node->can('descendent_count') ? $count += $node->descendent_count : next;
|
|
|
212 }
|
|
|
213 return $count;
|
|
|
214 }
|
|
|
215
|
|
|
216 =head2 to_string
|
|
|
217
|
|
|
218 Title : to_string
|
|
|
219 Usage : my $str = $node->to_string()
|
|
|
220 Function: For debugging, provide a node as a string
|
|
|
221 Returns : string
|
|
|
222 Args : none
|
|
|
223
|
|
|
224
|
|
|
225 =cut
|
|
|
226
|
|
|
227 sub to_string{
|
|
|
228 my ($self) = @_;
|
|
|
229 return sprintf("%s%s%s",
|
|
|
230 defined $self->id ? $self->id : '',
|
|
|
231 defined $self->branch_length ? ':' . $self->branch_length : ' ',
|
|
|
232 $self->is_Leaf() ? '(leaf)' : ''
|
|
|
233 );
|
|
|
234 }
|
|
|
235
|
|
|
236 =head2 height
|
|
|
237
|
|
|
238 Title : height
|
|
|
239 Usage : my $len = $node->height
|
|
|
240 Function: Returns the height of the tree starting at this
|
|
|
241 node. Height is the maximum branchlength.
|
|
|
242 Returns : The longest length (weighting branches with branch_length) to a leaf
|
|
|
243 Args : none
|
|
|
244
|
|
|
245 =cut
|
|
|
246
|
|
|
247 sub height{
|
|
|
248 my ($self) = @_;
|
|
|
249
|
|
|
250 if( $self->is_Leaf ) {
|
|
|
251 if( !defined $self->branch_length ) {
|
|
|
252 $self->debug(sprintf("Trying to calculate height of a node when a Node (%s) has an undefined branch_length\n",$self->id || '?' ));
|
|
|
253 return 0;
|
|
|
254 }
|
|
|
255 return $self->branch_length;
|
|
|
256 }
|
|
|
257 my $max = 0;
|
|
|
258 foreach my $subnode ( $self->each_Descendent ) {
|
|
|
259 my $s = $subnode->height;
|
|
|
260 if( $s > $max ) { $max = $s; }
|
|
|
261 }
|
|
|
262 return $max + ($self->branch_length || 1);
|
|
|
263 }
|
|
|
264
|
|
|
265 =head2 Get/Set methods
|
|
|
266
|
|
|
267 =cut
|
|
|
268
|
|
|
269 =head2 branch_length
|
|
|
270
|
|
|
271 Title : branch_length
|
|
|
272 Usage : $obj->branch_length()
|
|
|
273 Function: Get/Set the branch length
|
|
|
274 Returns : value of branch_length
|
|
|
275 Args : newvalue (optional)
|
|
|
276
|
|
|
277
|
|
|
278 =cut
|
|
|
279
|
|
|
280 sub branch_length{
|
|
|
281 my ($self)= @_;
|
|
|
282 $self->throw_not_implemented();
|
|
|
283 }
|
|
|
284
|
|
|
285 =head2 id
|
|
|
286
|
|
|
287 Title : id
|
|
|
288 Usage : $obj->id($newval)
|
|
|
289 Function: The human readable identifier for the node
|
|
|
290 Returns : value of human readable id
|
|
|
291 Args : newvalue (optional)
|
|
|
292
|
|
|
293
|
|
|
294 =cut
|
|
|
295
|
|
|
296 sub id{
|
|
|
297 my ($self)= @_;
|
|
|
298 $self->throw_not_implemented();
|
|
|
299 }
|
|
|
300
|
|
|
301 =head2 internal_id
|
|
|
302
|
|
|
303 Title : internal_id
|
|
|
304 Usage : my $internalid = $node->internal_id
|
|
|
305 Function: Returns the internal unique id for this Node
|
|
|
306 Returns : unique id
|
|
|
307 Args : none
|
|
|
308
|
|
|
309 =cut
|
|
|
310
|
|
|
311 sub internal_id{
|
|
|
312 my ($self) = @_;
|
|
|
313 $self->throw_not_implemented();
|
|
|
314 }
|
|
|
315
|
|
|
316 =head2 description
|
|
|
317
|
|
|
318 Title : description
|
|
|
319 Usage : $obj->description($newval)
|
|
|
320 Function: Get/Set the description string
|
|
|
321 Returns : value of description
|
|
|
322 Args : newvalue (optional)
|
|
|
323
|
|
|
324
|
|
|
325 =cut
|
|
|
326
|
|
|
327 sub description{
|
|
|
328 my ($self) = @_;
|
|
|
329 $self->throw_not_implemented();
|
|
|
330 }
|
|
|
331
|
|
|
332 =head2 bootstrap
|
|
|
333
|
|
|
334 Title : bootstrap
|
|
|
335 Usage : $obj->bootstrap($newval)
|
|
|
336 Function: Get/Set the bootstrap value
|
|
|
337 Returns : value of bootstrap
|
|
|
338 Args : newvalue (optional)
|
|
|
339
|
|
|
340
|
|
|
341 =cut
|
|
|
342
|
|
|
343 sub bootstrap{
|
|
|
344 my ($self) = @_;
|
|
|
345 $self->throw_not_implemented();
|
|
|
346 }
|
|
|
347
|
|
|
348 =head2 ancestor
|
|
|
349
|
|
|
350 Title : ancestor
|
|
|
351 Usage : my $node = $node->ancestor;
|
|
|
352 Function: Get/Set the ancestor node pointer for a Node
|
|
|
353 Returns : Null if this is top level node
|
|
|
354 Args : none
|
|
|
355
|
|
|
356 =cut
|
|
|
357
|
|
|
358
|
|
|
359 sub ancestor{
|
|
|
360 my ($self,@args) = @_;
|
|
|
361 $self->throw_not_implemented();
|
|
|
362 }
|
|
|
363
|
|
|
364 =head2 invalidate_height
|
|
|
365
|
|
|
366 Title : invalidate_height
|
|
|
367 Usage : private helper method
|
|
|
368 Function: Invalidate our cached value of the node height in the tree
|
|
|
369 Returns : nothing
|
|
|
370 Args : none
|
|
|
371
|
|
|
372 =cut
|
|
|
373
|
|
|
374 sub invalidate_height {
|
|
|
375 shift->throw_not_implemented();
|
|
|
376 }
|
|
|
377
|
|
|
378 =head2 Methods for associating Tag/Values with a Node
|
|
|
379
|
|
|
380 These methods associate tag/value pairs with a Node
|
|
|
381
|
|
|
382 =head2 add_tag_value
|
|
|
383
|
|
|
384 Title : add_tag_value
|
|
|
385 Usage : $node->add_tag_value($tag,$value)
|
|
|
386 Function: Adds a tag value to a node
|
|
|
387 Returns : number of values stored for this tag
|
|
|
388 Args : $tag - tag name
|
|
|
389 $value - value to store for the tag
|
|
|
390
|
|
|
391
|
|
|
392 =cut
|
|
|
393
|
|
|
394 sub add_tag_value{
|
|
|
395 shift->throw_not_implemented();
|
|
|
396 }
|
|
|
397
|
|
|
398 =head2 remove_tag
|
|
|
399
|
|
|
400 Title : remove_tag
|
|
|
401 Usage : $node->remove_tag($tag)
|
|
|
402 Function: Remove the tag and all values for this tag
|
|
|
403 Returns : boolean representing success (0 if tag does not exist)
|
|
|
404 Args : $tag - tagname to remove
|
|
|
405
|
|
|
406
|
|
|
407 =cut
|
|
|
408
|
|
|
409 sub remove_tag {
|
|
|
410 shift->throw_not_implemented();
|
|
|
411 }
|
|
|
412
|
|
|
413 =head2 remove_all_tags
|
|
|
414
|
|
|
415 Title : remove_all_tags
|
|
|
416 Usage : $node->remove_all_tags()
|
|
|
417 Function: Removes all tags
|
|
|
418 Returns : None
|
|
|
419 Args : None
|
|
|
420
|
|
|
421
|
|
|
422 =cut
|
|
|
423
|
|
|
424 sub remove_all_tags{
|
|
|
425 shift->throw_not_implemented();
|
|
|
426 }
|
|
|
427
|
|
|
428 =head2 get_all_tags
|
|
|
429
|
|
|
430 Title : get_all_tags
|
|
|
431 Usage : my @tags = $node->get_all_tags()
|
|
|
432 Function: Gets all the tag names for this Node
|
|
|
433 Returns : Array of tagnames
|
|
|
434 Args : None
|
|
|
435
|
|
|
436
|
|
|
437 =cut
|
|
|
438
|
|
|
439 sub get_all_tags {
|
|
|
440 shift->throw_not_implemented();
|
|
|
441 }
|
|
|
442
|
|
|
443 =head2 get_tag_values
|
|
|
444
|
|
|
445 Title : get_tag_values
|
|
|
446 Usage : my @values = $node->get_tag_value($tag)
|
|
|
447 Function: Gets the values for given tag ($tag)
|
|
|
448 Returns : Array of values or empty list if tag does not exist
|
|
|
449 Args : $tag - tag name
|
|
|
450
|
|
|
451
|
|
|
452 =cut
|
|
|
453
|
|
|
454 sub get_tag_values{
|
|
|
455 shift->throw_not_implemented();
|
|
|
456 }
|
|
|
457
|
|
|
458 =head2 has_tag
|
|
|
459
|
|
|
460 Title : has_tag
|
|
|
461 Usage : $node->has_tag($tag)
|
|
|
462 Function: Boolean test if tag exists in the Node
|
|
|
463 Returns : Boolean
|
|
|
464 Args : $tag - tagname
|
|
|
465
|
|
|
466
|
|
|
467 =cut
|
|
|
468
|
|
|
469 sub has_tag{
|
|
|
470 shift->throw_not_implemented();
|
|
|
471 }
|
|
|
472
|
|
|
473 1;
|
