Bio::Tree Node
SummaryIncluded librariesPackage variablesSynopsisDescriptionGeneral documentationMethods
Toolbar
WebCvsRaw content
Summary
Bio::Tree::Node - A Simple Tree Node
Package variables
No package variables defined.
Included modules
Bio::Root::Root
Bio::Tree::NodeI
Inherit
Bio::Root::Root Bio::Tree::NodeI
Synopsis
    use Bio::Tree::Node;
    my $nodeA = new Bio::Tree::Node();
    my $nodeL = new Bio::Tree::Node();
    my $nodeR = new Bio::Tree::Node();

    my $node = new Bio::Tree::Node();
    $node->add_Descendent($nodeL);
    $node->add_Descendent($nodeR);

    print "node is not a leaf \n" if( $node->is_leaf);
Description
Makes a Tree Node suitable for building a Tree.
Methods
BEGIN Code
_creation_idDescriptionCode
add_DescendentDescriptionCode
add_tag_valueDescriptionCode
ancestorDescriptionCode
bootstrapDescriptionCode
branch_lengthDescriptionCode
descriptionDescriptionCode
each_DescendentDescriptionCode
get_all_tagsDescriptionCode
get_tag_valuesDescriptionCode
has_tagDescriptionCode
heightDescriptionCode
idDescriptionCode
internal_idDescriptionCode
invalidate_heightDescriptionCode
is_LeafDescriptionCode
newDescriptionCode
node_cleanup
No description
Code
remove_DescendentDescriptionCode
remove_all_DescendentsDescriptionCode
remove_all_tagsDescriptionCode
remove_tagDescriptionCode
Methods description
_creation_idcode    nextTop
 Title   : _creation_id
 Usage   : $obj->_creation_id($newval)
 Function: a private method signifying the internal creation order
 Returns : value of _creation_id
 Args    : newvalue (optional)
add_DescendentcodeprevnextTop
 Title   : add_Descendent
 Usage   : $node->add_Descendant($node);
 Function: Adds a descendent to a node
 Returns : number of current descendents for this node
 Args    : Bio::Node::NodeI
           boolean flag, true if you want to ignore the fact that you are
           adding a second node with the same unique id (typically memory 
           location reference in this implementation).  default is false and 
           will throw an error if you try and overwrite an existing node.
add_tag_valuecodeprevnextTop
 Title   : add_tag_value
 Usage   : $node->add_tag_value($tag,$value)
 Function: Adds a tag value to a node 
 Returns : number of values stored for this tag
 Args    : $tag   - tag name
           $value - value to store for the tag
ancestorcodeprevnextTop
 Title   : ancestor
 Usage   : $obj->ancestor($newval)
 Function: Set the Ancestor
 Returns : value of ancestor
 Args    : newvalue (optional)
bootstrapcodeprevnextTop
 Title   : bootstrap
 Usage   : $obj->bootstrap($newval)
 Function: Get/Set the bootstrap value
 Returns : value of bootstrap
 Args    : newvalue (optional)
branch_lengthcodeprevnextTop
 Title   : branch_length
 Usage   : $obj->branch_length()
 Function: Get/Set the branch length
 Returns : value of branch_length
 Args    : newvalue (optional)
descriptioncodeprevnextTop
 Title   : description
 Usage   : $obj->description($newval)
 Function: Get/Set the description string
 Returns : value of description
 Args    : newvalue (optional)
each_DescendentcodeprevnextTop
 Title   : each_Descendent($sortby)
 Usage   : my @nodes = $node->each_Descendent;
 Function: all the descendents for this Node (but not their descendents
					      i.e. not a recursive fetchall)
 Returns : Array of Bio::Tree::NodeI objects
 Args    : $sortby [optional] "height", "creation" or coderef to be used
           to sort the order of children nodes.
get_all_tagscodeprevnextTop
 Title   : get_all_tags
 Usage   : my @tags = $node->get_all_tags()
 Function: Gets all the tag names for this Node
 Returns : Array of tagnames
 Args    : None
get_tag_valuescodeprevnextTop
 Title   : get_tag_values
 Usage   : my @values = $node->get_tag_value($tag)
 Function: Gets the values for given tag ($tag)
 Returns : Array of values or empty list if tag does not exist
 Args    : $tag - tag name
has_tagcodeprevnextTop
 Title   : has_tag
 Usage   : $node->has_tag($tag)
 Function: Boolean test if tag exists in the Node
 Returns : Boolean
 Args    : $tag - tagname
heightcodeprevnextTop
 Title   : height
 Usage   : my $len = $node->height
 Function: Returns the height of the tree starting at this
           node.  Height is the maximum branchlength.
 Returns : The longest length (weighting branches with branch_length) to a leaf
 Args    : none
