t/Tree/TreeIO/newick.t

   1 # -*-Perl-*- Test Harness script for Bioperl
   2 # $Id: TreeIO.t 14580 2008-03-01 17:01:30Z cjfields $
   3
   4 use strict;
   5
   6 BEGIN {
   7   use lib '.';
   8   use Bio::Root::Test;
   9
  10   test_begin(-tests => 49);
  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 # parse trees with scores
 114
 115 $treeio = Bio::TreeIO->new(-format => 'newick',
 116                            -file   => test_input_file('puzzle.tre'));
 117 $tree = $treeio->next_tree;
 118 ok($tree);
 119 is($tree->score, '-2673.059726');
 120
 121
 122 # no semi-colon
 123
 124 $treeio = Bio::TreeIO->new(-format => 'newick',
 125                            -file=> test_input_file('semicolon.newick'));
 126 $tree = $treeio->next_tree;
 127 ok($tree);
 128 is($tree->get_nodes, 15);
 129
 130 $treeio = Bio::TreeIO->new(-format => 'newick',
 131                            -file=> test_input_file('no_semicolon.newick'));
 132 $tree = $treeio->next_tree;
 133 ok($tree);
 134 is($tree->get_nodes, 15);
 135
 136
 137 test_roundtrip('((a,b),c);','Round trip: simple newick');
 138 test_roundtrip('(a:1,b:2,c:3,d:4)TEST:1.2345;','Round trip: Root node branch length');
 139 test_roundtrip('(a:1,b:2,c:3,d:4):1.2345;','Round trip: Root node branch length');
 140 test_roundtrip('(A:0.1,B:0.2,(C:0.3,D:0.4)E:0.5)F;','Round trip: from Wikipedia');
 141 test_roundtrip('(a:1,b:2):0.0;','Branch length on root');
 142 test_roundtrip('(a:1,b:2):0.001;','Tiny branch length on root');
 143 test_roundtrip('(a:0,b:00):0.0;','Zero branch lenghts');
 144
 145 # From Wikipedia:
 146 test_roundtrip('(,,(,));','wkp blank tree');
 147 test_roundtrip('(A,B,(C,D));','wkp only leaves labeled');
 148 test_roundtrip('(A,B,(C,D)E)F;','wkp all nodes labeled');
 149 test_roundtrip('(:0.1,:0.2,(:0.3,:0.4):0.5);','wkp branch lengths, no labels');
 150 test_roundtrip('(:0.1,:0.2,(:0.3,:0.4):0.5):0.0;','wkp branch lengths, including root');
 151 test_roundtrip('(A:0.1,B:0.2,(C:0.3,D:0.4):0.5);','wkp distances and leaf names');
 152 test_roundtrip('(A:0.1,B:0.2,(C:0.3,D:0.4)E:0.5)F;','wkp distances and all names');
 153 test_roundtrip('((B:0.2,(C:0.3,D:0.4)E:0.5)F:0.1)A;','wkp rooted on leaf node');
 154
 155 # From the PHYLIP site:
 156 test_roundtrip('(B,(A,C,E),D);','phylip simple tree');
 157 test_roundtrip('(,(,,),);','phylip no labels');
 158 test_roundtrip('(B:6.0,(A:5.0,C:3.0,E:4.0):5.0,D:11.0);','phylip w/ branch lengths');
 159 test_roundtrip('(B:6.0,(A:5.0,C:3.0,E:4.0)Ancestor1:5.0,D:11.0);','phylip w/ internal label');
 160 test_roundtrip('((raccoon:19.19959,bear:6.80041):0.84600,((sea_lion:11.99700,seal:12.00300):7.52973,((monkey:100.85930,cat:47.14069):20.59201,weasel:18.87953):2.09460):3.87382,dog:25.46154);','phylip raccoon tree');
 161 test_roundtrip('(Bovine:0.69395,(Gibbon:0.36079,(Orang:0.33636,(Gorilla:0.17147,(Chimp:0.19268,Human:0.11927):0.08386):0.06124):0.15057):0.54939,Mouse:1.21460):0.10;','phylip mammal tree');
 162 test_roundtrip('(Bovine:0.69395,(Hylobates:0.36079,(Pongo:0.33636,(G._Gorilla:0.17147,(P._paniscus:0.19268,H._sapiens:0.11927):0.08386):0.06124):0.15057):0.54939,Rodent:1.21460);','phylip mammal tree w/ underbars');
 163 test_roundtrip('A;','phylip single node');
 164 test_roundtrip('((A,B),(C,D));','phylip_quartet');
 165 test_roundtrip('(Alpha,Beta,Gamma,Delta,,Epsilon,,,);','phylip greek');
 166
 167 sub test_roundtrip {
 168   my $string = shift;
 169   my $desc = shift;
 170
 171   my $in = Bio::TreeIO->new(-format => 'newick',
 172                             -string => $string,
 173                             -verbose => $verbose
 174                             );
 175   my $out = '';
 176   eval {
 177     my $t = $in->next_tree;
 178     $out = $t->as_text('newick');
 179   };
 180   return is($out,$string,$desc);
 181 }
 182
 183 sub read_file {
 184   my $file = shift;
 185   open(IN,"<$file");
 186   my (@lines) = <IN>;
 187   @lines = map {$_ =~ s/\\n//g} @lines;
 188   return join("",@lines);
 189 }