Bio::Taxonomy Taxon
SummaryIncluded librariesPackage variablesSynopsisDescriptionGeneral documentationMethods
Toolbar
WebCvsRaw content
Summary
Bio::Taxonomy::Taxon - Generic Taxonomic Entity object
Package variables
No package variables defined.
Included modules
Bio::Root::Root
Bio::Species
Bio::Taxonomy
Bio::Tree::NodeI
Inherit
Bio::Root::Root Bio::Tree::NodeI
Synopsis
    use Bio::Taxonomy::Taxon;
    my $taxonA = new Bio::Taxonomy::Taxon();
    my $taxonL = new Bio::Taxonomy::Taxon();
    my $taxonR = new Bio::Taxonomy::Taxon();

    my $taxon = new Bio::Taxonomy::Taxon();
    $taxon->add_Descendents($nodeL);
    $taxon->add_Descendents($nodeR);

    $species = $taxon->species;
Description
Makes a taxonomic unit suitable for use in a taxonomic tree
Methods
BEGIN Code
DESTROY
No description
Code
_creation_idDescriptionCode
add_DescendentDescriptionCode
ancestorDescriptionCode
branch_lengthDescriptionCode
classifyDescriptionCode
descriptionDescriptionCode
distance_to_rootDescriptionCode
each_DescendentDescriptionCode
has_rankDescriptionCode
has_taxonDescriptionCode
heightDescriptionCode
idDescriptionCode
internal_idDescriptionCode
invalidate_heightDescriptionCode
is_LeafDescriptionCode
newDescriptionCode
rankDescriptionCode
recent_common_ancestorDescriptionCode
remove_DescendentDescriptionCode
remove_all_DescendentsDescriptionCode
speciesDescriptionCode
taxonDescriptionCode
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   : $taxon->add_Descendant($taxon);
 Function: Adds a descendent to a taxon
 Returns : number of current descendents for this taxon
 Args    : Bio::Taxonomy::Taxon
           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.
ancestorcodeprevnextTop
 Title   : ancestor
 Usage   : $taxon->ancestor($newval)
 Function: Set the Ancestor
 Returns : value of ancestor
 Args    : newvalue (optional)
branch_lengthcodeprevnextTop
 Title   : branch_length
 Usage   : $obj->branch_length($newval)
 Function:
 Example :
 Returns : value of branch_length
 Args    : newvalue (optional)
classifycodeprevnextTop
 Title   : classify
 Usage   : @obj->classify()
 Function: a method to return the classification of a species
 Returns : name of taxon and ancestor's taxon recursively
 Args    : boolean to specify whether we want all taxa not just ranked 
levels
descriptioncodeprevnextTop
 Title   : description
 Usage   : $obj->description($newval)
 Function:
 Example :
 Returns : value of description
 Args    : newvalue (optional)
distance_to_rootcodeprevnextTop
 Title   : distance_to_root
 Usage   : $obj->distance_to_root
 Function: a method to query ancestors' taxa
 Returns : number of links to root
 Args    :
each_DescendentcodeprevnextTop
 Title   : each_Descendent($sortby)
 Usage   : my @taxa = $taxon->each_Descendent;
 Function: all the descendents for this taxon (but not their descendents
					      i.e. not a recursive fetchall)
 Returns : Array of Bio::Taxonomy::Taxon objects
 Args    : $sortby [optional] "height", "creation" or coderef to be used
           to sort the order of children taxa.
has_rankcodeprevnextTop
 Title   : has_rank
 Usage   : $obj->has_rank($rank)
 Function: a method to query ancestors' rank
 Returns : boolean
 Args    : $rank
has_taxoncodeprevnextTop
 Title   : has_taxon
 Usage   : $obj->has_taxon($taxon)
 Function: a method to query ancestors' taxa
 Returns : boolean
 Args    : Bio::Taxonomy::Taxon object
heightcodeprevnextTop
 Title   : height
 Usage   : my $len = $taxon->height
 Function: Returns the height of the tree starting at this
           taxon.  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:
 Example :
 Returns : value of id
 Args    : newvalue (optional)
