Move HMMER related modules, tests, and programs to new distribution.
[bioperl-live.git] / t / Tree / TreeIO / newick.t
blob0d3dcd9615ec876aae6c56f2f7b6373d7e05752b
1 # -*-Perl-*- Test Harness script for Bioperl
2 # $Id: TreeIO.t 14580 2008-03-01 17:01:30Z cjfields $
4 use strict;
6 BEGIN {
7   use lib '.';
8   use Bio::Root::Test;
9     
10   test_begin(-tests => 51);
12   use_ok('Bio::TreeIO');
15 my $verbose = test_debug();
17 ok my $treeio = Bio::TreeIO->new(-verbose => $verbose,
18                                  -format => 'newick',
19                                  -file => test_input_file('cysprot1b.newick'));
21 my $tree = $treeio->next_tree;
22 isa_ok($tree, 'Bio::Tree::TreeI');
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, '');
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         }
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;
64 isa_ok($tree,'Bio::Tree::TreeI');
66 @nodes = $tree->get_nodes;
67 is(@nodes, 52);
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         }
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;
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         }
113 # parse trees with scores
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');
122 # no semi-colon
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);
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);
136 # initial AMPHORA2 tests
137 $treeio = Bio::TreeIO->new(-format => 'newick',
138                            -file=> test_input_file('amphora.newick'));
139 $tree = $treeio->next_tree;
140 ok($tree);
141 is($tree->get_nodes, 5);
143 test_roundtrip('((a,b),c);','Round trip: simple newick');
144 test_roundtrip('(a:1,b:2,c:3,d:4)TEST:1.2345;','Round trip: Root node branch length');
145 test_roundtrip('(a:1,b:2,c:3,d:4):1.2345;','Round trip: Root node branch length');
146 test_roundtrip('(A:0.1,B:0.2,(C:0.3,D:0.4)E:0.5)F;','Round trip: from Wikipedia');
147 test_roundtrip('(a:1,b:2):0.0;','Branch length on root');
148 test_roundtrip('(a:1,b:2):0.001;','Tiny branch length on root');
149 test_roundtrip('(a:0,b:00):0.0;','Zero branch lenghts');
151 # From Wikipedia:
152 test_roundtrip('(,,(,));','wkp blank tree');
153 test_roundtrip('(A,B,(C,D));','wkp only leaves labeled');
154 test_roundtrip('(A,B,(C,D)E)F;','wkp all nodes labeled');
155 test_roundtrip('(:0.1,:0.2,(:0.3,:0.4):0.5);','wkp branch lengths, no labels');
156 test_roundtrip('(:0.1,:0.2,(:0.3,:0.4):0.5):0.0;','wkp branch lengths, including root');
157 test_roundtrip('(A:0.1,B:0.2,(C:0.3,D:0.4):0.5);','wkp distances and leaf names');
158 test_roundtrip('(A:0.1,B:0.2,(C:0.3,D:0.4)E:0.5)F;','wkp distances and all names');
159 test_roundtrip('((B:0.2,(C:0.3,D:0.4)E:0.5)F:0.1)A;','wkp rooted on leaf node');
161 # From the PHYLIP site:
162 test_roundtrip('(B,(A,C,E),D);','phylip simple tree');
163 test_roundtrip('(,(,,),);','phylip no labels');
164 test_roundtrip('(B:6.0,(A:5.0,C:3.0,E:4.0):5.0,D:11.0);','phylip w/ branch lengths');
165 test_roundtrip('(B:6.0,(A:5.0,C:3.0,E:4.0)Ancestor1:5.0,D:11.0);','phylip w/ internal label');
166 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');
167 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');
168 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');
169 test_roundtrip('A;','phylip single node');
170 test_roundtrip('((A,B),(C,D));','phylip_quartet');
171 test_roundtrip('(Alpha,Beta,Gamma,Delta,,Epsilon,,,);','phylip greek');
173 sub test_roundtrip {
174   my $string = shift;
175   my $desc = shift;
177   my $in = Bio::TreeIO->new(-format => 'newick',
178                             -string => $string,
179                             -verbose => $verbose
180                             );
181   my $out = '';
182   eval {
183     my $t = $in->next_tree;
184     $out = $t->as_text('newick');
185   };
186   return is($out,$string,$desc);
189 sub read_file {
190   my $file = shift;
191   open my $IN, '<', $file or die "Could not read file '$file': $!\n";
192   my (@lines) = <$IN>;
193   close $IN;
195   @lines = map {$_ =~ s/\\n//g} @lines;
196   return join("",@lines);