~ubuntu-branches/ubuntu/trusty/bioperl/trusty-proposed

« back to all changes in this revision

Viewing changes to t/Tree/TreeIO.t

  • Committer: Bazaar Package Importer
  • Author(s): Charles Plessy
  • Date: 2009-03-10 07:19:11 UTC
  • mfrom: (1.2.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20090310071911-fukqzw54pyb1f0bd
Tags: 1.6.0-2
* Removed patch system (not used):
  - removed instuctions in debian/rules;
  - removed quilt from Build-Depends in debian/control.
* Re-enabled tests:
  - uncommented test command in debian/rules;
  - uncommented previously missing build-dependencies in debian/control.
  - Re-enabled tests and uncommented build-dependencies accordingly.
* Removed libmodule-build-perl and libtest-harness-perl from
  Build-Depends-Indep (provided by perl-modules).
* Better cleaning of empty directories using find -type d -empty -delete
  instead of rmdir in debian/rules (LP: #324001).

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
# -*-Perl-*- Test Harness script for Bioperl
 
2
# $Id: TreeIO.t 15112 2008-12-08 18:12:38Z sendu $
 
3
 
 
4
use strict;
 
5
 
 
6
BEGIN {
 
7
        use lib '.';
 
8
    use Bio::Root::Test;
 
9
    
 
10
    test_begin(-tests => 74);
 
11
        
 
12
        use_ok('Bio::TreeIO');
 
13
}
 
14
 
 
15
my $verbose = test_debug();
 
16
 
 
17
ok my $treeio = Bio::TreeIO->new(-verbose => $verbose,
 
18
                             -format => 'newick',
 
19
                             -file   => test_input_file('cysprot1b.newick'));
 
20
 
 
21
my $tree = $treeio->next_tree;
 
22
isa_ok($tree, 'Bio::Tree::TreeI');
 
23
 
 
24
my @nodes = $tree->get_nodes;
 
25
is(@nodes, 6);
 
26
my ($rat) = $tree->find_node('CATL_RAT');
 
27
ok($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, '');
 
37
 
 
38
if ($verbose) {
 
39
        foreach my $node ( $tree->get_root_node()->each_Descendent() ) {
 
40
                print "node: ", $node->to_string(), "\n";
 
41
                my @ch = $node->each_Descendent();
 
42
                if( @ch ) {
 
43
                        print "\tchildren are: \n";
 
44
                        foreach my $node ( $node->each_Descendent() ) {
 
45
                                print "\t\t ", $node->to_string(), "\n";
 
46
                        }
 
47
                }
 
48
        }
 
49
}
 
50
 
 
51
my $FILE1 = test_output_file();
 
52
$treeio = Bio::TreeIO->new(-verbose => $verbose,
 
53
                          -format => 'newick',
 
54
                          -file   => ">$FILE1");
 
55
$treeio->write_tree($tree);
 
56
undef $treeio;
 
57
ok( -s $FILE1 );
 
58
$treeio = Bio::TreeIO->new(-verbose => $verbose,
 
59
                          -format => 'newick',
 
60
                          -file   => test_input_file('LOAD_Ccd1.dnd'));
 
61
ok($treeio);
 
62
$tree = $treeio->next_tree;
 
63
 
 
64
isa_ok($tree,'Bio::Tree::TreeI');
 
65
 
 
66
@nodes = $tree->get_nodes;
 
67
is(@nodes, 52);
 
68
 
 
69
if( $verbose ) { 
 
70
        foreach my $node ( @nodes ) {
 
71
                print "node: ", $node->to_string(), "\n";
 
72
                my @ch = $node->each_Descendent();
 
73
                if( @ch ) {
 
74
                        print "\tchildren are: \n";
 
75
                        foreach my $node ( $node->each_Descendent() ) {
 
76
                                print "\t\t ", $node->to_string(), "\n";
 
77
                        }
 
78
                }
 
79
        }
 
80
}
 
81
 
 
82
is($tree->total_branch_length, 7.12148);
 
83
my $FILE2 = test_output_file();
 
84
$treeio = Bio::TreeIO->new(-verbose => $verbose,
 
85
                          -format => 'newick', 
 
86
                          -file   => ">$FILE2");
 
87
$treeio->write_tree($tree);
 
88
undef $treeio;
 
89
ok(-s $FILE2);
 
90
$treeio = Bio::TreeIO->new(-verbose => $verbose,
 
91
                          -format  => 'newick',
 
92
                          -file    => test_input_file('hs_fugu.newick'));
 
93
$tree = $treeio->next_tree();
 
94
@nodes = $tree->get_nodes();
 
95
is(@nodes, 5);
 
96
# no relable order for the bottom nodes because they have no branchlen
 
97
my @vals = qw(SINFRUP0000006110);
 
98
my $saw = 0;
 
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; }
 
103
        }
 
