t/Tree/TreeIO.t

   1 # -*-Perl-*- Test Harness script for Bioperl
   2 # $Id$
   3
   4 use strict;
   5
   6 BEGIN {
   7     use lib '.';
   8     use Bio::Root::Test;
   9
  10     test_begin(-tests => 78);
  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, 12, "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 #/maj   is(@nodes, 25);
 165     is(@nodes, 24); # this is clear from the datafile and counting \maj
 166     ($node) = $tree->find_node(-id => '18');
 167     ok($node);
 168     is($node->id, '18');
 169     is($node->branch_length, '0.030579');
 170     is($node->bootstrap, 998);
 171 }
 172
 173 $treeio = Bio::TreeIO->new(-format => 'lintree',
 174                -file   => test_input_file('crab.nj'));
 175
 176 $tree = $treeio->next_tree;
 177
 178 isa_ok($tree, 'Bio::Tree::TreeI');
 179
 180 @nodes = $tree->get_nodes;
 181 @leaves = $tree->get_leaf_nodes;
 182 is(@leaves, 13);
 183 #/maj is(@nodes, 25);
 184 is(@nodes, 24); #/maj
 185 ($node) = $tree->find_node('18');
 186 is($node->id, '18');
 187 is($node->branch_length, '0.028117');
 188
 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');
 193
 194 $treeio = Bio::TreeIO->new(-format => 'lintree',
 195               -file   => test_input_file('crab.dat.cn'));
 196
 197 $tree = $treeio->next_tree;
 198
 199 isa_ok($tree, 'Bio::Tree::TreeI');
 200
 201 @nodes = $tree->get_nodes;
 202 @leaves = $tree->get_leaf_nodes;
 203 is(@leaves, 13, "Leaf nodes");
 204
 205 #/maj is(@nodes, 25, "All nodes");
 206 is(@nodes, 24, "All nodes");
 207 ($node) = $tree->find_node('18');
 208 is($node->id, '18');
 209
 210 is($node->branch_length, '0.029044');
 211
 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');
 216
 217 SKIP: {
 218     test_skip(-tests => 8, -requires_module => 'IO::String');
 219
 220     # test nexus tree parsing
 221     $treeio = Bio::TreeIO->new(-format => 'nexus',
 222                                -verbose => $verbose,
 223                    -file   => test_input_file('urease.tre.nexus'));
 224
 225     $tree = $treeio->next_tree;
 226     ok($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);
 231
 232     # test nexus MrBayes tree parsing
 233     $treeio = Bio::TreeIO->new(-format => 'nexus',
 234                    -file   => test_input_file('adh.mb_tree.nexus'));
 235
 236     $tree = $treeio->next_tree;
 237     my $ct = 1;
 238     ok($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) {
 244         $ct++;
 245     }
 246     is($ct,13,'bug 2356');
 247 }
 248
 249 # bug #1854
 250 # process no-newlined tree
 251 $treeio = Bio::TreeIO->new(-format => 'nexus',
 252                            -verbose => $verbose,
 253                -file   => test_input_file('tree_nonewline.nexus'));
 254
 255 $tree = $treeio->next_tree;
 256 ok($tree);
 257 ok($tree->find_node('TRXHomo'));
 258
 259
 260 # parse trees with scores
 261
 262 $treeio = Bio::TreeIO->new(-format => 'newick',
 263                -file   => test_input_file('puzzle.tre'));
 264 $tree = $treeio->next_tree;
 265 ok($tree);
 266 is($tree->score, '-2673.059726');
 267
 268 # bug #2205
 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'));
 273
 274 $tree = $treeio->next_tree;
 275
 276 my @nodeids = ("'Allium drummondii'", "'Allium cernuum'",'A.cyaneum');
 277
 278 ok($tree);
 279 for my $node ($tree->get_leaf_nodes) {
 280     is($node->id, shift @nodeids);
 281 }
 282
 283 # bug #2221
 284 # process tree with names containing quoted commas
 285
 286 $tree = $treeio->next_tree;
 287
 288 @nodeids = ("'Allium drummondii, USA'", "'Allium drummondii, Russia'",'A.cyaneum');
 289
 290 ok($tree);
 291 for my $node ($tree->get_leaf_nodes) {
 292     is($node->id, shift @nodeids);
 293 }
 294
 295 # bug #2221
 296 # process tree with names containing quoted commas on one line
 297
 298 $tree = $treeio->next_tree;
 299
 300 @nodeids = ("'Allium drummondii, Russia'", "'Allium drummondii, USA'",'A.cyaneum');
 301
 302 ok($tree);
 303 for my $node ($tree->get_leaf_nodes) {
 304     is($node->id, shift @nodeids);
 305 }
 306
 307 # bug #2869
 308 #
 309
 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;
 314
 315 my $root = $tree->get_root_node;
 316
 317 isa_ok($root, 'Bio::Tree::NodeI');
 318
 319 my $total1 = 0;
 320 for my $child ($root->get_Descendents) {
 321     $total1++;
 322 }
 323
 324 is($total1, 198);
 325
 326 undef $tree; # GC
 327
 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;
 332
 333 isa_ok($root, 'Bio::Tree::NodeI');
 334
 335 TODO: {
 336     local $TODO = 'The nodes are garbage-collected away b/c Tree isn\'t retained in memory';
 337     my $total2 = 0;
 338     for my $child ($root->get_Descendents) {
 339         $total2++;
 340     }
 341
 342     is($total2, $total1);
 343 }
 344
 345 __DATA__
 346 (((A:1,B:1):1,(C:1,D:1):1):1,((E:1,F:1):1,(G:1,H:1):1):1);