[Bioperl-guts-l] bioperl-live/t genbank.t, 1.9, 1.10 Taxonomy.t, 1.10, 1.11 TaxonTree.t, 1.4, 1.5 Species.t, 1.10, 1.11 SearchIO.t, 1.95, 1.96 Node.t, 1.6, 1.7 Index.t, 1.42, 1.43 BioFetch_DB.t, 1.12, 1.13

Senduran Balasubramaniam sendu at dev.open-bio.org
Sat Aug 12 07:00:05 EDT 2006


Update of /home/repository/bioperl/bioperl-live/t
In directory dev.open-bio.org:/tmp/cvs-serv30335/t

Modified Files:
	genbank.t Taxonomy.t TaxonTree.t Species.t SearchIO.t Node.t 
	Index.t BioFetch_DB.t 
Log Message:
Bio::Taxonomy overhaul, see bug 2061

Index: TaxonTree.t
===================================================================
RCS file: /home/repository/bioperl/bioperl-live/t/TaxonTree.t,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** TaxonTree.t	26 Jul 2006 10:47:33 -0000	1.4
--- TaxonTree.t	12 Aug 2006 11:00:02 -0000	1.5
***************
*** 3,6 ****
--- 3,7 ----
  ##
  
+ # These modules are now deprecated, don't bother testing them.
  
  ## I am pretty sure this module is going the way of the dodo bird so 
***************
*** 20,152 ****
      }
      use Test;
!     plan tests => 41;
  }
  
- use Bio::Taxonomy::Taxon;
  ok(1);
  
