t/TaxonTree.t

   1 # -*-Perl-*- Test Harness script for Bioperl
   2 # $Id$
   3
   4 # These modules are now deprecated, don't bother testing them. --sendubala
   5
   6 ## I am pretty sure this module is going the way of the dodo bird so
   7 ## I am not sure how much work to put into fixing the tests/module
   8 ## --jasonstajich
   9
  10 use strict;
  11
  12 BEGIN {
  13     use lib '.';
  14     use Bio::Root::Test;
  15
  16     test_begin(-tests => 0);
  17 }
  18
  19 if (0) {
  20         use Bio::Taxonomy::Taxon;
  21         ok(1);
  22
  23
  24         ok my $taxonL = Bio::Taxonomy::Taxon->new;
  25         ok $taxonL->description('this could be anything');
  26         ok $taxonL->taxon('could this be called name?');
  27         ok $taxonL->id('could this be called taxid?');
  28         skip 1, $taxonL->branch_length('should accept only numerical values?');
  29         ok  $taxonL->branch_length(5);
  30
  31         ok $taxonL->id('could this be called taxid?');
  32         ok $taxonL->rank('species');
  33         ok $taxonL->rank, 'species';
  34         # ok $taxonL->has_rank, 'species'; #why two methods that do mostly the same thing, but work differently?
  35
  36         skip 1, $taxonL->rank('foo is not a rank, class variable @RANK not initialised');
  37         ok $taxonL->to_string, '"could this be called taxid?":5';
  38
  39         my $taxonR = Bio::Taxonomy::Taxon->new();
  40
  41         my $taxon = Bio::Taxonomy::Taxon->new(-id =>'ancient', -taxon => 'genus');
  42         ok $taxon->id(), 'ancient';
  43         ok $taxon->taxon(), 'genus';
  44         ok $taxon->internal_id, 2;
  45         ok $taxonL->internal_id, 0; # would not it be better to start numebering from 1?
  46         ok $taxon->add_Descendent($taxonL);
  47         $taxon->add_Descendent($taxonR);
  48
  49         ok  scalar $taxon->each_Descendent, 2;  # dies
  50         ok $taxon->remove_Descendent($taxonR); # better to return number of Descendants removed
  51
  52         ok $taxon->remove_all_Descendents();
  53
  54
  55         $taxon->add_Descendent($taxonL);
  56         ok $taxonL->ancestor->id, 'ancient';
  57         ok $taxonL->branch_length(5);
  58
  59
  60         ok $taxonL->is_Leaf, 1;
  61         ok $taxon->is_Leaf, 0;
  62         ok $taxon->height, 6;
  63         ok $taxonL->height, 5;
  64         ok $taxon->invalidate_height, undef;
  65         ok $taxonL->classify(1), 2;
  66         skip(1,"skip classify weirdness");
  67         # ok $taxonL->classify(0), 2, 'ancestor has rank, but implementation prevents showing anything more than one value';
  68         skip(1,"skip classify weirdness");
  69         #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';
  70         skip(1,"skip classify weirdness");
  71         #ok $taxonL->has_rank('species'), 1;
  72
  73         #ok $taxon->has_taxon(); # why docs and code talk about ancestor?
  74         #ok $taxonL->has_taxon('genus');  returns undef or oan object, not boolean
  75
  76         ok $taxon->distance_to_root, 0;
  77         ok $taxonL->distance_to_root, 1;
  78         #ok $taxonL->recent_common_ancestor($taxon)->id, 'ancient';
  79
  80
  81
  82         #use Data::Dumper;
  83         #print Dumper  $taxonL->classify();
  84         skip(1, 'Skip this weird function');
  85         # ok $taxonL->has_rank('species'), 1;
  86         #ok my $species = $taxonL->species;
  87
  88
  89
  90
  91
  92         ##################################################################################################
  93
  94         # tests for Bio::Taxonomy::Tree;
  95         # code from synopsis
  96
  97         use Bio::Species;
  98         use Bio::Taxonomy::Tree;
  99         use Bio::Taxonomy;
 100
 101         my $human=Bio::Species->new();
 102         my $chimp=Bio::Species->new();
 103         my $bonobo=Bio::Species->new();
 104
 105         $human->classification(qw( sapiens Homo Hominidae
 106                                                            Catarrhini Primates Eutheria
 107                                                            Mammalia Euteleostomi Vertebrata
 108                                                            Craniata Chordata
 109                                                            Metazoa Eukaryota ));
 110         $chimp->classification(qw( troglodytes Pan Hominidae
 111                                                            Catarrhini Primates Eutheria
 112                                                            Mammalia Euteleostomi Vertebrata
 113                                                            Craniata Chordata
 114                                                            Metazoa Eukaryota ));
 115         $bonobo->classification(qw( paniscus Pan Hominidae
 116                                                                 Catarrhini Primates Eutheria
 117                                                                 Mammalia Euteleostomi Vertebrata
 118                                                                 Craniata Chordata
 119                                                                 Metazoa Eukaryota ));
 120
 121         # ranks passed to $taxonomy match ranks of species
 122         my @ranks = ('superkingdom','kingdom','phylum','subphylum',
 123                                  'no rank 1','no rank 2','class','no rank 3','order',
 124                                  'suborder','family','genus','species');
 125
 126         my $taxonomy=Bio::Taxonomy->new(-ranks => \@ranks,
 127                                                                    -method => 'trust',
 128                                                                    -order => -1);
 129
 130
 131         ok my $tree1=Bio::Taxonomy::Tree->new();
 132         my $tree2=Bio::Taxonomy::Tree->new();
 133
 134         $tree1->make_species_branch($human,$taxonomy);
 135         $tree2->make_species_branch($chimp,$taxonomy);
 136
 137         my ($homo_sapiens) = $tree1->get_leaves;
 138         ok ref $homo_sapiens, 'Bio::Taxonomy::Taxon';
 139
 140         ok $tree1->splice($tree2);
 141
 142         ok $tree1->add_species($bonobo,$taxonomy);
 143
 144
 145         ok join (", ", map {$_->taxon} $tree1->get_leaves), 'Homo sapiens, Pan troglodytes, Pan paniscus';
 146         ok $tree1->remove_branch($homo_sapiens);
 147         ok join (", ", map {$_->taxon} $tree1->get_leaves), 'Pan troglodytes, Pan paniscus';
 148 }