idcodeprevnextTop
 Title   : id
 Usage   : $obj->id($newval)
 Function: The human readable identifier for the node 
 Returns : value of human readable id
 Args    : newvalue (optional)
 Note    : id cannot contain the chracters '();:'
"A name can be any string of printable characters except blanks,
colons, semicolons, parentheses, and square brackets. Because you may
want to include a blank in a name, it is assumed that an underscore
character ("_") stands for a blank; any of these in a name will be
converted to a blank when it is read in."
from http://evolution.genetics.washington.edu/phylip/newicktree.html
internal_idcodeprevnextTop
 Title   : internal_id
 Usage   : my $internalid = $node->internal_id
 Function: Returns the internal unique id for this Node
           (a monotonically increasing number for this in-memory implementation
            but could be a database determined unique id in other 
	    implementations)
 Returns : unique id
 Args    : none
invalidate_heightcodeprevnextTop
 Title   : invalidate_height
 Usage   : private helper method
 Function: Invalidate our cached value of the node's height in the tree
 Returns : nothing
 Args    : none
is_LeafcodeprevnextTop
 Title   : is_Leaf
 Usage   : if( $node->is_Leaf )
 Function: Get Leaf status
 Returns : boolean
 Args    : none
newcodeprevnextTop
 Title   : new
 Usage   : my $obj = new Bio::Tree::Node();
 Function: Builds a new Bio::Tree::Node object
 Returns : Bio::Tree::Node
 Args    : -left          => pointer to Left descendent (optional)
           -right         => pointer to Right descenent (optional)
	   -branch_length => branch length [integer] (optional)
           -bootstrap     => value   bootstrap value (string)
           -description   => description of node
           -id            => human readable id for node
remove_DescendentcodeprevnextTop
 Title   : remove_Descendent
 Usage   : $node->remove_Descedent($node_foo);
 Function: Removes a specific node from being a Descendent of this node
 Returns : nothing
 Args    : An array of Bio::Node::NodeI objects which have be previously
           passed to the add_Descendent call of this object.
remove_all_DescendentscodeprevnextTop
 Title   : remove_all_Descendents
 Usage   : $node->remove_All_Descendents()
 Function: Cleanup the node's reference to descendents and reset
           their ancestor pointers to undef, if you don't have a reference
           to these objects after this call they will be cleaned up - so
           a get_nodes from the Tree object would be a safe thing to do first
 Returns : nothing
 Args    : none
remove_all_tagscodeprevnextTop
 Title   : remove_all_tags
 Usage   : $node->remove_all_tags()
 Function: Removes all tags 
 Returns : None
 Args    : None
remove_tagcodeprevnextTop
 Title   : remove_tag
 Usage   : $node->remove_tag($tag)
 Function: Remove the tag and all values for this tag
 Returns : boolean representing success (0 if tag does not exist)
 Args    : $tag - tagname to remove
