[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