← Back to branch summary

~ubuntu-branches/ubuntu/raring/bioperl/raring

« back to all changes in this revision

Viewing changes to Bio/Tree/NodeI.pm

  • Committer: Bazaar Package Importer
  • Author(s): Charles Plessy
  • Date: 2008-03-18 14:44:57 UTC
  • mfrom: (4 hardy)
  • mto: This revision was merged to the branch mainline in revision 6.
  • Revision ID: james.westby@ubuntu.com-20080318144457-1jjoztrvqwf0gruk
http://bugs.debian.org/448890
* debian/control:
  - Removed MIA Matt Hope (dopey) from the Uploaders field.
    Thank you for your work, Matt. I hope you are doing well.
  - Downgraded some recommended package to the 'Suggests' priority,
    according to the following discussion on Upstream's mail list.
    http://bioperl.org/pipermail/bioperl-l/2008-March/027379.html
    (Closes: #448890)
* debian/copyright converted to machine-readable format.

Show diffs side-by-side

added added

removed removed

Lines of Context:
Bio/Tree/NodeI.pm
1
 
# $Id: NodeI.pm,v 1.26 2003/09/25 16:07:44 jason Exp $
 
1
# $Id: NodeI.pm,v 1.35.4.1 2006/10/02 23:10:37 sendu Exp $
2
2
#
3
3
# BioPerl module for Bio::Tree::NodeI
4
4
#
79
79
Bioperl modules. Send your comments and suggestions preferably to
80
80
the Bioperl mailing list.  Your participation is much appreciated.
81
81
 
82
 
  bioperl-l@bioperl.org              - General discussion
83
 
  http://bioperl.org/MailList.shtml  - About the mailing lists
 
82
  bioperl-l@bioperl.org                  - General discussion
 
83
  http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
84
84
 
85
85
=head2 Reporting Bugs
86
86
 
88
88
of the bugs and their resolution. Bug reports can be submitted via
89
89
the web:
90
90
 
91
 
  http://bugzilla.bioperl.org/
 
91
  http://bugzilla.open-bio.org/
92
92
 
93
93
=head1 AUTHOR - Jason Stajich
94
94
 
108
108
# Let the code begin...
109
109
 
110
110
package Bio::Tree::NodeI;
111
 
use vars qw(@ISA);
112
111
use strict;
113
 
use Bio::Root::RootI;
114
 
@ISA = qw(Bio::Root::RootI);
 
112
no warnings 'recursion';
115
113
 
 
114
use base qw(Bio::Root::RootI);
116
115
 
117
116
=head2 add_Descendent
118
117
 
159
158
 Function: Recursively fetch all the nodes and their descendents
160
159
           *NOTE* This is different from each_Descendent
161
160
 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.
 
161
 Args    : $sortby [optional] "height", "creation", "alpha", "revalpha", 
 
162
           or a coderef to be used to sort the order of children nodes.
164
163
 
165
164
=cut
166
165
 
167
166
sub get_all_Descendents{
168
167
   my ($self, $sortby) = @_;
169
 
   $sortby ||= 'height';
 
168
   $sortby ||= 'none';   
170
169
   my @nodes;
171
170
   foreach my $node ( $self->each_Descendent($sortby) ) {
172
 
       push @nodes, ($node->get_all_Descendents($sortby), $node);
 
171
       push @nodes, ($node,$node->get_all_Descendents($sortby));
173
172
   }
174
173
   return @nodes;
175
174
}
226
225
 
227
226
sub to_string{
228
227
   my ($self) = @_;
229
 
   return join('',defined $self->id ? $self->id : '',
 
228
   return join('',defined $self->id_output ? $self->id_output : '',
230
229
                  defined $self->branch_length ? ':' . $self->branch_length 
231
230
                  : ' ')
232
231
}
236
235
 Title   : height
237
236
 Usage   : my $len = $node->height
238
237
 Function: Returns the height of the tree starting at this
239
 
           node.  Height is the maximum branchlength.
 
238
           node.  Height is the maximum branchlength to get to the tip.
240
239
 Returns : The longest length (weighting branches with branch_length) to a leaf
241
240
 Args    : none
242
241
 
243
242
=cut
244
243
 
245
244
sub height{
 
245
    my ($self) = @_;
 
246
 
 
247
    return 0 if( $self->is_Leaf );
 
248
    
 
249
    my $max = 0;
 
250
    foreach my $subnode ( $self->each_Descendent ) { 
 
251
        my $s = $subnode->height + $subnode->branch_length;;
 
252
        if( $s > $max ) { $max = $s; }
 
253
    }
 
254
    return $max;
 
255
}
 
256
 
 
257
=head2 depth
 
258
 
 
259
 Title   : depth
 
260
 Usage   : my $len = $node->depth
 
261
 Function: Returns the depth of the tree starting at this
 
262
           node.  Depth is the distance from this node to the root.
 
263
 Returns : The branch length to the root.
 
264
 Args    : none
 
265
 
 
266
=cut
 
267
 
 
268
sub depth{
246
269
   my ($self) = @_;
247
270
   
248
 
   if( $self->is_Leaf ) { 
249
 
       if( !defined $self->branch_length ) { 
250
 
           $self->debug(sprintf("Trying to calculate height of a node when a Node (%s) has an undefined branch_length\n",$self->id || '?' ));
251
 
           return 0;
252
 
       }
253
 
       return $self->branch_length;
254
 
   }
255
 
   my $max = 0;
256
 
   foreach my $subnode ( $self->each_Descendent ) { 
257
 
       my $s = $subnode->height;
258
 
       if( $s > $max ) { $max = $s; }
259
 
   }
260
 
   return $max + ($self->branch_length || 1);
 
271
   my $depth = 0;
 
272
   my $node = $self;
 
273
   while( defined $node->ancestor ) { 
 
274
       $depth += $node->branch_length;
 
275
       $node = $node->ancestor;
 
276
   }
 
277
   return $depth;
261
278
}
262
279
 
263
280
=head2 Get/Set methods
468
485
    shift->throw_not_implemented();
469
486
}
470
487
 
 
488
 
 
489
=head2 Helper Functions
 
490
 
 
491
=cut
 
492
 
 
493
=head2 id_output
 
494
 
 
495
 Title   : id_output
 
496
 Usage   : my $id = $node->id_output;
 
497
 Function: Return an id suitable for output in format like newick
 
498
           so that if it contains spaces or ():; characters it is properly 
 
499
           quoted
 
500
 Returns : $id string if $node->id has a value
 
501
 Args    : none
 
502
 
 
503
 
 
504
=cut
 
505
 
 
506
sub id_output{
 
507
    my $node = shift;
 
508
    my $id = $node->id;
 
509
    return unless( defined $id && length($id ) );
 
510
    # single quotes must become double quotes
 
511
    # $id =~ s/'/''/g;
 
512
    if( $id =~ /[\(\);:,\s]/ ) {
 
513
        $id = '"'.$id.'"';
 
514
    }
 
515
    return $id;
 
516
}
 
517
 
471
518
1;