Methods code
BEGINTop
BEGIN {
     $CREATIONORDER = 0;
}
_creation_iddescriptionprevnextTop
sub _creation_id {
    my $self = shift @_;
    $self->{'_creation_id'} = shift @_ if( @_);
    return $self->{'_creation_id'} || 0;
}
add_DescendentdescriptionprevnextTop
sub add_Descendent {
   my ($self,$node,$ignoreoverwrite) = @_;
   return -1 if( ! defined $node ) ;
   if( ! $node->isa('Bio::Tree::NodeI') ) {
       $self->warn("Trying to add a Descendent who is not a Bio::Tree::NodeI");
       return -1;
   }
   # do we care about order?
   $node->ancestor($self);
   if( $self->{'_desc'}->{$node->internal_id} && ! $ignoreoverwrite ) {
       $self->throw("Going to overwrite a node which is $node that is already stored here, set the ignore overwrite flag (parameter 2) to true to ignore this in the future");
   }
   
   $self->{'_desc'}->{$node->internal_id} = $node; # is this safely unique - we've tested before at any rate??
   
   $self->invalidate_height();
   
   return scalar keys %{$self->{'_desc'}};
}
add_tag_valuedescriptionprevnextTop
sub add_tag_value {
    my ($self,$tag,$value) = @_;
    if( ! defined $tag || ! defined $value ) {
	$self->warn("cannot call add_tag_value with an undefined value");
    }
    push @{$self->{'_tags'}->{$tag}}, $value;
    return scalar @{$self->{'_tags'}->{$tag}};
}
ancestordescriptionprevnextTop
sub ancestor {
   my $self = shift;
   $self->{'_ancestor'} = shift @_ if @_;
   return $self->{'_ancestor'};
}
bootstrapdescriptionprevnextTop
sub bootstrap {
     my $self = shift;
    if( @_ ) {
	if( $self->has_tag('B') ) {
	    $self->remove_tag('B');
	}
	$self->add_tag_value('B',shift);
    }
    return ($self->get_tag_values('B'))[0];
}
branch_lengthdescriptionprevnextTop
sub branch_length {
    my $self = shift;
    if( @_ ) {
	my $bl = shift;
	if( defined $bl &&
	    $bl =~ s/\[(\d+)\]// ) {
	    $self->bootstrap($1);
	}
	$self->{'_branch_length'} = $bl;
    }
    return $self->{'_branch_length'};
}
descriptiondescriptionprevnextTop
sub description {
    my $self = shift;
    $self->{'_description'} = shift @_ if @_;
    return $self->{'_description'};
}
each_DescendentdescriptionprevnextTop
sub each_Descendent {
   my ($self, $sortby) = @_;

   # order can be based on branch length (and sub branchlength)

   $sortby ||= 'height';

   if (ref $sortby eq 'CODE') {
       return sort $sortby values %{$self->{'_desc'}};
   } else  {
       if ($sortby eq 'height') {
	   return map { $_->[0] }
		  sort { $a->[1] <=> $b->[1] || 
			 $a->[2] <=> $b->[2] } 
	       map { [$_, $_->height, $_->internal_id ] } 
	   values %{$self->{'_desc'}};
       } else {
	   return map { $_->[0] }
	          sort { $a->[1] <=> $b->[1] } 
	          map { [$_, $_->height ] }
	          values %{$self->{'_desc'}};	   
       }
   }
}
get_all_tagsdescriptionprevnextTop
sub get_all_tags {
   my ($self) = @_;
   return sort keys %{$self->{'_tags'} || {}};
}
get_tag_valuesdescriptionprevnextTop
sub get_tag_values {
   my ($self,$tag) = @_;
   return @{$self->{'_tags'}->{$tag} || []};
}
has_tagdescriptionprevnextTop
sub has_tag {
   my ($self,$tag) = @_;
   return exists $self->{'_tags'}->{$tag};
}
heightdescriptionprevnextTop
sub height {
     my ($self) = @_;

    return $self->{'_height'} if( defined $self->{'_height'} );
    
    if( $self->is_Leaf ) { 
       if( !defined $self->branch_length ) { 
	   $self->debug(sprintf("Trying to calculate height of a node when a Node (%s) has an undefined branch_length\n",$self->id || '?' ));
	   return 0;
       }
       return $self->branch_length;
   }
   my $max = 0;
   foreach my $subnode ( $self->each_Descendent ) { 
       my $s = $subnode->height;
       if( $s > $max ) { $max = $s; }
   }
   return ($self->{'_height'} = $max + ($self->branch_length || 1));
}
iddescriptionprevnextTop
sub id {
    my ($self, $value) = @_;
    if ($value) {
        $self->warn("Illegal characters ();:  and space in the id [$value], converting to _ ")
            if $value =~ /\(\);:/ and $self->verbose >= 0;
        $value =~ s/[\(\);:\s]/_/g;
        $self->{'_id'} = $value;
    }
    return $self->{'_id'};
}
internal_iddescriptionprevnextTop
sub internal_id {
   return $_[0]->_creation_id;
}
invalidate_heightdescriptionprevnextTop
sub invalidate_height {
     my ($self) = @_;
    
    $self->{'_height'} = undef;
    if( $self->ancestor ) {
	$self->ancestor->invalidate_height;
    }
}
is_LeafdescriptionprevnextTop
sub is_Leaf {
    my ($self) = @_;
    my $isleaf = ! (defined $self->{'_desc'} &&
		 (keys %{$self->{'_desc'}} > 0) );
    return $isleaf;
}
newdescriptionprevnextTop
sub new {
  my($class,@args) = @_;

  my $self = $class->SUPER::new(@args);
  my ($children, $branchlen,$id,
      $bootstrap, $desc,$d) = $self->_rearrange([qw(DESCENDENTS
						 BRANCH_LENGTH
						 ID
						 BOOTSTRAP
						 DESC
						 DESCRIPTION
						 )],
					     @args);
  $self->_register_for_cleanup(\&node_cleanup);
  $self->{'_desc'} = {}; # for descendents
  if( $d && $desc ) { 
      $self->warn("can only accept -desc or -description, not both, accepting -description");
      $desc = $d;
  } elsif( defined $d && ! defined $desc ) {
      $desc = $d;
  }
  defined $desc && $self->description($desc);
  defined $bootstrap && $self->bootstrap($bootstrap);
  defined $id && $self->id($id);
  defined $branchlen && $self->branch_length($branchlen);

  if( defined $children ) {
      if( ref($children) !~ /ARRAY/i ) {
	  $self->warn("Must specify a valid ARRAY reference to initialize a Node's Descendents");
      }
      foreach my $c ( @$children ) { 	
	  $self->add_Descendent($c);
      }
  }
  $self->_creation_id($CREATIONORDER++);
  return $self;
}
node_cleanupdescriptionprevnextTop
sub node_cleanup {
    my $self = shift;
    if( defined $self->{'_desc'} &&
	ref($self->{'_desc'}) =~ /ARRAY/i ) {
	while( my ($nodeid,$node) = each %{ $self->{'_desc'} } ) {
	    $node->ancestor(undef); # insure no circular references
	    $node = undef;
	}
    }
    $self->{'_desc'} = {};
}