! 
! ok my $taxonL = Bio::Taxonomy::Taxon->new;
! ok $taxonL->description('this could be anything');
! ok $taxonL->taxon('could this be called name?');
! ok $taxonL->id('could this be called taxid?');
! skip 1, $taxonL->branch_length('should accept only numerical values?');
! ok  $taxonL->branch_length(5);
! 
! ok $taxonL->id('could this be called taxid?');
! ok $taxonL->rank('species');
! ok $taxonL->rank, 'species';
! # ok $taxonL->has_rank, 'species'; #why two methods that do mostly the same thing, but work differently?
! 
! skip 1, $taxonL->rank('foo is not a rank, class variable @RANK not initialised'); 
! ok $taxonL->to_string, '"could this be called taxid?":5';
! 
! my $taxonR = new Bio::Taxonomy::Taxon;
! 
! my $taxon = new Bio::Taxonomy::Taxon(-id =>'ancient', -taxon => 'genus');
! ok $taxon->id(), 'ancient'; 
! ok $taxon->taxon(), 'genus'; 
! ok $taxon->internal_id, 2;
! ok $taxonL->internal_id, 0; # would not it be better to start numebering from 1?
! ok $taxon->add_Descendent($taxonL);
! $taxon->add_Descendent($taxonR);
! 
! ok  scalar $taxon->each_Descendent, 2;  # dies
! ok $taxon->remove_Descendent($taxonR); # better to return number of Descendants removed
! 
! ok $taxon->remove_all_Descendents();
! 
! 
! $taxon->add_Descendent($taxonL);
! ok $taxonL->ancestor->id, 'ancient';
! ok $taxonL->branch_length(5);
! 
! 
! ok $taxonL->is_Leaf, 1;
! ok $taxon->is_Leaf, 0;
! ok $taxon->height, 6;
! ok $taxonL->height, 5;
! ok $taxon->invalidate_height, undef;
! ok $taxonL->classify(1), 2;
! skip(1,"skip classify weirdness");
! # ok $taxonL->classify(0), 2, 'ancestor has rank, but implementation prevents showing anything more than one value';
! skip(1,"skip classify weirdness");
! #ok $taxonL->has_rank, 1, 'documentation claims this returns a boolean; and that it queries ancestors rank?, needs an agrument but does not test it';
! skip(1,"skip classify weirdness");
! #ok $taxonL->has_rank('species'), 1;
! 
! #ok $taxon->has_taxon(); # why docs and code talk about ancestor?
! #ok $taxonL->has_taxon('genus');  returns undef or oan object, not boolean
! 
! ok $taxon->distance_to_root, 0;
! ok $taxonL->distance_to_root, 1;
! #ok $taxonL->recent_common_ancestor($taxon)->id, 'ancient';
! 
! 
! 
! #use Data::Dumper;
! #print Dumper  $taxonL->classify();
! skip(1, 'Skip this weird function');
! # ok $taxonL->has_rank('species'), 1;
! #ok my $species = $taxonL->species;
! 
! 
! 
! 
! 
! ##################################################################################################
! 
! # tests for Bio::Taxonomy::Tree;
! # code from synopsis
! 
! use Bio::Species;
! use Bio::Taxonomy::Tree;
! use Bio::Taxonomy;
! 
! my $human=new Bio::Species;
! my $chimp=new Bio::Species;
! my $bonobo=new Bio::Species;
! 
! $human->classification(qw( sapiens Homo Hominidae
!                            Catarrhini Primates Eutheria
!                            Mammalia Euteleostomi Vertebrata 
!                            Craniata Chordata
!                            Metazoa Eukaryota ));
! $chimp->classification(qw( troglodytes Pan Hominidae
!                            Catarrhini Primates Eutheria
!                            Mammalia Euteleostomi Vertebrata 
!                            Craniata Chordata
!                            Metazoa Eukaryota ));
! $bonobo->classification(qw( paniscus Pan Hominidae
!                             Catarrhini Primates Eutheria
!                             Mammalia Euteleostomi Vertebrata 
!                             Craniata Chordata
!                             Metazoa Eukaryota ));
! 
! # ranks passed to $taxonomy match ranks of species
! my @ranks = ('superkingdom','kingdom','phylum','subphylum',
!              'no rank 1','no rank 2','class','no rank 3','order',
!              'suborder','family','genus','species');
! 
! my $taxonomy=new Bio::Taxonomy(-ranks => \@ranks,
!                                -method => 'trust',
!                                -order => -1);
! 
! 
! ok my $tree1=new Bio::Taxonomy::Tree;
! my $tree2=new Bio::Taxonomy::Tree;
! 
! $tree1->make_species_branch($human,$taxonomy);
! $tree2->make_species_branch($chimp,$taxonomy);
! 
! my ($homo_sapiens) = $tree1->get_leaves;
! ok ref $homo_sapiens, 'Bio::Taxonomy::Taxon';
! 
! ok $tree1->splice($tree2);
! 
! ok $tree1->add_species($bonobo,$taxonomy);
! 
! 
! ok join (", ", map {$_->taxon} $tree1->get_leaves), 'Homo sapiens, Pan troglodytes, Pan paniscus';
! ok $tree1->remove_branch($homo_sapiens);
! ok join (", ", map {$_->taxon} $tree1->get_leaves), 'Pan troglodytes, Pan paniscus';
--- 21,157 ----
      }
      use Test;
!     plan tests => 1;
  }
  
  ok(1);
  
