Bio::Taxonomy Taxon
SummaryIncluded librariesPackage variablesSynopsisDescriptionGeneral documentationMethods
Toolbar
WebCvs
Summary
Bio::Taxonomy::Taxon - Generic Taxonomic Entity object
Package variables
No package variables defined.
Included modules
Bio::Species
Inherit
Bio::Root::Root Bio::Tree::NodeI
Synopsis
    # NB: This module is deprecated. Use Bio::Taxon instead.
use Bio::Taxonomy::Taxon; my $taxonA = Bio::Taxonomy::Taxon->new(); my $taxonL = Bio::Taxonomy::Taxon->new(); my $taxonR = Bio::Taxonomy::Taxon->new(); my $taxon = Bio::Taxonomy::Taxon->new(); $taxon->add_Descendents($taxonL); $taxon->add_Descendents($taxonR); my $species = $taxon->species;
Description
Makes a taxonomic unit suitable for use in a taxonomic tree
Methods
BEGIN Code
newDescriptionCode
add_DescendentDescriptionCode
each_DescendentDescriptionCode
remove_DescendentDescriptionCode
remove_all_DescendentsDescriptionCode
ancestorDescriptionCode
branch_lengthDescriptionCode
descriptionDescriptionCode
rankDescriptionCode
taxonDescriptionCode
idDescriptionCode
DESTROY
No description
Code
internal_idDescriptionCode
_creation_idDescriptionCode
is_LeafDescriptionCode
heightDescriptionCode
invalidate_heightDescriptionCode
classifyDescriptionCode
has_rankDescriptionCode
has_taxonDescriptionCode
distance_to_rootDescriptionCode
recent_common_ancestorDescriptionCode
speciesDescriptionCode
Methods description
newcode    nextTop
 Title   : new
Usage : my $obj = Bio::Taxonomy::Taxon->new();
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)
add_DescendentcodeprevnextTop
 Title   : add_Descendent
Usage : $taxon->add_Descendent($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.
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.
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
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)
descriptioncodeprevnextTop
 Title   : description
Usage : $obj->description($newval)
Function:
Returns : value of description
Args : newvalue (optional)
rankcodeprevnextTop
 Title   : rank
Usage : $obj->rank($newval)
Function: Set the taxonomic rank
Returns : taxonomic rank of taxon
Args : newvalue (optional)
taxoncodeprevnextTop
 Title   : taxon
Usage : $obj->taxon($newtaxon)
Function: Set the name of the taxon
Example :
Returns : name of taxon
Args : newtaxon (optional)
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
_creation_idcodeprevnextTop
 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)
is_LeafcodeprevnextTop
 Title   : is_Leaf
Usage : if( $node->is_Leaf )
Function: Get Leaf status
Returns : boolean
Args : none
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
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
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
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
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 :
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
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
Methods code
BEGINTop
BEGIN {
     $CREATIONORDER = 0;
}
newdescriptionprevnextTop
sub new {
  my($class,@args) = @_;

  my $self = $class->SUPER::new(@args);
  $self->warn("Bio::Taxonomy::Taxon is deprecated. Use Bio::Taxon instead.");
  
  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;
}
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'}};
}
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') { my @values = sort $sortby values %{$self->{'_desc'}}; return @values; } 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'}}; } }
}
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;
}
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'};
}
descriptiondescriptionprevnextTop
sub description {
   my ($self,$value) = @_;
   if( defined $value  ) {
       $self->{'_description'} = $value;
   }
   return $self->{'_description'};
}
rankdescriptionprevnextTop
sub rank {
   my ($self,$value) = @_;
   if (defined $value) {
      $self->{'_rank'} = $value;
   }
   return $self->{'_rank'};
}
taxondescriptionprevnextTop
sub taxon {
   my ($self,$value) = @_;
   if( defined $value  ) {
       $self->{'_taxon'} = $value;
   }
   return $self->{'_taxon'};
}
iddescriptionprevnextTop
sub id {
   my ($self,$value) = @_;
   if( defined $value ) {
       $self->{'_id'} = $value;
   }
   return $self->{'_id'};
}
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'} = {}; }
}
internal_iddescriptionprevnextTop
sub internal_id {
   return $_[0]->_creation_id;
}
_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
}
is_LeafdescriptionprevnextTop
sub is_Leaf {
    my ($self) = @_;
    my $rc = 0;
    $rc = 1 if( ! defined $self->{'_desc'} ||	
		keys %{$self->{'_desc'}} == 0);
    return $rc;
}
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));
}
invalidate_heightdescriptionprevnextTop
sub invalidate_height {
     my ($self) = @_;
    
    $self->{'_height'} = undef;
    if( $self->ancestor ) {
	    $self->ancestor->invalidate_height;
    }
}
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);
}
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;
}
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;
}
distance_to_rootdescriptionprevnextTop
sub distance_to_root {
   my ($self,$taxon) = @_;

   my $count=0;

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

   return $count;
}
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;
}
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;
}
General documentation
AUTHORTop
Dan Kortschak email kortschak@rsbs.anu.edu.au
CONTRIBUTORSTop
Sendu Bala: bix@sendu.me.uk
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