104
        last if $saw;
 
105
}
 
106
is($saw, 1, "Saw $vals[0] as expected");
 
107
if( $verbose ) {
 
108
        foreach my $node ( @nodes ) {
 
109
                print "\t", $node->id, "\n" if $node->id;
 
110
        }
 
111
}
 
112
 
 
113
$treeio = Bio::TreeIO->new(-format => 'newick', 
 
114
                                                                  -fh => \*DATA);
 
115
my $treeout = Bio::TreeIO->new(-format => 'tabtree');
 
116
my $treeout2 = Bio::TreeIO->new(-format => 'newick');
 
117
 
 
118
$tree = $treeio->next_tree;
 
119
 
 
120
if( $verbose > 0  ) {
 
121
    $treeout->write_tree($tree);
 
122
    $treeout2->write_tree($tree);
 
123
}
 
124
 
 
125
$treeio = Bio::TreeIO->new(-verbose => $verbose,
 
126
                          -file   => test_input_file('test.nhx'));
 
127
 
 
128
SKIP: {
 
129
        test_skip(-tests => 2, -requires_module => 'SVG::Graph');
 
130
        my $FILE3 = test_output_file();
 
131
        my $treeout3 = Bio::TreeIO->new(-format => 'svggraph',
 
132
                                                                                         -file => ">$FILE3");
 
133
        ok($treeout3);
 
134
        eval {$treeout3->write_tree($tree);};
 
135
        ok (-s $FILE3);
 
136
}
 
137
 
 
138
ok($treeio);
 
139
$tree = $treeio->next_tree;
 
140
 
 
141
isa_ok($tree, 'Bio::Tree::TreeI');
 
142
 
 
143
@nodes = $tree->get_nodes;
 
144
is(@nodes, 13, "Total Nodes");
 
145
 
 
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');
 
150
 
 
151
# try lintree parsing
 
152
$treeio = Bio::TreeIO->new(-format => 'lintree',
 
153
                              -file   => test_input_file('crab.njb'));
 
154
 
 
155
my (@leaves, $node);
 
156
while( $tree = $treeio->next_tree ) {
 
157
 
 
158
        isa_ok($tree, 'Bio::Tree::TreeI');
 
159
 
 
160
        @nodes = $tree->get_nodes;
 
161
 
 
162
        @leaves = $tree->get_leaf_nodes;
 
163
        is(@leaves, 13);
 
164
        is(@nodes, 25);
 
165
        ($node) = $tree->find_node(-id => '18');
 
166
        ok($node);
 
167
        is($node->id, '18');
 
168
        is($node->branch_length, '0.030579');
 
169
        is($node->bootstrap, 998);
 
170
}
 
171
 
 
172
$treeio = Bio::TreeIO->new(-format => 'lintree',
 
173
                           -file   => test_input_file('crab.nj'));
 
174
 
 
175
$tree = $treeio->next_tree;
 
176
 
 
177
isa_ok($tree, 'Bio::Tree::TreeI');
 
178
 
 
179
@nodes = $tree->get_nodes;
 
180
@leaves = $tree->get_leaf_nodes;
 
181
is(@leaves, 13);
 
182
is(@nodes, 25);
 
183
($node) = $tree->find_node('18');
 
184
is($node->id, '18');
 