! if (0) {
! 	use Bio::Taxonomy::Taxon;
! 	ok(1);
! 	
! 	
! 	ok my $taxonL = Bio::Taxonomy::Taxon->new;
! 	ok $taxonL->description('this could be anything');
! 	ok $taxonL->taxon('could this be called name?');
! 	ok $taxonL->id('could this be called taxid?');
! 	skip 1, $taxonL->branch_length('should accept only numerical values?');
! 	ok  $taxonL->branch_length(5);
! 	
! 	ok $taxonL->id('could this be called taxid?');
! 	ok $taxonL->rank('species');
! 	ok $taxonL->rank, 'species';
! 	# ok $taxonL->has_rank, 'species'; #why two methods that do mostly the same thing, but work differently?
! 	
! 	skip 1, $taxonL->rank('foo is not a rank, class variable @RANK not initialised'); 
! 	ok $taxonL->to_string, '"could this be called taxid?":5';
! 	
! 	my $taxonR = new Bio::Taxonomy::Taxon;
! 	
! 	my $taxon = new Bio::Taxonomy::Taxon(-id =>'ancient', -taxon => 'genus');
! 	ok $taxon->id(), 'ancient'; 
! 	ok $taxon->taxon(), 'genus'; 
! 	ok $taxon->internal_id, 2;
! 	ok $taxonL->internal_id, 0; # would not it be better to start numebering from 1?
! 	ok $taxon->add_Descendent($taxonL);
! 	$taxon->add_Descendent($taxonR);
! 	
! 	ok  scalar $taxon->each_Descendent, 2;  # dies
! 	ok $taxon->remove_Descendent($taxonR); # better to return number of Descendants removed
! 	
! 	ok $taxon->remove_all_Descendents();
! 	
! 	
! 	$taxon->add_Descendent($taxonL);
! 	ok $taxonL->ancestor->id, 'ancient';
! 	ok $taxonL->branch_length(5);
! 	
! 	
! 	ok $taxonL->is_Leaf, 1;
! 	ok $taxon->is_Leaf, 0;
! 	ok $taxon->height, 6;
! 	ok $taxonL->height, 5;
! 	ok $taxon->invalidate_height, undef;
! 	ok $taxonL->classify(1), 2;
! 	skip(1,"skip classify weirdness");
! 	# ok $taxonL->classify(0), 2, 'ancestor has rank, but implementation prevents showing anything more than one value';
! 	skip(1,"skip classify weirdness");
! 	#ok $taxonL->has_rank, 1, 'documentation claims this returns a boolean; and that it queries ancestors rank?, needs an agrument but does not test it';
! 	skip(1,"skip classify weirdness");
! 	#ok $taxonL->has_rank('species'), 1;
! 	
! 	#ok $taxon->has_taxon(); # why docs and code talk about ancestor?
! 	#ok $taxonL->has_taxon('genus');  returns undef or oan object, not boolean
! 	
! 	ok $taxon->distance_to_root, 0;
! 	ok $taxonL->distance_to_root, 1;
! 	#ok $taxonL->recent_common_ancestor($taxon)->id, 'ancient';
! 	
! 	
! 	
! 	#use Data::Dumper;
! 	#print Dumper  $taxonL->classify();
! 	skip(1, 'Skip this weird function');
! 	# ok $taxonL->has_rank('species'), 1;
! 	#ok my $species = $taxonL->species;
! 	
! 	
! 	
! 	
! 	
! 	##################################################################################################
! 	
! 	# tests for Bio::Taxonomy::Tree;
! 	# code from synopsis
! 	
! 	use Bio::Species;
! 	use Bio::Taxonomy::Tree;
! 	use Bio::Taxonomy;
! 	
! 	my $human=new Bio::Species;
! 	my $chimp=new Bio::Species;
! 	my $bonobo=new Bio::Species;
! 	
! 	$human->classification(qw( sapiens Homo Hominidae
! 							   Catarrhini Primates Eutheria
! 							   Mammalia Euteleostomi Vertebrata 
! 							   Craniata Chordata
! 							   Metazoa Eukaryota ));
! 	$chimp->classification(qw( troglodytes Pan Hominidae
! 							   Catarrhini Primates Eutheria
! 							   Mammalia Euteleostomi Vertebrata 
! 							   Craniata Chordata
! 							   Metazoa Eukaryota ));
! 	$bonobo->classification(qw( paniscus Pan Hominidae
! 								Catarrhini Primates Eutheria
! 								Mammalia Euteleostomi Vertebrata 
! 								Craniata Chordata
! 								Metazoa Eukaryota ));
! 	
! 	# ranks passed to $taxonomy match ranks of species
! 	my @ranks = ('superkingdom','kingdom','phylum','subphylum',
! 				 'no rank 1','no rank 2','class','no rank 3','order',
! 				 'suborder','family','genus','species');
! 	
! 	my $taxonomy=new Bio::Taxonomy(-ranks => \@ranks,
! 								   -method => 'trust',
! 								   -order => -1);
! 	
! 	
! 	ok my $tree1=new Bio::Taxonomy::Tree;
! 	my $tree2=new Bio::Taxonomy::Tree;
! 	
! 	$tree1->make_species_branch($human,$taxonomy);
! 	$tree2->make_species_branch($chimp,$taxonomy);
! 	
! 	my ($homo_sapiens) = $tree1->get_leaves;
! 	ok ref $homo_sapiens, 'Bio::Taxonomy::Taxon';
! 	
! 	ok $tree1->splice($tree2);
! 	
! 	ok $tree1->add_species($bonobo,$taxonomy);
! 	
! 	
! 	ok join (", ", map {$_->taxon} $tree1->get_leaves), 'Homo sapiens, Pan troglodytes, Pan paniscus';
! 	ok $tree1->remove_branch($homo_sapiens);
! 	ok join (", ", map {$_->taxon} $tree1->get_leaves), 'Pan troglodytes, Pan paniscus';
! }

