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 => 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 #/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 __DATA__
 308 (((A:1,B:1):1,(C:1,D:1):1):1,((E:1,F:1):1,(G:1,H:1):1):1);