[Bioperl-guts-l] bioperl-live/Bio/DB Taxonomy.pm,1.15,1.16

Senduran Balasubramaniam sendu at dev.open-bio.org
Wed Feb 14 12:32:15 EST 2007


Update of /home/repository/bioperl/bioperl-live/Bio/DB
In directory dev.open-bio.org:/tmp/cvs-serv21079/Bio/DB

Modified Files:
	Taxonomy.pm 
Log Message:
added get_tree method

Index: Taxonomy.pm
===================================================================
RCS file: /home/repository/bioperl/bioperl-live/Bio/DB/Taxonomy.pm,v
retrieving revision 1.15
retrieving revision 1.16
diff -C2 -d -r1.15 -r1.16
*** Taxonomy.pm	26 Sep 2006 22:03:06 -0000	1.15
--- Taxonomy.pm	14 Feb 2007 17:32:12 -0000	1.16
***************
*** 147,150 ****
--- 147,190 ----
  *get_taxaid = \&get_taxonids;
  
+ =head2 get_tree
+ 
+  Title   : get_tree
+  Usage   : my $tree = $db->get_tree(@species_names)
+  Function: Generate a tree comprised of the full lineages of all the supplied
+            species names. The nodes for the requested species are given
+            name('supplied') values corresponding to the supplied name, such that
+            they can be identified if the real species name in the database
+            (stored under node_name()) is different.
+  Returns : Bio::Tree::Tree
+  Args    : a list of species names (strings)
+ 
+ =cut
+ 
+ sub get_tree {
+     my ($self, @species_names) = @_;
+     
+     # the full lineages of the species are merged into a single tree
+     my $tree;
+     foreach my $name (@species_names) {
+         my $ncbi_id = $self->get_taxonid($name);
+         if ($ncbi_id) {
+             my $node = $self->get_taxon(-taxonid => $ncbi_id);
+             $node->name('supplied', $name);
+             
+             if ($tree) {
+                 $tree->merge_lineage($node);
+             }
+             else {
+                 $tree = new Bio::Tree::Tree(-verbose => $self->verbose, -node => $node);
+             }
+         }
+         else {
+             $self->throw("No taxonomy database node for species ".$name);
+         }
+     }
+     
+     return $tree;
+ }
+ 
  =head2 ancestor
  



More information about the Bioperl-guts-l mailing list