Index: genbank.t
===================================================================
RCS file: /home/repository/bioperl/bioperl-live/t/genbank.t,v
retrieving revision 1.9
retrieving revision 1.10
diff -C2 -d -r1.9 -r1.10
*** genbank.t	7 Aug 2006 10:47:36 -0000	1.9
--- genbank.t	12 Aug 2006 11:00:02 -0000	1.10
***************
*** 279,283 ****
  my $spec_obj = $seq->species;
  ok ($spec_obj->common_name, 'Mus musculus (house mouse)');
! ok ($spec_obj->species, 'Mus musculus');
  ok ($spec_obj->genus, 'Mus');
  ok ($spec_obj->binomial, 'Mus musculus');
--- 279,283 ----
  my $spec_obj = $seq->species;
  ok ($spec_obj->common_name, 'Mus musculus (house mouse)');
! ok ($spec_obj->species, 'musculus');
  ok ($spec_obj->genus, 'Mus');
  ok ($spec_obj->binomial, 'Mus musculus');
***************
*** 311,315 ****
  $spec_obj = $seq->species;
  ok ($spec_obj->common_name, 'Mus musculus (house mouse)');
! ok ($spec_obj->species, 'Mus musculus');
  ok ($spec_obj->genus, 'Mus');
  ok ($spec_obj->binomial, 'Mus musculus');
--- 311,315 ----
  $spec_obj = $seq->species;
  ok ($spec_obj->common_name, 'Mus musculus (house mouse)');
! ok ($spec_obj->species, 'musculus');
  ok ($spec_obj->genus, 'Mus');
  ok ($spec_obj->binomial, 'Mus musculus');
***************
*** 407,412 ****
  			if ($_ ne $in[$line]) {
  				$ok = 0;
! 				warn "$_ -vs-\n$in[$line]\n";
! 				#last;
  			}
  		}
--- 407,411 ----
  			if ($_ ne $in[$line]) {
  				$ok = 0;
! 				last;
  			}
  		}
***************
*** 418,422 ****
  	close(RESULT);
  	
! 	ok $ok; # last 2 will fail; these are unresolvable problems with original Bio::Species
  	
  	unlink($outfile);
--- 417,421 ----
  	close(RESULT);
  	
! 	ok $ok;
  	
  	unlink($outfile);

Index: BioFetch_DB.t
===================================================================
RCS file: /home/repository/bioperl/bioperl-live/t/BioFetch_DB.t,v
retrieving revision 1.12
retrieving revision 1.13
diff -C2 -d -r1.12 -r1.13
*** BioFetch_DB.t	29 Jun 2006 16:30:28 -0000	1.12
--- BioFetch_DB.t	12 Aug 2006 11:00:02 -0000	1.13
***************
*** 74,78 ****
      ok( $seq->length, 408);
      ok(defined($seq = $db->get_Seq_by_acc('J02231')));
! 	ok $seq->id, 'J02231;';
      ok( $seq->length, 200); 
      ok(defined($seqio = $db->get_Stream_by_id(['BUM'])));
--- 74,78 ----
      ok( $seq->length, 408);
      ok(defined($seq = $db->get_Seq_by_acc('J02231')));
! 	ok $seq->id, 'J02231';
      ok( $seq->length, 200); 
      ok(defined($seqio = $db->get_Stream_by_id(['BUM'])));

Index: SearchIO.t
===================================================================
RCS file: /home/repository/bioperl/bioperl-live/t/SearchIO.t,v
retrieving revision 1.95
retrieving revision 1.96
diff -C2 -d -r1.95 -r1.96
*** SearchIO.t	3 Aug 2006 16:04:59 -0000	1.95
--- SearchIO.t	12 Aug 2006 11:00:02 -0000	1.96
***************
*** 23,27 ****
  	}
  	use vars qw($NTESTS);
