Merge branch 'master' of github.com:bioperl/bioperl-live
[bioperl-live.git] / t / TaxonTree.t
blob6ba6d98520250c306b7ea9b436e12c690be28469
1 # -*-Perl-*- Test Harness script for Bioperl
2 # $Id$
4 # These modules are now deprecated, don't bother testing them. --sendubala
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
10 use strict;
12 BEGIN { 
13     use lib '.';
14     use Bio::Root::Test;
15     
16     test_begin(-tests => 0);
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';