1
# -*-Perl-*- Test Harness script for Bioperl
2
# $Id: TreeIO.t 15112 2008-12-08 18:12:38Z sendu $
10
test_begin(-tests => 74);
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, 13, "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;
165
($node) = $tree->find_node(-id => '18');
168
is($node->branch_length, '0.030579');
169
is($node->bootstrap, 998);
172
$treeio = Bio::TreeIO->new(-format => 'lintree',
173
-file => test_input_file('crab.nj'));
175
$tree = $treeio->next_tree;
177
isa_ok($tree, 'Bio::Tree::TreeI');
179
@nodes = $tree->get_nodes;
180
@leaves = $tree->get_leaf_nodes;
183
($node) = $tree->find_node('18');
185
is($node->branch_length, '0.028117');
187
($node) = $tree->find_node(-id => 'C-vittat');
188
is($node->id, 'C-vittat');
189
is($node->branch_length, '0.087619');
190
is($node->ancestor->id, '14');
192
$treeio = Bio::TreeIO->new(-format => 'lintree',
193
-file => test_input_file('crab.dat.cn'));
195
$tree = $treeio->next_tree;
197
isa_ok($tree, 'Bio::Tree::TreeI');
199
@nodes = $tree->get_nodes;
200
@leaves = $tree->get_leaf_nodes;
201
is(@leaves, 13, "Leaf nodes");
203
is(@nodes, 25, "All nodes");
204
($node) = $tree->find_node('18');
207
is($node->branch_length, '0.029044');
209
($node) = $tree->find_node(-id => 'C-vittat');
210
is($node->id, 'C-vittat');
211
is($node->branch_length, '0.097855');
212
is($node->ancestor->id, '14');
215
test_skip(-tests => 8, -requires_module => 'IO::String');
217
# test nexus tree parsing
218
$treeio = Bio::TreeIO->new(-format => 'nexus',
219
-verbose => $verbose,
220
-file => test_input_file('urease.tre.nexus'));
222
$tree = $treeio->next_tree;
224
is($tree->id, 'PAUP_1');
225
is($tree->get_leaf_nodes, 6);
226
($node) = $tree->find_node(-id => 'Spombe');
227
is($node->branch_length,0.221404);
229
# test nexus MrBayes tree parsing
230
$treeio = Bio::TreeIO->new(-format => 'nexus',
231
-file => test_input_file('adh.mb_tree.nexus'));
233
$tree = $treeio->next_tree;
236
is($tree->id, 'rep.1');
237
is($tree->get_leaf_nodes, 54);
238
($node) = $tree->find_node(-id => 'd.madeirensis');
239
is($node->branch_length,0.039223);
240
while ($tree = $treeio->next_tree) {
243
is($ct,13,'bug 2356');
247
# process no-newlined tree
248
$treeio = Bio::TreeIO->new(-format => 'nexus',
249
-verbose => $verbose,
250
-file => test_input_file('tree_nonewline.nexus'));
252
$tree = $treeio->next_tree;
254
ok($tree->find_node('TRXHomo'));
257
# parse trees with scores
259
$treeio = Bio::TreeIO->new(-format => 'newick',
260
-file => test_input_file('puzzle.tre'));
261
$tree = $treeio->next_tree;
263
is($tree->score, '-2673.059726');
266
# process trees with node IDs containing spaces
267
$treeio = Bio::TreeIO->new(-format => 'nexus',
268
-verbose => $verbose,
269
-file => test_input_file('spaces.nex'));
271
$tree = $treeio->next_tree;
273
my @nodeids = ("'Allium drummondii'", "'Allium cernuum'",'A.cyaneum');
276
for my $node ($tree->get_leaf_nodes) {
277
is($node->id, shift @nodeids);
281
# process tree with names containing quoted commas
283
$tree = $treeio->next_tree;
285
@nodeids = ("'Allium drummondii, USA'", "'Allium drummondii, Russia'",'A.cyaneum');
288
for my $node ($tree->get_leaf_nodes) {
289
is($node->id, shift @nodeids);
293
# process tree with names containing quoted commas on one line
295
$tree = $treeio->next_tree;
297
@nodeids = ("'Allium drummondii, Russia'", "'Allium drummondii, USA'",'A.cyaneum');
300
for my $node ($tree->get_leaf_nodes) {
301
is($node->id, shift @nodeids);
305
(((A:1,B:1):1,(C:1,D:1):1):1,((E:1,F:1):1,(G:1,H:1):1):1);