! 	$NTESTS = 1294;
  	$LASTXMLTEST = 67;
  	$error = 0;
--- 23,27 ----
  	}
  	use vars qw($NTESTS);
! 	$NTESTS = 1334;
  	$LASTXMLTEST = 67;
[...1150 lines suppressed...]
!             ok($hsp->length('hsp'), 291);
!             ok($hsp->start('hit'), $hsp->hit->start);
!             ok($hsp->end('query'), $hsp->query->end);
!             ok($hsp->strand('sbjct'), $hsp->subject->strand);# alias for hit
!             ok($hsp->evalue == 6e-59);
!             ok($hsp->score, 119);
!             ok($hsp->bits,236);	    	    
!             ok(sprintf("%.2f",$hsp->percent_identity), 85.22);
!             ok(sprintf("%.4f",$hsp->frac_identical('query')), 0.8522);
!             ok(sprintf("%.4f",$hsp->frac_identical('hit')), 0.8522);
!             ok($hsp->gaps, 0);
!             $hsps_left--;
!         }
!         ok $hsps_left, 0;
      }
      last if( $count++ > @valid );
  }
+ ok @valid, 0;
  
  # some utilities

Index: Index.t
===================================================================
RCS file: /home/repository/bioperl/bioperl-live/t/Index.t,v
retrieving revision 1.42
retrieving revision 1.43
diff -C2 -d -r1.42 -r1.43
*** Index.t	23 Jul 2006 18:01:56 -0000	1.42
--- Index.t	12 Aug 2006 11:00:02 -0000	1.43
***************
*** 146,149 ****
--- 146,150 ----
  												-keep  => 1,
  												-file  => 'filecache.idx');
+    # problem:
     my $seq = $cache->get_Seq_by_id('AI129902');
     ok ( $seq);

Index: Taxonomy.t
===================================================================
RCS file: /home/repository/bioperl/bioperl-live/t/Taxonomy.t,v
retrieving revision 1.10
retrieving revision 1.11
diff -C2 -d -r1.10 -r1.11
*** Taxonomy.t	24 Jul 2006 16:35:41 -0000	1.10
--- Taxonomy.t	12 Aug 2006 11:00:02 -0000	1.11
***************
*** 15,18 ****
--- 15,19 ----
  	eval {
  		require Bio::DB::Taxonomy;
+         require Bio::Tree::Tree;
  		require XML::Twig;
  	};
***************
*** 21,25 ****
  		warn "Unable to run tests because XML::Twig is not installed\n";
  	}
! 	$NUMTESTS = 63;
  	$error = 0;
  	plan tests => $NUMTESTS;
--- 22,26 ----
  		warn "Unable to run tests because XML::Twig is not installed\n";
  	}
! 	$NUMTESTS = 96;
  	$error = 0;
  	plan tests => $NUMTESTS;
***************
*** 40,43 ****
--- 41,47 ----
  }
  
+ # we're actually testing Bio::Taxon and Bio::DB::Taxonomy::* here, not
+ # Bio::Taxonomy
+ 
  my $db_entrez = new Bio::DB::Taxonomy(-source => 'entrez');
  ok $db_entrez;
***************
*** 65,72 ****
      ok $id, 9606;
      
!     # easy test on human, try out the main node methods
!     ok $n = $db->get_Taxonomy_Node(9606);
!     ok $n->object_id, 9606;
!     ok $n->ncbi_taxid, $n->object_id;
      ok $n->parent_id, 9605;
      ok $n->rank, 'species';
--- 69,77 ----
      ok $id, 9606;
      
!     # easy test on human, try out the main Taxon methods
!     ok $n = $db->get_taxon(9606);
!     ok $n->id, 9606;
!     ok $n->object_id, $n->id;
!     ok $n->ncbi_taxid, $n->id;
      ok $n->parent_id, 9605;
      ok $n->rank, 'species';
***************
*** 74,80 ****
      ok $n->node_name, 'Homo sapiens';
      ok $n->scientific_name, $n->node_name;
