[Bioperl-guts-l] [14800] bioperl-live/trunk: the new method Bio::Tree::Tree::subtree_length( $internal_node) is identical to total_branch_length when no Bio::Tree:: NodeI object is given as an argument
Heikki Lehvaslaiho
heikki at dev.open-bio.org
Thu Aug 14 04:14:58 EDT 2008
Revision: 14800
Author: heikki
Date: 2008-08-14 04:14:57 -0400 (Thu, 14 Aug 2008)
Log Message:
-----------
the new method Bio::Tree::Tree::subtree_length($internal_node) is identical to total_branch_length when no Bio::Tree::NodeI object is given as an argument
Modified Paths:
--------------
bioperl-live/trunk/Bio/Tree/Tree.pm
bioperl-live/trunk/t/Tree.t
Modified: bioperl-live/trunk/Bio/Tree/Tree.pm
===================================================================
--- bioperl-live/trunk/Bio/Tree/Tree.pm 2008-08-14 02:21:13 UTC (rev 14799)
+++ bioperl-live/trunk/Bio/Tree/Tree.pm 2008-08-14 08:14:57 UTC (rev 14800)
@@ -152,8 +152,8 @@
Title : get_nodes
Usage : my @nodes = $tree->get_nodes()
- Function: Return list of Tree::NodeI objects
- Returns : array of Tree::NodeI objects
+ Function: Return list of Bio::Tree::NodeI objects
+ Returns : array of Bio::Tree::NodeI objects
Args : (named values) hash with one value
order => 'b|breadth' first order or 'd|depth' first order
@@ -227,22 +227,37 @@
Title : total_branch_length
Usage : my $size = $tree->total_branch_length
Function: Returns the sum of the length of all branches
- Returns : integer
+ Returns : real
Args : none
=cut
-sub total_branch_length {
- my ($self) = @_;
- my $sum = 0;
- if( defined $self->get_root_node ) {
- for ( $self->get_root_node->get_all_Descendents('none') ) {
- $sum += $_->branch_length || 0;
- }
- }
- return $sum;
+sub total_branch_length { shift->subtree_length }
+
+=head2 subtree_length
+
+ Title : subtree_length
+ Usage : my $subtree_size = $tree->subtree_length($internal_node)
+ Function: Returns the sum of the length of all branches in a subtree
+ under the node. Calculates the size of the whole tree
+ without an argument (but only if root node is defined)
+ Returns : real or undef
+ Args : Bio::Tree::NodeI object, defaults to the root node
+
+=cut
+
+sub subtree_length {
+ my $tree = shift;
+ my $node = shift || $tree->get_root_node;
+ return unless $node;
+ my $sum = 0;
+ for ( $node->get_all_Descendents ) {
+ $sum += $_->branch_length || 0;
+ }
+ return $sum;
}
+
=head2 id
Title : id
Modified: bioperl-live/trunk/t/Tree.t
===================================================================
--- bioperl-live/trunk/t/Tree.t 2008-08-14 02:21:13 UTC (rev 14799)
+++ bioperl-live/trunk/t/Tree.t 2008-08-14 08:14:57 UTC (rev 14800)
@@ -7,7 +7,7 @@
use lib 't/lib';
use BioperlTest;
- test_begin(-tests => 42);
+ test_begin(-tests => 44);
use_ok('Bio::TreeIO');
}
@@ -114,6 +114,10 @@
# removing node_count checks because re-rooting can change the
# number of internal nodes (if it is done correctly)
my $total_length_orig = $tree->total_branch_length;
+is $tree->total_branch_length, $tree->subtree_length,
+ "subtree_length() without attributes is an alias to total_branch_lenght()";
+cmp_ok($total_length_orig, '>',$tree->subtree_length($a->ancestor),
+ 'Length of the tree is larger that lenght of a subtree');
$out->write_tree($tree) if $verbose;
is($tree->reroot($a),1, 'Can re-root with A as outgroup');
$out->write_tree($tree) if $verbose;
More information about the Bioperl-guts-l
mailing list