lib/Bio/Tree/NodeI.pm

   1 #
   2 # BioPerl module for Bio::Tree::NodeI
   3 #
   4 # Please direct questions and support issues to <bioperl-l@bioperl.org>
   5 #
   6 # Cared for by Jason Stajich <jason@bioperl.org>
   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 attaching 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<bioperl-l@bioperl.org>
  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
 124 use strict;
 125 no warnings 'recursion';
 126
 127 use base qw(Bio::Root::RootI);
 128
 129 =head2 add_Descendent
 130
 131  Title   : add_Descendent
 132  Usage   : $node->add_Descendent($node);
 133  Function: Adds a descendent to a node
 134  Returns : number of current descendents for this node
 135  Args    : Bio::Node::NodeI
 136
 137
 138 =cut
 139
 140 sub add_Descendent{
 141    my ($self,@args) = @_;
 142
 143    $self->throw_not_implemented();
 144 }
 145
 146
 147 =head2 each_Descendent
 148
 149  Title   : each_Descendent
 150  Usage   : my @nodes = $node->each_Descendent;
 151  Function: all the descendents for this Node (but not their descendents
 152                                               i.e. not a recursive fetchall)
 153  Returns : Array of Bio::Tree::NodeI objects
 154  Args    : none
 155
 156 =cut
 157
 158 sub each_Descendent{
 159    my ($self) = @_;
 160    $self->throw_not_implemented();
 161 }
 162
 163 =head2 Decorated Interface methods
 164
 165 =cut
 166
 167 =head2 get_all_Descendents
 168
 169  Title   : get_all_Descendents($sortby)
 170  Usage   : my @nodes = $node->get_all_Descendents;
 171  Function: Recursively fetch all the nodes and their descendents
 172            *NOTE* This is different from each_Descendent
 173  Returns : Array or Bio::Tree::NodeI objects
 174  Args    : $sortby [optional] "height", "creation", "alpha", "revalpha",
 175            or a coderef to be used to sort the order of children nodes.
 176
 177 =cut
 178
 179 sub get_all_Descendents{
 180    my ($self, $sortby) = @_;
 181    $sortby ||= 'none';
 182    my @nodes;
 183    foreach my $node ( $self->each_Descendent($sortby) ) {
 184        push @nodes, ($node,$node->get_all_Descendents($sortby));
 185    }
 186    return @nodes;
 187 }
 188
 189 *get_Descendents = \&get_all_Descendents;
 190
 191 =head2 is_Leaf
 192
 193  Title   : is_Leaf
 194  Usage   : if( $node->is_Leaf )
 195  Function: Get Leaf status
 196  Returns : boolean
 197  Args    : none
 198
 199 =cut
 200
 201 sub is_Leaf{
 202     my ($self) = @_;
 203     $self->throw_not_implemented();
 204 }
 205
 206 =head2 descendent_count
 207
 208  Title   : descendent_count
 209  Usage   : my $count = $node->descendent_count;
 210  Function: Counts the number of descendents a node has
 211            (and all of their subnodes)
 212  Returns : integer
 213  Args    : none
 214
 215 =cut
 216
 217 sub descendent_count{
 218    my ($self) = @_;
 219    my $count = 0;
 220
 221    foreach my $node ( $self->each_Descendent ) {
 222        $count += 1;
 223        $node->can('descendent_count') ? $count += $node->descendent_count : next;
 224    }
 225    return $count;
 226 }
 227
 228 =head2 to_string
 229
 230  Title   : to_string
 231  Usage   : my $str = $node->to_string()
 232  Function: For debugging, provide a node as a string
 233  Returns : string
 234  Args    : none
 235
 236
 237 =cut
 238
 239 sub to_string{
 240    my ($self) = @_;
 241    return join('',defined $self->id_output ? $self->id_output : '',
 242                   defined $self->branch_length ? ':' . $self->branch_length
 243                   : ' ')
 244 }
 245
 246 =head2 height
 247
 248  Title   : height
 249  Usage   : my $len = $node->height
 250  Function: Returns the height of the tree starting at this
 251            node.  Height is the maximum branchlength to get to the tip.
 252  Returns : The longest length (weighting branches with branch_length) to a leaf
 253  Args    : none
 254
 255 =cut
 256
 257 sub height{
 258     my ($self) = @_;
 259
 260     return 0 if( $self->is_Leaf );
 261
 262     my $max = 0;
 263     foreach my $subnode ( $self->each_Descendent ) {
 264         my $s = $subnode->height + $subnode->branch_length;;
 265         if( $s > $max ) { $max = $s; }
 266     }
 267     return $max;
 268 }
 269
 270 =head2 depth
 271
 272  Title   : depth
 273  Usage   : my $len = $node->depth
 274  Function: Returns the depth of the tree starting at this
 275            node.  Depth is the distance from this node to the root.
 276  Returns : The branch length to the root.
 277  Args    : none
 278
 279 =cut
 280
 281 sub depth{
 282    my ($self) = @_;
 283
 284    my $depth = 0;
 285    my $node = $self;
 286    while( defined $node->ancestor ) {
 287        $depth += $node->branch_length;
 288        $node = $node->ancestor;
 289    }
 290    return $depth;
 291 }
 292
 293 =head2 Get/Set methods
 294
 295 =cut
 296
 297 =head2 branch_length
 298
 299  Title   : branch_length
 300  Usage   : $obj->branch_length()
 301  Function: Get/Set the branch length
 302  Returns : value of branch_length
 303  Args    : newvalue (optional)
 304
 305
 306 =cut
 307
 308 sub branch_length{
 309     my ($self)= @_;
 310     $self->throw_not_implemented();
 311 }
 312
 313 =head2 id
 314
 315  Title   : id
 316  Usage   : $obj->id($newval)
 317  Function: The human readable identifier for the node
 318  Returns : value of human readable id
 319  Args    : newvalue (optional)
 320
 321
 322 =cut
 323
 324 sub id{
 325     my ($self)= @_;
 326     $self->throw_not_implemented();
 327 }
 328
 329 =head2 internal_id
 330
 331  Title   : internal_id
 332  Usage   : my $internalid = $node->internal_id
 333  Function: Returns the internal unique id for this Node
 334  Returns : unique id
 335  Args    : none
 336
 337 =cut
 338
 339 sub internal_id{
 340    my ($self) = @_;
 341    $self->throw_not_implemented();
 342 }
 343
 344 =head2 description
 345
 346  Title   : description
 347  Usage   : $obj->description($newval)
 348  Function: Get/Set the description string
 349  Returns : value of description
 350  Args    : newvalue (optional)
 351
 352
 353 =cut
 354
 355 sub description{
 356     my ($self) = @_;
 357     $self->throw_not_implemented();
 358 }
 359
 360 =head2 bootstrap
 361
 362  Title   : bootstrap
 363  Usage   : $obj->bootstrap($newval)
 364  Function: Get/Set the bootstrap value
 365  Returns : value of bootstrap
 366  Args    : newvalue (optional)
 367
 368
 369 =cut
 370
 371 sub bootstrap{
 372     my ($self) = @_;
 373     $self->throw_not_implemented();
 374 }
 375
 376 =head2 ancestor
 377
 378  Title   : ancestor
 379  Usage   : my $node = $node->ancestor;
 380  Function: Get/Set the ancestor node pointer for a Node
 381  Returns : Null if this is top level node
 382  Args    : none
 383
 384 =cut
 385
 386
 387 sub ancestor{
 388    my ($self,@args) = @_;
 389     $self->throw_not_implemented();
 390 }
 391
 392 =head2 invalidate_height
 393
 394  Title   : invalidate_height
 395  Usage   : private helper method
 396  Function: Invalidate our cached value of the node height in the tree
 397  Returns : nothing
 398  Args    : none
 399
 400 =cut
 401
 402 sub invalidate_height {
 403     shift->throw_not_implemented();
 404 }
 405
 406 =head2 Methods for associating Tag/Values with a Node
 407
 408 These methods associate tag/value pairs with a Node
 409
 410 =head2 set_tag_value
 411
 412  Title   : set_tag_value
 413  Usage   : $node->set_tag_value($tag,$value)
 414            $node->set_tag_value($tag,@values)
 415  Function: Sets a tag value(s) to a node. Replaces old values.
 416  Returns : number of values stored for this tag
 417  Args    : $tag   - tag name
 418            $value - value to store for the tag
 419
 420 =cut
 421
 422 sub set_tag_value{
 423     shift->throw_not_implemented();
 424 }
 425
 426 =head2 add_tag_value
 427
 428  Title   : add_tag_value
 429  Usage   : $node->add_tag_value($tag,$value)
 430  Function: Adds a tag value to a node
 431  Returns : number of values stored for this tag
 432  Args    : $tag   - tag name
 433            $value - value to store for the tag
 434
 435
 436 =cut
 437
 438 sub add_tag_value{
 439     shift->throw_not_implemented();
 440 }
 441
 442 =head2 remove_tag
 443
 444  Title   : remove_tag
 445  Usage   : $node->remove_tag($tag)
 446  Function: Remove the tag and all values for this tag
 447  Returns : boolean representing success (0 if tag does not exist)
 448  Args    : $tag - tagname to remove
 449
 450
 451 =cut
 452
 453 sub remove_tag {
 454     shift->throw_not_implemented();
 455 }
 456
 457 =head2 remove_all_tags
 458
 459  Title   : remove_all_tags
 460  Usage   : $node->remove_all_tags()
 461  Function: Removes all tags
 462  Returns : None
 463  Args    : None
 464
 465
 466 =cut
 467
 468 sub remove_all_tags{
 469     shift->throw_not_implemented();
 470 }
 471
 472 =head2 get_all_tags
 473
 474  Title   : get_all_tags
 475  Usage   : my @tags = $node->get_all_tags()
 476  Function: Gets all the tag names for this Node
 477  Returns : Array of tagnames
 478  Args    : None
 479
 480
 481 =cut
 482
 483 sub get_all_tags {
 484     shift->throw_not_implemented();
 485 }
 486
 487 =head2 get_tag_values
 488
 489  Title   : get_tag_values
 490  Usage   : my @values = $node->get_tag_values($tag)
 491  Function: Gets the values for given tag ($tag)
 492  Returns : Array of values or empty list if tag does not exist
 493  Args    : $tag - tag name
 494
 495
 496 =cut
 497
 498 sub get_tag_values{
 499     shift->throw_not_implemented();
 500 }
 501
 502 =head2 has_tag
 503
 504  Title   : has_tag
 505  Usage   : $node->has_tag($tag)
 506  Function: Boolean test if tag exists in the Node
 507  Returns : Boolean
 508  Args    : $tag - tagname
 509
 510
 511 =cut
 512
 513 sub has_tag{
 514     shift->throw_not_implemented();
 515 }
 516
 517
 518 =head2 Helper Functions
 519
 520 =cut
 521
 522 =head2 id_output
 523
 524  Title   : id_output
 525  Usage   : my $id = $node->id_output;
 526  Function: Return an id suitable for output in format like newick
 527            so that if it contains spaces or ():; characters it is properly
 528            quoted
 529  Returns : $id string if $node->id has a value
 530  Args    : none
 531
 532
 533 =cut
 534
 535 sub id_output{
 536     my $node = shift;
 537     my $id = $node->id;
 538     return unless( defined $id && length($id ) );
 539     # single quotes must become double quotes
 540     # $id =~ s/'/''/g;
 541     if( $id =~ /[\(\);:,\s]/ ) {
 542         $id = '"'.$id.'"';
 543     }
 544     return $id;
 545 }
 546
 547 1;