1;
}
remove_DescendentdescriptionprevnextTop
sub remove_Descendent {
   my ($self,@nodes) = @_;
   my $c= 0;
   foreach my $n ( @nodes ) { 
       if( $self->{'_desc'}->{$n->internal_id} ) {
	   $n->ancestor(undef);
	   # should be redundant
	   $self->{'_desc'}->{$n->internal_id}->ancestor(undef);
	   delete $self->{'_desc'}->{$n->internal_id};
	   my $a1 = $self->ancestor;
	   # remove unecessary nodes if we have removed the part 
	   # which branches.
	   # if( $a1 ) {
	   #    my $bl = $self->branch_length || 0;
	   #    my @d = $self->each_Descendent;
	   #    if (scalar @d == 1) {
	   #	   $d[0]->branch_length($bl + ($d[0]->branch_length || 0));
	   #	   $a1->add_Descendent($d[0]);
	   #    }
	   #    $a1->remove_Descendent($self);
	   #}
	   $c++;
       } else { 
	   if( $self->verbose ) {
	       $self->debug(sprintf("no node %s (%s) listed as a descendent in this node %s (%s)\n",$n->id, $n,$self->id,$self));
	       $self->debug("Descendents are " . join(',', keys %{$self->{'_desc'}})."\n");
	   }
       }
   }
   $c;
}
remove_all_DescendentsdescriptionprevnextTop
sub remove_all_Descendents {
   my ($self) = @_;
   # this won't cleanup the nodes themselves if you also have
   # a copy/pointer of them (I think)...
   while( my ($node,$val) = each %{ $self->{'_desc'} } ) {
       $val->ancestor(undef);
   }
   $self->{'_desc'} = {};
   1;
}
remove_all_tagsdescriptionprevnextTop
sub remove_all_tags {
   my ($self) = @_;
   $self->{'_tags'} = {};
   return;
}
remove_tagdescriptionprevnextTop
sub remove_tag {
   my ($self,$tag) = @_;
   if( exists $self->{'_tags'}->{$tag} ) {
       $self->{'_tags'}->{$tag} = undef;
       delete $self->{'_tags'}->{$tag};
       return 1;
   }
   return 0;
}
General documentation
FEEDBACKTop
Mailing ListsTop
User feedback is an integral part of the evolution of this and other
Bioperl modules. Send your comments and suggestions preferably to
the Bioperl mailing list. Your participation is much appreciated.
  bioperl-l@bioperl.org              - General discussion
  http://bioperl.org/MailList.shtml  - About the mailing lists
Reporting BugsTop
Report bugs to the Bioperl bug tracking system to help us keep track
of the bugs and their resolution. Bug reports can be submitted via
the web:
  http://bugzilla.bioperl.org/
AUTHOR - Jason StajichTop
Email jason@bioperl.org
CONTRIBUTORSTop
Aaron Mackey amackey@virginia.edu
APPENDIXTop
The rest of the documentation details each of the object methods.
Internal methods are usually preceded with a _
get_all_DescendentsTop
 Title   : get_all_Descendents
 Usage   : my @nodes = $node->get_all_Descendents;
 Function: Recursively fetch all the nodes and their descendents
           *NOTE* This is different from each_Descendent
 Returns : Array or Bio::Tree::NodeI objects
 Args    : none
Bio::Node::NodeI decorated interface implementedTop
The following methods are implemented by Bio::Node::NodeI decorated
interface.
to_stringTop
 Title   : to_string
 Usage   : my $str = $node->to_string()
 Function: For debugging, provide a node as a string
 Returns : string
 Args    : none