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 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<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 use strict;
 124 no warnings 'recursion';
 125
 126 use base qw(Bio::Root::RootI);
 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    my ($self,@args) = @_;
 141
 142    $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    my ($self) = @_;
 159    $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    my ($self, $sortby) = @_;
 180    $sortby ||= 'none';
 181    my @nodes;
 182    foreach my $node ( $self->each_Descendent($sortby) ) {
 183        push @nodes, ($node,$node->get_all_Descendents($sortby));
 184    }
 185    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     my ($self) = @_;
 202     $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    my ($self) = @_;
 218    my $count = 0;
 219
 220    foreach my $node ( $self->each_Descendent ) {
 221        $count += 1;
 222        $node->can('descendent_count') ? $count += $node->descendent_count : next;
 223    }
 224    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    my ($self) = @_;
 240    return join('',defined $self->id_output ? $self->id_output : '',
 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     my ($self) = @_;
 258
 259     return 0 if( $self->is_Leaf );
 260
 261     my $max = 0;
 262     foreach my $subnode ( $self->each_Descendent ) {
 263         my $s = $subnode->height + $subnode->branch_length;;
 264         if( $s > $max ) { $max = $s; }
 265     }
 266     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    my ($self) = @_;
 282
 283    my $depth = 0;
 284    my $node = $self;
 285    while( defined $node->ancestor ) {
 286        $depth += $node->branch_length;
 287        $node = $node->ancestor;
 288    }
 289    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     my ($self)= @_;
 309     $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     my ($self)= @_;
 325     $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    my ($self) = @_;
 340    $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     my ($self) = @_;
 356     $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     my ($self) = @_;
 372     $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    my ($self,@args) = @_;
 388     $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     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     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     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     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     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     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     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     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     my $node = shift;
 536     my $id = $node->id;
 537     return unless( defined $id && length($id ) );
 538     # single quotes must become double quotes
 539     # $id =~ s/'/''/g;
 540     if( $id =~ /[\(\);:,\s]/ ) {
 541         $id = '"'.$id.'"';
 542     }
 543     return $id;
 544 }
 545
 546 1;