-     ok (($n->classification)[0], $n->node_name);
      ok ${$n->name('scientific')}[0], $n->node_name;
-     ok $n->binomial, $n->node_name;
      
      my %common_names = map { $_ => 1 } $n->common_names;
--- 79,83 ----
***************
*** 93,109 ****
      }
      
!     #*** deprecated?
!     ok $n->genus, 'Homo';
!     ok $n->species, 'Homo sapiens';
!     ok ! $n->sub_species;
!     
!     # There needs to be more in-depth testing of Bio::Taxonomy::Node, but I may
!     # be rewriting it soon, so holding off for now
      
      sleep(3) if $db eq $db_entrez;
      
      # do some trickier things...
!     ok $n = $db->get_Taxonomy_Node('89593');
!     ok $n->scientific_name, 'Craniata';
      
      sleep(3) if $db eq $db_entrez;
--- 96,126 ----
      }
      
!     # briefly test some Bio::Tree::NodeI methods
!     ok my $ancestor = $n->ancestor;
!     ok $ancestor->scientific_name, 'Homo';
! 	# unless set explicitly, Bio::Taxon doesn't return anything for
! 	# each_Descendent; must ask the database directly
!     ok my @children = $ancestor->db_handle->each_Descendent($ancestor); 
!     ok @children > 0;
      
      sleep(3) if $db eq $db_entrez;
      
      # do some trickier things...
!     ok my $n2 = $db->get_Taxonomy_Node('89593');
!     ok $n2->scientific_name, 'Craniata';
!     
!     # briefly check we can use some Tree methods
!     my $tree = new Bio::Tree::Tree();
!     ok ($tree->get_lca($n, $n2)->scientific_name, 'Craniata');
!     
!     # can we actually form a Tree and use other Tree methods?
!     ok $tree = new Bio::Tree::Tree(-node => $n);
!     ok $tree->number_nodes, 30;
!     ok $tree->get_nodes, 30;
!     ok $tree->find_node(-rank => 'genus')->scientific_name, 'Homo';
!     
!     # check that getting the ancestor still works now we have explitly set the
!     # ancestor by making a Tree
!     ok $n->ancestor->scientific_name, 'Homo';
      
      sleep(3) if $db eq $db_entrez;
***************
*** 125,127 ****
      ok @ids, 1;
      ok $ids[0], 231509;
! }
\ No newline at end of file
--- 142,228 ----
      ok @ids, 1;
      ok $ids[0], 231509;