185
is($node->branch_length, '0.028117');
 
186
 
 
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');
 
191
 
 
192
$treeio = Bio::TreeIO->new(-format => 'lintree',
 
193
                          -file   => test_input_file('crab.dat.cn'));
 
194
 
 
195
$tree = $treeio->next_tree;
 
196
 
 
197
isa_ok($tree, 'Bio::Tree::TreeI');
 
198
 
 
199
@nodes = $tree->get_nodes;
 
200
@leaves = $tree->get_leaf_nodes;
 
201
is(@leaves, 13, "Leaf nodes");
 
202
 
 
203
is(@nodes, 25, "All nodes");
 
204
($node) = $tree->find_node('18');
 
205
is($node->id, '18');
 
206
 
 
207
is($node->branch_length, '0.029044');
 
208
 
 
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');
 
213
 
 
214
SKIP: {
 
215
        test_skip(-tests => 8, -requires_module => 'IO::String');
 
216
        
 
217
        # test nexus tree parsing
 
218
    $treeio = Bio::TreeIO->new(-format => 'nexus',
 
219
                                                           -verbose => $verbose,
 
220
                               -file   => test_input_file('urease.tre.nexus'));
 
221
    
 
222
    $tree = $treeio->next_tree;
 
223
    ok($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);
 
228
    
 
229
        # test nexus MrBayes tree parsing
 
230
    $treeio = Bio::TreeIO->new(-format => 'nexus',
 
231
                               -file   => test_input_file('adh.mb_tree.nexus'));
 
232
    
 
233
    $tree = $treeio->next_tree;
 
234
        my $ct = 1; 
 
235
    ok($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) {
 
241
                $ct++;
 
242
        }
 
243
        is($ct,13,'bug 2356');
 
244
}
 
245
 
 
246
# bug #1854
 
247
# process no-newlined tree
 
248
$treeio = Bio::TreeIO->new(-format => 'nexus',
 
249
                                                   -verbose => $verbose,
 
250
                           -file   => test_input_file('tree_nonewline.nexus'));
 
251
 
 
252
$tree = $treeio->next_tree;
 
253
ok($tree);
 
254
ok($tree->find_node('TRXHomo'));
 
255
 
 
256
 
 
257
# parse trees with scores
 
258
 
 
259
$treeio = Bio::TreeIO->new(-format => 'newick',
 
260
                           -file   => test_input_file('puzzle.tre'));
 
261
$tree = $treeio->next_tree;
 
262
ok($tree);
 
263
is($tree->score, '-2673.059726');
 
264
 
 
265
# bug #2205
 
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'));
 
270
 
 
271
$tree = $treeio->next_tree;
 
272
 
 
273
my @nodeids = ("'Allium drummondii'", "'Allium cernuum'",'A.cyaneum');
 
274
 
 
275
ok($tree);
 
276
for my $node ($tree->get_leaf_nodes) {
 
277
        is($node->id, shift @nodeids);          
 
278
}
 
279
 
 
280
# bug #2221
 
281
# process tree with names containing quoted commas
 
282
 
 
283
$tree = $treeio->next_tree;
 
284
 
 
285
@nodeids = ("'Allium drummondii, USA'", "'Allium drummondii, Russia'",'A.cyaneum');
 
286
 
 
287
ok($tree);
 
288
for my $node ($tree->get_leaf_nodes) {
 
289
        is($node->id, shift @nodeids);          
 
290
}
 
291
 
 
292
# bug #2221
 
293
# process tree with names containing quoted commas on one line
 
294
 
 
295
$tree = $treeio->next_tree;
 
296
 
 
297
@nodeids = ("'Allium drummondii, Russia'", "'Allium drummondii, USA'",'A.cyaneum');
 
298
 
 
299
ok($tree);
 
300
for my $node ($tree->get_leaf_nodes) {
 
301
        is($node->id, shift @nodeids);          
 
302
}
 
303
 
 
304
__DATA__
 
305
(((A:1,B:1):1,(C:1,D:1):1):1,((E:1,F:1):1,(G:1,H:1):1):1);