internal_idcodeprevnextTop
 Title   : internal_id
 Usage   : my $internalid = $taxon->internal_id
 Function: Returns the internal unique id for this taxon
           (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 taxon'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::Taxonomy::Taxon();
 Function: Builds a new Bio::Taxonomy::Taxon object
 Returns : Bio::Taxonomy::Taxon
 Args    : -descendents   => array pointer to descendents (optional)
     	   -branch_length => branch length [integer] (optional)
     	   -taxon     => taxon
           -id     => unique taxon id for node (from NCBI's list preferably)
           -rank  => the taxonomic level of the node (also from NCBI)
rankcodeprevnextTop
 Title   : rank
 Usage   : $obj->rank($newval)
 Function: Set the taxonomic rank
 Example :
 Returns : taxonomic rank of taxon
 Args    : newvalue (optional)
recent_common_ancestorcodeprevnextTop
 Title   : recent_common_ancestor
 Usage   : $obj->recent_common_ancestor($taxon)
 Function: a method to query find common ancestors
 Returns : Bio::Taxonomy::Taxon of query or undef if no ancestor of rank
 Args    : Bio::Taxonomy::Taxon
remove_DescendentcodeprevnextTop
 Title   : remove_Descendent
 Usage   : $taxon->remove_Descedent($taxon_foo);
 Function: Removes a specific taxon from being a Descendent of this taxon
 Returns : nothing
 Args    : An array of Bio::taxonomy::Taxon objects which have be previously
           passed to the add_Descendent call of this object.
remove_all_DescendentscodeprevnextTop
 Title   : remove_all_Descendents
 Usage   : $taxon->remove_All_Descendents()
 Function: Cleanup the taxon'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 cleanedup - so
           a get_nodes from the Tree object would be a safe thing to do first
 Returns : nothing
 Args    : none
speciescodeprevnextTop
 Title   : species
 Usage   : $obj=$taxon->species;
 Function: Returns a Bio::Species object reflecting the taxon's tree position
 Returns : a Bio::Species object
 Args    : none
taxoncodeprevnextTop
 Title   : taxon
 Usage   : $obj->taxon($newtaxon)
 Function: Set the name of the taxon
 Example :
 Returns : name of taxon
 Args    : newtaxon (optional)
Methods code
BEGINTop
BEGIN {
     $CREATIONORDER = 0;
}
DESTROYdescriptionprevnextTop
sub DESTROY {
    my ($self) = @_;
    # try to insure that everything is cleaned up
    $self->SUPER::DESTROY();
    if( defined $self->{'_desc'} &&
	ref($self->{'_desc'}) =~ /ARRAY/i ) {
	while( my ($nodeid,$node) = each %{ $self->{'_desc'} } ) {
	    $node->{'_ancestor'} = undef; # ensure no circular references
	    $node->DESTROY();
	    $node = undef;
	}
	$self->{'_desc'} = {};
    }
}
_creation_iddescriptionprevnextTop
sub _creation_id {
    my ($self,$value) = @_;
    if( defined $value) {
	$self->{'_creation_id'} = $value;
    }
    return $self->{'_creation_id'} || 0;
}


# The following methods are implemented by NodeI decorated interface
}
add_DescendentdescriptionprevnextTop
sub add_Descendent {
   my ($self,$node,$ignoreoverwrite) = @_;

   return -1 if( ! defined $node ) ;
   if( ! $node->isa('Bio::Taxonomy::Taxon') ) {
       $self->warn("Trying to add a Descendent who is not a Bio::Taxonomy::Taxon");
       return -1;
   }
   # do we care about order?
   $node->{'_ancestor'} = $self;
   if( $self->{'_desc'}->{$node->internal_id} && ! $ignoreoverwrite ) {
       $self->throw("Going to overwrite a taxon 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'}};
}
ancestordescriptionprevnextTop
sub ancestor {
   my ($self, $value) = @_;
   if (defined $value) {
       $self->{'_ancestor'} = $value;
   }
   return $self->{'_ancestor'};
}
branch_lengthdescriptionprevnextTop
sub branch_length {
    my ($self,$value) = @_;
    if( defined $value) {
	$self->{'branch_length'} = $value;
    }
    return $self->{'branch_length'};
}
classifydescriptionprevnextTop
sub classify {
   my ($self,$allnodes) = @_;

   my @classification=($self->taxon);
   my $node=$self;

   while (defined $node->ancestor) {
      push @classification, $node->ancestor->taxon if $allnodes==1;
      $node=$node->ancestor;
   }

   return (@classification);
}
descriptiondescriptionprevnextTop
sub description {
   my ($self,$value) = @_;
   if( defined $value  ) {
       $self->{'_desc'} = $value;
   }
   return $self->{'_desc'};
}
distance_to_rootdescriptionprevnextTop
sub distance_to_root {
   my ($self,$taxon) = @_;

   my $count=0;

   while (defined $self->ancestor) {
      $count++;
      $self=$self->ancestor;
   }

   return $count;
}
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'}};	   
       }
   }
}
has_rankdescriptionprevnextTop
sub has_rank {
   my ($self,$rank) = @_;

   return $self if $self->rank eq $rank;

   while (defined $self->ancestor) {
      return $self if $self->ancestor->rank eq $rank;
      $self=$self->ancestor;
   }

   return undef;
}
has_taxondescriptionprevnextTop
sub has_taxon {
   my ($self,$taxon) = @_;

   return $self if 
      ((defined $self->id && $self->id == $taxon->id) ||
      ($self->taxon eq $taxon->taxon && $self->rank eq $taxon->rank));

   while (defined $self->ancestor) {
      return $self if 
         ((defined $self->id && $self->id == $taxon->id) ||
         ($self->taxon eq $taxon->taxon && $self->rank eq $taxon->rank) &&
         ($self->taxon ne 'no rank'));
      $self=$self->ancestor;
   }

   return undef;
}
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 taxon when a taxon (%s) has an undefined branch_length",$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( defined $value ) {
       $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 $rc = 0;
    $rc = 1 if( ! defined $self->{'_desc'} ||	
		keys %{$self->{'_desc'}} == 0);
    return $rc;
}
newdescriptionprevnextTop
sub new {
  my($class,@args) = @_;

  my $self = $class->SUPER::new(@args);
  my ($children,$branchlen,$id,$taxon,$rank,$desc) = 

                      $self->_rearrange([qw(DESCENDENTS
                                            BRANCH_LENGTH
                                            ID
                                            TAXON
                                            RANK
                                            DESC)], @args);
  
  $self->{'_desc'} = {};
  defined $desc && $self->description($desc);
  defined $taxon && $self->taxon($taxon);
  defined $id && $self->id($id);
  defined $branchlen && $self->branch_length($branchlen);
  defined $rank && $self->rank($rank);

  if( defined $children ) {
      if( ref($children) !~ /ARRAY/i ) {
	  $self->warn("Must specify a valid ARRAY reference to initialize a Taxon's Descendents");
      }
      foreach my $c ( @$children ) { 	
 	  $self->add_Descendent($c);
      }
  }
  $self->_creation_id($CREATIONORDER++);
  return $self;
}
rankdescriptionprevnextTop
sub rank {
   my ($self,$value) = @_;
   if (defined $value) {
      my $ranks=join("|",@RANK);
      if ($value=~/$ranks/) {
         $self->{'_rank'} = $value;
      } else {
         $self->throw("Attempted to set unknown taxonomic rank: $value.\n");
      }
   }
   return $self->{'_rank'};
}
recent_common_ancestordescriptionprevnextTop
sub recent_common_ancestor {
   my ($self,$node) = @_;

   while (defined $node->ancestor) {
      my $common=$self->has_taxon($node);
      return $common if defined $common;
      $node=$node->ancestor;
   }

   return undef;
}
remove_DescendentdescriptionprevnextTop
sub remove_Descendent {
   my ($self,@nodes) = @_;
   foreach my $n ( @nodes ) { 
       if( $self->{'_desc'}->{$n->internal_id} ) {
	   $n->{'_ancestor'} = undef;
	   $self->{'_desc'}->{$n->internal_id}->{'_ancestor'} = undef;
	   delete $self->{'_desc'}->{$n->internal_id};
	   
       } else { 
	   $self->debug(sprintf("no taxon %s (%s) listed as a descendent in this taxon %s (%s)\n",$n->id, $n,$self->id,$self));
	   $self->debug("Descendents are " . join(',', keys %{$self->{'_desc'}})."\n");
       }
   }
   1;
}
remove_all_DescendentsdescriptionprevnextTop
sub remove_all_Descendents {
   my ($self) = @_;
   # this won't cleanup the taxa 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;
}
speciesdescriptionprevnextTop
sub species {
   my ($self) = @_;
   my $species;

   if ($self->has_rank('subspecies') && $self->ancestor->rank eq 'species') {
      $species = Bio::Species->new(-classification => $self->ancestor->classify);
      $species->genus($self->ancestor->ancestor->taxon);
      $species->species($self->ancestor->taxon);
      $species->sub_species($self->taxon);
   } elsif ($self->has_rank('species')) {
      $species = Bio::Species->new(-classification => $self->classify);
      $species->genus($self->ancestor->taxon);
      $species->species($self->taxon);
   } else {
      $self->throw("Trying to create a species from a taxonomic entity without species rank. Use classify instead of species.\n");
   }
   return $species;
}

1;
}
taxondescriptionprevnextTop
sub taxon {
   my ($self,$value) = @_;
   if( defined $value  ) {
       $self->{'_taxon'} = $value;
   }
   return $self->{'_taxon'};
}
General documentation
CONTACTTop
Dan Kortschak email kortschak@rsbs.anu.edu.au
APPENDIXTop
The rest of the documentation details each of the object
methods. Internal methods are usually preceded with a _
get_DescendentsTop
 Title   : get_Descendents
 Usage   : my @taxa = $taxon->get_Descendents;
 Function: Recursively fetch all the taxa and their descendents
           *NOTE* This is different from each_Descendent
 Returns : Array or Bio::Taxonomy::Taxon objects
 Args    : none
to_stringTop
 Title   : to_string
 Usage   : my $str = $taxon->to_string()
 Function: For debugging, provide a taxon as a string
 Returns : string
 Args    : none