! }
! 
! # Test the list database
! my @ranks = qw(superkingdom class genus species);
! my @h_lineage = ('Eukaryota', 'Mammalia', 'Homo', 'Homo sapiens');
! my $db_list = new Bio::DB::Taxonomy(-source => 'list', -names => \@h_lineage,
!                                                        -ranks => \@ranks);
! ok $db_list;
! 
! ok my $h_list = $db_list->get_taxon(-name => 'Homo sapiens');
! ok my $h_flat = $db_flatfile->get_taxon(-name => 'Homo sapiens');
! 
! ok $h_list->ancestor->scientific_name, 'Homo';
! 
! my @names = $h_list->common_names;
! ok @names, 0;
! $h_list->common_names('woman');
! @names = $h_list->common_names;
! ok @names, 1;
! @names = $h_flat->common_names;
! ok @names, 2;
! 
! # you can switch to another database when you need more information, which also
! # merges information in the node from the two different dbs
! $h_list->db_handle($db_flatfile);
! @names = $h_list->common_names;
! ok @names, 3;
! 
! # form a tree with the list lineage first, preventing a subsequent database
! # change from giving us all those extra ranks
! $h_list->db_handle($db_list);
! my $ancestors_ancestor = $h_list->ancestor->ancestor;
! ok $ancestors_ancestor->scientific_name, 'Mammalia';
! 
! my $tree = new Bio::Tree::Tree(-node => $h_list);
! $h_list->db_handle($db_flatfile);
! $ancestors_ancestor = $h_list->ancestor->ancestor;
! ok $ancestors_ancestor->scientific_name, 'Mammalia';
! 
! # or we can get the flatfile database's idea of the ancestors by removing
! # ourselves from the tree
! ok $h_flat->ancestor->ancestor->scientific_name, 'Homo/Pan/Gorilla group';
! $h_list->ancestor(undef);
! ok $h_list->ancestor->ancestor->scientific_name, 'Homo/Pan/Gorilla group';
! 
! # get_lca should work on nodes from different databases
! $h_flat = $db_flatfile->get_taxon(-name => 'Homo');
! ok my $h_entrez = $db_entrez->get_taxon(-name => 'Homo sapiens');
! ok my $tree_functions = new Bio::Tree::Tree();
! ok ($tree_functions->get_lca($h_flat, $h_entrez)->scientific_name, 'Homo');
! 
! # even though the species taxa for Homo sapiens from list and flat databases
! # have the same internal id, get_lca won't work because they have different
! # roots and descendents
! $h_list = $db_list->get_taxon(-name => 'Homo sapiens');
! ok $h_list->ancestor->internal_id, $h_flat->internal_id;
! ok ! $tree_functions->get_lca($h_flat, $h_list);
! 
! # but we can form a tree with the flat node then remove all the ranks we're
! # not interested in and try again
! $tree = new Bio::Tree::Tree(-node => $h_flat);
! $tree->splice(-keep_rank => \@ranks);
! ok ($tree->get_lca($h_flat, $h_list)->scientific_name, 'Homo');
! 
! # ideas from taxonomy2tree.PLS that let us make nice tree, using
! # Bio::Tree::TreeFunctionsI methods; this is a weird and trivial example just
! # because our test flatfile database only has the full lineage of one species
! undef $tree;
! for my $name ('Human', 'Hominidae') {
!   my $ncbi_id = $db_flatfile->get_taxonid($name);
!   if ($ncbi_id) {
!     my $node = $db_flatfile->get_taxon(-taxonid => $ncbi_id);
!     
!     if ($tree) {
! 		$tree->merge_lineage($node);
!     }
!     else {
! 		ok $tree = new Bio::Tree::Tree(-node => $node);
!     }
!   }
! }
! ok $tree->get_nodes, 30;
! $tree->contract_linear_paths;
! my $ids = join(",", map { $_->id } $tree->get_nodes);
! ok $ids, '131567,9606';
\ No newline at end of file

Index: Node.t
===================================================================
RCS file: /home/repository/bioperl/bioperl-live/t/Node.t,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** Node.t	30 Jul 2003 20:11:35 -0000	1.6
--- Node.t	12 Aug 2006 11:00:02 -0000	1.7
***************
*** 15,19 ****
      }
      use Test;
!     plan tests => 17;
  }
  
--- 15,19 ----
      }
      use Test;
!     plan tests => 21;
  }
  
***************
*** 46,49 ****
--- 46,54 ----
  ok($phylo_node->description, 'Taxon 1');
  
+ ok $phylo_node->ancestor($node2), $node2;
+ ok $node1->is_Leaf;
+ ok my @descs = $node2->each_Descendent, 1;
+ ok $descs[0], $phylo_node;
+ 
  my $allele_node = new Bio::Tree::AlleleNode();
  $allele_node->add_Genotype(new Bio::PopGen::Genotype(-marker_name => 'm1',

Index: Species.t
===================================================================
RCS file: /home/repository/bioperl/bioperl-live/t/Species.t,v
retrieving revision 1.10
retrieving revision 1.11
diff -C2 -d -r1.10 -r1.11
*** Species.t	28 Jul 2006 13:56:04 -0000	1.10
--- Species.t	12 Aug 2006 11:00:02 -0000	1.11
***************
*** 23,28 ****
      }
      use Test;
! 
!     plan tests => 9;
  }
  
--- 23,28 ----
      }
      use Test;
!     
!     plan tests => 13;
  }
  
***************
*** 60,61 ****
--- 60,68 ----
  ok( $species);
  ok $species->binomial(), 'Homo sapiens';
+ ok $species->species, 'sapiens';
+ ok $species->genus, 'Homo';
+ 
+ 
+ # A Bio::Species isa Bio::Taxon, so test some things from there briefly
+ ok $species->scientific_name, 'sapiens';
+ ok $species->rank, 'species';



More information about the Bioperl-guts-l mailing list