1 # -*-Perl-*- Test Harness script for Bioperl
10 test_begin(-tests => 78);
12 use_ok('Bio::TreeIO');
15 my $verbose = test_debug();
17 ok my $treeio = Bio::TreeIO->new(-verbose => $verbose,
19 -file => test_input_file('cysprot1b.newick'));
21 my $tree = $treeio->next_tree;
22 isa_ok($tree, 'Bio::Tree::TreeI');
24 my @nodes = $tree->get_nodes;
26 my ($rat) = $tree->find_node('CATL_RAT');
28 is($rat->branch_length, '0.12788');
29 # move the id to the bootstap
30 is($rat->ancestor->bootstrap($rat->ancestor->id), '95');
31 $rat->ancestor->id('');
32 # maybe this can be auto-detected, but then can't distinguish
33 # between internal node labels and bootstraps...
34 is($rat->ancestor->bootstrap, '95');
35 is($rat->ancestor->branch_length, '0.18794');
36 is($rat->ancestor->id, '');
39 foreach my $node ( $tree->get_root_node()->each_Descendent() ) {
40 print "node: ", $node->to_string(), "\n";
41 my @ch = $node->each_Descendent();
43 print "\tchildren are: \n";
44 foreach my $node ( $node->each_Descendent() ) {
45 print "\t\t ", $node->to_string(), "\n";
51 my $FILE1 = test_output_file();
52 $treeio = Bio::TreeIO->new(-verbose => $verbose,
55 $treeio->write_tree($tree);
58 $treeio = Bio::TreeIO->new(-verbose => $verbose,
60 -file => test_input_file('LOAD_Ccd1.dnd'));
62 $tree = $treeio->next_tree;
64 isa_ok($tree,'Bio::Tree::TreeI');
66 @nodes = $tree->get_nodes;
70 foreach my $node ( @nodes ) {
71 print "node: ", $node->to_string(), "\n";
72 my @ch = $node->each_Descendent();
74 print "\tchildren are: \n";
75 foreach my $node ( $node->each_Descendent() ) {
76 print "\t\t ", $node->to_string(), "\n";
82 is($tree->total_branch_length, 7.12148);
83 my $FILE2 = test_output_file();
84 $treeio = Bio::TreeIO->new(-verbose => $verbose,
87 $treeio->write_tree($tree);
90 $treeio = Bio::TreeIO->new(-verbose => $verbose,
92 -file => test_input_file('hs_fugu.newick'));
93 $tree = $treeio->next_tree();
94 @nodes = $tree->get_nodes();
96 # no relable order for the bottom nodes because they have no branchlen
97 my @vals = qw(SINFRUP0000006110);
99 foreach my $node ( $tree->get_root_node()->each_Descendent() ) {
100 foreach my $v ( @vals ) {
101 if( defined $node->id &&
102 $node->id eq $v ){ $saw = 1; last; }
106 is($saw, 1, "Saw $vals[0] as expected");
108 foreach my $node ( @nodes ) {
109 print "\t", $node->id, "\n" if $node->id;
113 $treeio = Bio::TreeIO->new(-format => 'newick',
115 my $treeout = Bio::TreeIO->new(-format => 'tabtree');
116 my $treeout2 = Bio::TreeIO->new(-format => 'newick');
118 $tree = $treeio->next_tree;
121 $treeout->write_tree($tree);
122 $treeout2->write_tree($tree);
125 $treeio = Bio::TreeIO->new(-verbose => $verbose,
126 -file => test_input_file('test.nhx'));
129 test_skip(-tests => 2, -requires_module => 'SVG::Graph');
130 my $FILE3 = test_output_file();
131 my $treeout3 = Bio::TreeIO->new(-format => 'svggraph',
134 eval {$treeout3->write_tree($tree);};
139 $tree = $treeio->next_tree;
141 isa_ok($tree, 'Bio::Tree::TreeI');
143 @nodes = $tree->get_nodes;
144 is(@nodes, 12, "Total Nodes");
146 my $adhy = $tree->find_node('ADHY');
147 is($adhy->branch_length, 0.1);
148 is(($adhy->get_tag_values('S'))[0], 'nematode');
149 is(($adhy->get_tag_values('E'))[0], '1.1.1.1');
151 # try lintree parsing
152 $treeio = Bio::TreeIO->new(-format => 'lintree',
153 -file => test_input_file('crab.njb'));
156 while( $tree = $treeio->next_tree ) {
158 isa_ok($tree, 'Bio::Tree::TreeI');
160 @nodes = $tree->get_nodes;
162 @leaves = $tree->get_leaf_nodes;
164 #/maj is(@nodes, 25);
165 is(@nodes, 24); # this is clear from the datafile and counting \maj
166 ($node) = $tree->find_node(-id => '18');
169 is($node->branch_length, '0.030579');
170 is($node->bootstrap, 998);
173 $treeio = Bio::TreeIO->new(-format => 'lintree',
174 -file => test_input_file('crab.nj'));
176 $tree = $treeio->next_tree;
178 isa_ok($tree, 'Bio::Tree::TreeI');
180 @nodes = $tree->get_nodes;
181 @leaves = $tree->get_leaf_nodes;
183 #/maj is(@nodes, 25);
184 is(@nodes, 24); #/maj
185 ($node) = $tree->find_node('18');
187 is($node->branch_length, '0.028117');
189 ($node) = $tree->find_node(-id => 'C-vittat');
190 is($node->id, 'C-vittat');
191 is($node->branch_length, '0.087619');
192 is($node->ancestor->id, '14');
194 $treeio = Bio::TreeIO->new(-format => 'lintree',
195 -file => test_input_file('crab.dat.cn'));
197 $tree = $treeio->next_tree;
199 isa_ok($tree, 'Bio::Tree::TreeI');
201 @nodes = $tree->get_nodes;
202 @leaves = $tree->get_leaf_nodes;
203 is(@leaves, 13, "Leaf nodes");
205 #/maj is(@nodes, 25, "All nodes");
206 is(@nodes, 24, "All nodes");
207 ($node) = $tree->find_node('18');
210 is($node->branch_length, '0.029044');
212 ($node) = $tree->find_node(-id => 'C-vittat');
213 is($node->id, 'C-vittat');
214 is($node->branch_length, '0.097855');
215 is($node->ancestor->id, '14');
218 test_skip(-tests => 8, -requires_module => 'IO::String');
220 # test nexus tree parsing
221 $treeio = Bio::TreeIO->new(-format => 'nexus',
222 -verbose => $verbose,
223 -file => test_input_file('urease.tre.nexus'));
225 $tree = $treeio->next_tree;
227 is($tree->id, 'PAUP_1');
228 is($tree->get_leaf_nodes, 6);
229 ($node) = $tree->find_node(-id => 'Spombe');
230 is($node->branch_length,0.221404);
232 # test nexus MrBayes tree parsing
233 $treeio = Bio::TreeIO->new(-format => 'nexus',
234 -file => test_input_file('adh.mb_tree.nexus'));
236 $tree = $treeio->next_tree;
239 is($tree->id, 'rep.1');
240 is($tree->get_leaf_nodes, 54);
241 ($node) = $tree->find_node(-id => 'd.madeirensis');
242 is($node->branch_length,0.039223);
243 while ($tree = $treeio->next_tree) {
246 is($ct,13,'bug 2356');
250 # process no-newlined tree
251 $treeio = Bio::TreeIO->new(-format => 'nexus',
252 -verbose => $verbose,
253 -file => test_input_file('tree_nonewline.nexus'));
255 $tree = $treeio->next_tree;
257 ok($tree->find_node('TRXHomo'));
260 # parse trees with scores
262 $treeio = Bio::TreeIO->new(-format => 'newick',
263 -file => test_input_file('puzzle.tre'));
264 $tree = $treeio->next_tree;
266 is($tree->score, '-2673.059726');
269 # process trees with node IDs containing spaces
270 $treeio = Bio::TreeIO->new(-format => 'nexus',
271 -verbose => $verbose,
272 -file => test_input_file('spaces.nex'));
274 $tree = $treeio->next_tree;
276 my @nodeids = ("'Allium drummondii'", "'Allium cernuum'",'A.cyaneum');
279 for my $node ($tree->get_leaf_nodes) {
280 is($node->id, shift @nodeids);
284 # process tree with names containing quoted commas
286 $tree = $treeio->next_tree;
288 @nodeids = ("'Allium drummondii, USA'", "'Allium drummondii, Russia'",'A.cyaneum');
291 for my $node ($tree->get_leaf_nodes) {
292 is($node->id, shift @nodeids);
296 # process tree with names containing quoted commas on one line
298 $tree = $treeio->next_tree;
300 @nodeids = ("'Allium drummondii, Russia'", "'Allium drummondii, USA'",'A.cyaneum');
303 for my $node ($tree->get_leaf_nodes) {
304 is($node->id, shift @nodeids);
310 # proper way (Tree isn't GC'd)
311 $tree = Bio::TreeIO->new(-format => 'newick',
312 -verbose => $verbose,
313 -file => test_input_file('bug2869.tree'))->next_tree;
315 my $root = $tree->get_root_node;
317 isa_ok($root, 'Bio::Tree::NodeI');
320 for my $child ($root->get_Descendents) {
328 $root = Bio::TreeIO->new(-format => 'newick',
329 -verbose => $verbose,
330 -file => test_input_file('bug2869.tree'),
331 -no_cleanup => 1)->next_tree->get_root_node;
333 isa_ok($root, 'Bio::Tree::NodeI');
336 local $TODO = 'The nodes are garbage-collected away b/c Tree isn\'t retained in memory';
338 for my $child ($root->get_Descendents) {
342 is($total2, $total1);
346 (((A:1,B:1):1,(C:1,D:1):1):1,((E:1,F:1):1,(G:1,H:1):1):1);