[Bioperl-l] getting a subtree

[Devin Scannell]

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.

best,

Devin



=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 
branch.
            As a bonus the removed node is used to root and return a new 
tree.
            This function therefore effectively makes two trees from the 
original.
	  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

=cut

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 
ref($remove_node);

     # some light checking 	

     unless ($remove_node) {
       	$self->warn("Requires Bio::Tree::NodeI object or node id as an 
argument");
	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

	$self->remove_Node($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 {
	$retain_node->ancestor(undef);
	$self->set_root_node($retain_node);
     }

     # make new tree from removed branch and return

     $remove_node->ancestor(undef);
     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,
TCD,
Ireland
00353-1-6081288		
-----------------