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 => 76);
  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
 129 ok($treeio);
 130 $tree = $treeio->next_tree;
 131
 132 isa_ok($tree, 'Bio::Tree::TreeI');
 133
 134 @nodes = $tree->get_nodes;
 135 is(@nodes, 12, "Total Nodes");
 136
 137 my $adhy = $tree->find_node('ADHY');
 138 is($adhy->branch_length, 0.1);
 139 is(($adhy->get_tag_values('S'))[0], 'nematode');
 140 is(($adhy->get_tag_values('E'))[0], '1.1.1.1');
 141
 142 # try lintree parsing
 143 $treeio = Bio::TreeIO->new(-format => 'lintree',
 144                   -file   => test_input_file('crab.njb'));
 145
 146 my (@leaves, $node);
 147 while( $tree = $treeio->next_tree ) {
 148
 149     isa_ok($tree, 'Bio::Tree::TreeI');
 150
 151     @nodes = $tree->get_nodes;
 152
 153     @leaves = $tree->get_leaf_nodes;
 154     is(@leaves, 13);
 155 #/maj   is(@nodes, 25);
 156     is(@nodes, 24); # this is clear from the datafile and counting \maj
 157     ($node) = $tree->find_node(-id => '18');
 158     ok($node);
 159     is($node->id, '18');
 160     is($node->branch_length, '0.030579');
 161     is($node->bootstrap, 998);
 162 }
 163
 164 $treeio = Bio::TreeIO->new(-format => 'lintree',
 165                -file   => test_input_file('crab.nj'));
 166
 167 $tree = $treeio->next_tree;
 168
 169 isa_ok($tree, 'Bio::Tree::TreeI');
 170
 171 @nodes = $tree->get_nodes;
 172 @leaves = $tree->get_leaf_nodes;
 173 is(@leaves, 13);
 174 #/maj is(@nodes, 25);
 175 is(@nodes, 24); #/maj
 176 ($node) = $tree->find_node('18');
 177 is($node->id, '18');
 178 is($node->branch_length, '0.028117');
 179
 180 ($node) = $tree->find_node(-id => 'C-vittat');
 181 is($node->id, 'C-vittat');
 182 is($node->branch_length, '0.087619');
 183 is($node->ancestor->id, '14');
 184
 185 $treeio = Bio::TreeIO->new(-format => 'lintree',
 186               -file   => test_input_file('crab.dat.cn'));
 187
 188 $tree = $treeio->next_tree;
 189
 190 isa_ok($tree, 'Bio::Tree::TreeI');
 191
 192 @nodes = $tree->get_nodes;
 193 @leaves = $tree->get_leaf_nodes;
 194 is(@leaves, 13, "Leaf nodes");
 195
 196 #/maj is(@nodes, 25, "All nodes");
 197 is(@nodes, 24, "All nodes");
 198 ($node) = $tree->find_node('18');
 199 is($node->id, '18');
 200
 201 is($node->branch_length, '0.029044');
 202
 203 ($node) = $tree->find_node(-id => 'C-vittat');
 204 is($node->id, 'C-vittat');
 205 is($node->branch_length, '0.097855');
 206 is($node->ancestor->id, '14');
 207
 208 SKIP: {
 209     test_skip(-tests => 8, -requires_module => 'IO::String');
 210
 211     # test nexus tree parsing
 212     $treeio = Bio::TreeIO->new(-format => 'nexus',
 213                                -verbose => $verbose,
 214                    -file   => test_input_file('urease.tre.nexus'));
 215
 216     $tree = $treeio->next_tree;
 217     ok($tree);
 218     is($tree->id, 'PAUP_1');
 219     is($tree->get_leaf_nodes, 6);
 220     ($node) = $tree->find_node(-id => 'Spombe');
 221     is($node->branch_length,0.221404);
 222
 223     # test nexus MrBayes tree parsing
 224     $treeio = Bio::TreeIO->new(-format => 'nexus',
 225                    -file   => test_input_file('adh.mb_tree.nexus'));
 226
 227     $tree = $treeio->next_tree;
 228     my $ct = 1;
 229     ok($tree);
 230     is($tree->id, 'rep.1');
 231     is($tree->get_leaf_nodes, 54);
 232     ($node) = $tree->find_node(-id => 'd.madeirensis');
 233     is($node->branch_length,0.039223);
 234     while ($tree = $treeio->next_tree) {
 235         $ct++;
 236     }
 237     is($ct,13,'bug 2356');
 238 }
 239
 240 # bug #1854
 241 # process no-newlined tree
 242 $treeio = Bio::TreeIO->new(-format => 'nexus',
 243                            -verbose => $verbose,
 244                -file   => test_input_file('tree_nonewline.nexus'));
 245
 246 $tree = $treeio->next_tree;
 247 ok($tree);
 248 ok($tree->find_node('TRXHomo'));
 249
 250
 251 # parse trees with scores
 252
 253 $treeio = Bio::TreeIO->new(-format => 'newick',
 254                -file   => test_input_file('puzzle.tre'));
 255 $tree = $treeio->next_tree;
 256 ok($tree);
 257 is($tree->score, '-2673.059726');
 258
 259 # bug #2205
 260 # process trees with node IDs containing spaces
 261 $treeio = Bio::TreeIO->new(-format => 'nexus',
 262                            -verbose => $verbose,
 263                -file   => test_input_file('spaces.nex'));
 264
 265 $tree = $treeio->next_tree;
 266
 267 my @nodeids = ("'Allium drummondii'", "'Allium cernuum'",'A.cyaneum');
 268
 269 ok($tree);
 270 for my $node ($tree->get_leaf_nodes) {
 271     is($node->id, shift @nodeids);
 272 }
 273
 274 # bug #2221
 275 # process tree with names containing quoted commas
 276
 277 $tree = $treeio->next_tree;
 278
 279 @nodeids = ("'Allium drummondii, USA'", "'Allium drummondii, Russia'",'A.cyaneum');
 280
 281 ok($tree);
 282 for my $node ($tree->get_leaf_nodes) {
 283     is($node->id, shift @nodeids);
 284 }
 285
 286 # bug #2221
 287 # process tree with names containing quoted commas on one line
 288
 289 $tree = $treeio->next_tree;
 290
 291 @nodeids = ("'Allium drummondii, Russia'", "'Allium drummondii, USA'",'A.cyaneum');
 292
 293 ok($tree);
 294 for my $node ($tree->get_leaf_nodes) {
 295     is($node->id, shift @nodeids);
 296 }
 297
 298 # bug #2869
 299 #
 300
 301 # proper way (Tree isn't GC'd)
 302 $tree = Bio::TreeIO->new(-format => 'newick',
 303                -verbose => $verbose,
 304                -file   => test_input_file('bug2869.tree'))->next_tree;
 305
 306 my $root = $tree->get_root_node;
 307
 308 isa_ok($root, 'Bio::Tree::NodeI');
 309
 310 my $total1 = 0;
 311 for my $child ($root->get_Descendents) {
 312     $total1++;
 313 }
 314
 315 is($total1, 198);
 316
 317 undef $tree; # GC
 318
 319 $root = Bio::TreeIO->new(-format => 'newick',
 320                -verbose => $verbose,
 321                -file   => test_input_file('bug2869.tree'),
 322                -no_cleanup => 1)->next_tree->get_root_node;
 323
 324 isa_ok($root, 'Bio::Tree::NodeI');
 325
 326 TODO: {
 327     local $TODO = 'The nodes are garbage-collected away b/c Tree isn\'t retained in memory';
 328     my $total2 = 0;
 329     for my $child ($root->get_Descendents) {
 330         $total2++;
 331     }
 332
 333     is($total2, $total1);
 334 }
 335
 336 __DATA__
 337 (((A:1,B:1):1,(C:1,D:1):1):1,((E:1,F:1):1,(G:1,H:1):1):1);