[Bioperl-l] getting a subtree

Devin Scannell scannedr at tcd.ie
Sat Mar 6 15:55:21 EST 2004

Hi Jason and Deng,

I suspect Jasons solution was the required one but I have been getting 
a lot of use out of the method below which does something similar - 
return a  branch as a new tree object but also remove it from the 
original tree. I have been using it to split trees into well supported 
clades according to certain criteria.

if its useful and the caveats (1. only works for bifurcating nodes and 
2. does not correct branch lengths (it was written for use with phylip 
trees)) are not too problematic, I would be happy to have it added to 
the Tree::FunctionsI module. Failing this, if I get an interested 
reply, I'll correct these problems when less busy and resubmit.



=head2 remove_branch

  Title   : remove_branch
  Usage   : $tree->remove_branch($first_node_on_branch_to_be_removed)
  Function: At a bifurcating node removes one descendant branch
            and replaces the ancestral branch with the other descendant 
            As a bonus the removed node is used to root and return a new 
            This function therefore effectively makes two trees from the 
	  This method DOES NOT work at trifurcating nodes
            and DOES NOT correct branch lengths.
  Returns : New tree object corresponding to removed branch.
  Args    : Bio::Tree::NodeI object or node id
  Added   : Devin Scannell Wed Feb 11 22:09:28 GMT 2004


sub remove_branch {

     # if b is a bifurcating node
     # where a->b is the ancestral branch
     # and b->c, b->d are descendent branches
     # then	
     # 1) destroy central_node (b)
     # 2) make retain_node (c) a descendent of attach_node (a)
     # 3) return remove_node (d) as a new tree object

     my $self = shift;
     my $remove_node = shift;
     $remove_node = $self->find_node($remove_node) unless 

     # some light checking 	

     unless ($remove_node) {
       	$self->warn("Requires Bio::Tree::NodeI object or node id as an 
	return undef;
     unless (scalar($remove_node->ancestor->each_Descendent) == 2 ) {
	$self->warn("Tree not bifurcating");
	return undef;

     # get attach_node && central_node

     my $central_node = $remove_node->ancestor;
     my $attach_node = $central_node->ancestor;

     # get retain_node

	my $retain_node = '';
     foreach ($remove_node->ancestor->each_Descendent) {
	$retain_node = $_;
	last if $retain_node ne $remove_node;

    # destroy central_node


     # if no attach_node, tree is bisected
     # ie remove_node and retain_node are immediate descendants of the 
root node
     # therefore just reroot current tree at retain_node

     if ($attach_node) {
	$attach_node->add_Descendent($retain_node, 1);
     } else {

     # make new tree from removed branch and return

     return(Bio::Tree::Tree->new(-root => $remove_node));

On Thursday, Mar 4, 2004, at 21:15 Europe/Dublin, Jason Stajich wrote:

> Deng - here is some code to answer your question.
> use Bio::Tree::Tree;
> use Bio::TreeIO;
> # get a tree somehow
> # choose the subnodes for finding the lca somehow
> # get the least common ancestor
> my $node = $tree->get_lca( -nodes => \@nodes );
> # build a new tree with its root at $node
> my $subtree = Bio::Tree::Tree->new(-root => $node, -nodelete => 1);
> my $out = Bio::TreeIO->new(-format=>'newick');
> $out->write_tree($subtree);
> -jason
> --
> Jason Stajich
> Duke University
> jason at cgt.mc.duke.edu
> _______________________________________________
> Bioperl-l mailing list
> Bioperl-l at portal.open-bio.org
> http://portal.open-bio.org/mailman/listinfo/bioperl-l
Devin Scannell,
Wolfe Lab,

More information about the Bioperl-l mailing list