t/Tree/TreeIO.t

   1 # -*-Perl-*- Test Harness script for Bioperl
   2 # $Id$
   3
   4 use strict;
   5
   6 BEGIN {
   7     use Bio::Root::Test;
   8
   9     test_begin(-tests => 76);
  10
  11     use_ok('Bio::TreeIO');
  12 }
  13
  14 my $verbose = test_debug();
  15
  16 ok my $treeio = Bio::TreeIO->new(-verbose => $verbose,
  17                  -format => 'newick',
  18                  -file   => test_input_file('cysprot1b.newick'));
  19
  20 my $tree = $treeio->next_tree;
  21 isa_ok($tree, 'Bio::Tree::TreeI');
  22
  23 my @nodes = $tree->get_nodes;
  24 is(@nodes, 6);
  25 my ($rat) = $tree->find_node('CATL_RAT');
  26 ok($rat);
  27 is($rat->branch_length, '0.12788');
  28 # move the id to the bootstap
  29 is($rat->ancestor->bootstrap($rat->ancestor->id), '95');
  30 $rat->ancestor->id('');
  31 # maybe this can be auto-detected, but then can't distinguish
  32 # between internal node labels and bootstraps...
  33 is($rat->ancestor->bootstrap, '95');
  34 is($rat->ancestor->branch_length, '0.18794');
  35 is($rat->ancestor->id, '');
  36
  37 if ($verbose) {
  38     foreach my $node ( $tree->get_root_node()->each_Descendent() ) {
  39         print "node: ", $node->to_string(), "\n";
  40         my @ch = $node->each_Descendent();
  41         if( @ch ) {
  42             print "\tchildren are: \n";
  43             foreach my $node ( $node->each_Descendent() ) {
  44                 print "\t\t ", $node->to_string(), "\n";
  45             }
  46         }
  47     }
  48 }
  49
  50 my $FILE1 = test_output_file();
  51 $treeio = Bio::TreeIO->new(-verbose => $verbose,
  52               -format => 'newick',
  53               -file   => ">$FILE1");
  54 $treeio->write_tree($tree);
  55 undef $treeio;
  56 ok( -s $FILE1 );
  57 $treeio = Bio::TreeIO->new(-verbose => $verbose,
  58               -format => 'newick',
  59               -file   => test_input_file('LOAD_Ccd1.dnd'));
  60 ok($treeio);
  61 $tree = $treeio->next_tree;
  62
  63 isa_ok($tree,'Bio::Tree::TreeI');
  64
  65 @nodes = $tree->get_nodes;
  66 is(@nodes, 52);
  67
  68 if( $verbose ) {
  69     foreach my $node ( @nodes ) {
  70         print "node: ", $node->to_string(), "\n";
  71         my @ch = $node->each_Descendent();
  72         if( @ch ) {
  73             print "\tchildren are: \n";
  74             foreach my $node ( $node->each_Descendent() ) {
  75                 print "\t\t ", $node->to_string(), "\n";
  76             }
  77         }
  78     }
  79 }
  80
  81 is($tree->total_branch_length, 7.12148);
  82 my $FILE2 = test_output_file();
  83 $treeio = Bio::TreeIO->new(-verbose => $verbose,
  84               -format => 'newick',
  85               -file   => ">$FILE2");
  86 $treeio->write_tree($tree);
  87 undef $treeio;
  88 ok(-s $FILE2);
  89 $treeio = Bio::TreeIO->new(-verbose => $verbose,
  90               -format  => 'newick',
  91               -file    => test_input_file('hs_fugu.newick'));
  92 $tree = $treeio->next_tree();
  93 @nodes = $tree->get_nodes();
  94 is(@nodes, 5);
  95 # no relable order for the bottom nodes because they have no branchlen
  96 my @vals = qw(SINFRUP0000006110);
  97 my $saw = 0;
  98 foreach my $node ( $tree->get_root_node()->each_Descendent() ) {
  99     foreach my $v ( @vals ) {
 100        if( defined $node->id &&
 101            $node->id eq $v ){ $saw = 1; last; }
 102     }
 103     last if $saw;
 104 }
 105 is($saw, 1, "Saw $vals[0] as expected");
 106 if( $verbose ) {
 107     foreach my $node ( @nodes ) {
 108         print "\t", $node->id, "\n" if $node->id;
 109     }
 110 }
 111
 112 $treeio = Bio::TreeIO->new(-format => 'newick',
 113                                   -fh => \*DATA);
 114 my $treeout = Bio::TreeIO->new(-format => 'tabtree');
 115 my $treeout2 = Bio::TreeIO->new(-format => 'newick');
 116
 117 $tree = $treeio->next_tree;
 118
 119 if( $verbose > 0  ) {
 120     $treeout->write_tree($tree);
 121     $treeout2->write_tree($tree);
 122 }
 123
 124 $treeio = Bio::TreeIO->new(-verbose => $verbose,
 125               -file   => test_input_file('test.nhx'));
 126
 127
 128 ok($treeio);
 129 $tree = $treeio->next_tree;
 130
 131 isa_ok($tree, 'Bio::Tree::TreeI');
 132
 133 @nodes = $tree->get_nodes;
 134 is(@nodes, 12, "Total Nodes");
 135
 136 my $adhy = $tree->find_node('ADHY');
 137 is($adhy->branch_length, 0.1);
 138 is(($adhy->get_tag_values('S'))[0], 'nematode');
 139 is(($adhy->get_tag_values('E'))[0], '1.1.1.1');
 140
 141 # try lintree parsing
 142 $treeio = Bio::TreeIO->new(-format => 'lintree',
 143                   -file   => test_input_file('crab.njb'));
 144
 145 my (@leaves, $node);
 146 while( $tree = $treeio->next_tree ) {
 147
 148     isa_ok($tree, 'Bio::Tree::TreeI');
 149
 150     @nodes = $tree->get_nodes;
 151
 152     @leaves = $tree->get_leaf_nodes;
 153     is(@leaves, 13);
 154 #/maj   is(@nodes, 25);
 155     is(@nodes, 24); # this is clear from the datafile and counting \maj
 156     ($node) = $tree->find_node(-id => '18');
 157     ok($node);
 158     is($node->id, '18');
 159     is($node->branch_length, '0.030579');
 160     is($node->bootstrap, 998);
 161 }
 162
 163 $treeio = Bio::TreeIO->new(-format => 'lintree',
 164                -file   => test_input_file('crab.nj'));
 165
 166 $tree = $treeio->next_tree;
 167
 168 isa_ok($tree, 'Bio::Tree::TreeI');
 169
 170 @nodes = $tree->get_nodes;
 171 @leaves = $tree->get_leaf_nodes;
 172 is(@leaves, 13);
 173 #/maj is(@nodes, 25);
 174 is(@nodes, 24); #/maj
 175 ($node) = $tree->find_node('18');
 176 is($node->id, '18');
 177 is($node->branch_length, '0.028117');
 178
 179 ($node) = $tree->find_node(-id => 'C-vittat');
 180 is($node->id, 'C-vittat');
 181 is($node->branch_length, '0.087619');
 182 is($node->ancestor->id, '14');
 183
 184 $treeio = Bio::TreeIO->new(-format => 'lintree',
 185               -file   => test_input_file('crab.dat.cn'));
 186
 187 $tree = $treeio->next_tree;
 188
 189 isa_ok($tree, 'Bio::Tree::TreeI');
 190
 191 @nodes = $tree->get_nodes;
 192 @leaves = $tree->get_leaf_nodes;
 193 is(@leaves, 13, "Leaf nodes");
 194
 195 #/maj is(@nodes, 25, "All nodes");
 196 is(@nodes, 24, "All nodes");
 197 ($node) = $tree->find_node('18');
 198 is($node->id, '18');
 199
 200 is($node->branch_length, '0.029044');
 201
 202 ($node) = $tree->find_node(-id => 'C-vittat');
 203 is($node->id, 'C-vittat');
 204 is($node->branch_length, '0.097855');
 205 is($node->ancestor->id, '14');
 206
 207 SKIP: {
 208     test_skip(-tests => 8, -requires_module => 'IO::String');
 209
 210     # test nexus tree parsing
 211     $treeio = Bio::TreeIO->new(-format => 'nexus',
 212                                -verbose => $verbose,
 213                    -file   => test_input_file('urease.tre.nexus'));
 214
 215     $tree = $treeio->next_tree;
 216     ok($tree);
 217     is($tree->id, 'PAUP_1');
 218     is($tree->get_leaf_nodes, 6);
 219     ($node) = $tree->find_node(-id => 'Spombe');
 220     is($node->branch_length,0.221404);
 221
 222     # test nexus MrBayes tree parsing
 223     $treeio = Bio::TreeIO->new(-format => 'nexus',
 224                    -file   => test_input_file('adh.mb_tree.nexus'));
 225
 226     $tree = $treeio->next_tree;
 227     my $ct = 1;
 228     ok($tree);
 229     is($tree->id, 'rep.1');
 230     is($tree->get_leaf_nodes, 54);
 231     ($node) = $tree->find_node(-id => 'd.madeirensis');
 232     is($node->branch_length,0.039223);
 233     while ($tree = $treeio->next_tree) {
 234         $ct++;
 235     }
 236     is($ct,13,'bug 2356');
 237 }
 238
 239 # bug #1854
 240 # process no-newlined tree
 241 $treeio = Bio::TreeIO->new(-format => 'nexus',
 242                            -verbose => $verbose,
 243                -file   => test_input_file('tree_nonewline.nexus'));
 244
 245 $tree = $treeio->next_tree;
 246 ok($tree);
 247 ok($tree->find_node('TRXHomo'));
 248
 249
 250 # parse trees with scores
 251
 252 $treeio = Bio::TreeIO->new(-format => 'newick',
 253                -file   => test_input_file('puzzle.tre'));
 254 $tree = $treeio->next_tree;
 255 ok($tree);
 256 is($tree->score, '-2673.059726');
 257
 258 # bug #2205
 259 # process trees with node IDs containing spaces
 260 $treeio = Bio::TreeIO->new(-format => 'nexus',
 261                            -verbose => $verbose,
 262                -file   => test_input_file('spaces.nex'));
 263
 264 $tree = $treeio->next_tree;
 265
 266 my @nodeids = ("'Allium drummondii'", "'Allium cernuum'",'A.cyaneum');
 267
 268 ok($tree);
 269 for my $node ($tree->get_leaf_nodes) {
 270     is($node->id, shift @nodeids);
 271 }
 272
 273 # bug #2221
 274 # process tree with names containing quoted commas
 275
 276 $tree = $treeio->next_tree;
 277
 278 @nodeids = ("'Allium drummondii, USA'", "'Allium drummondii, Russia'",'A.cyaneum');
 279
 280 ok($tree);
 281 for my $node ($tree->get_leaf_nodes) {
 282     is($node->id, shift @nodeids);
 283 }
 284
 285 # bug #2221
 286 # process tree with names containing quoted commas on one line
 287
 288 $tree = $treeio->next_tree;
 289
 290 @nodeids = ("'Allium drummondii, Russia'", "'Allium drummondii, USA'",'A.cyaneum');
 291
 292 ok($tree);
 293 for my $node ($tree->get_leaf_nodes) {
 294     is($node->id, shift @nodeids);
 295 }
 296
 297 # bug #2869
 298 #
 299
 300 # proper way (Tree isn't GC'd)
 301 $tree = Bio::TreeIO->new(-format => 'newick',
 302                -verbose => $verbose,
 303                -file   => test_input_file('bug2869.tree'))->next_tree;
 304
 305 my $root = $tree->get_root_node;
 306
 307 isa_ok($root, 'Bio::Tree::NodeI');
 308
 309 my $total1 = 0;
 310 for my $child ($root->get_Descendents) {
 311     $total1++;
 312 }
 313
 314 is($total1, 198);
 315
 316 undef $tree; # GC
 317
 318 $root = Bio::TreeIO->new(-format => 'newick',
 319                -verbose => $verbose,
 320                -file   => test_input_file('bug2869.tree'),
 321                -no_cleanup => 1)->next_tree->get_root_node;
 322
 323 isa_ok($root, 'Bio::Tree::NodeI');
 324
 325 TODO: {
 326     local $TODO = 'The nodes are garbage-collected away b/c Tree isn\'t retained in memory';
 327     my $total2 = 0;
 328     for my $child ($root->get_Descendents) {
 329         $total2++;
 330     }
 331
 332     is($total2, $total1);
 333 }
 334
 335 __DATA__
 336 (((A:1,B:1):1,(C:1,D:1):1):1,((E:1,F:1):1,(G:1,H:1):1):1);