# -*-Perl-*- Test Harness script for Bioperl
# $Id: TreeIO.t 14580 2008-03-01 17:01:30Z cjfields $
use strict;
BEGIN {
use lib '.';
use Bio::Root::Test;
test_begin(-tests => 49);
use_ok('Bio::TreeIO');
}
my $verbose = test_debug();
ok my $treeio = Bio::TreeIO->new(-verbose => $verbose,
-format => 'newick',
-file => test_input_file('cysprot1b.newick'));
my $tree = $treeio->next_tree;
isa_ok($tree, 'Bio::Tree::TreeI');
my @nodes = $tree->get_nodes;
is(@nodes, 6);
my ($rat) = $tree->find_node('CATL_RAT');
ok($rat);
is($rat->branch_length, '0.12788');
# move the id to the bootstap
is($rat->ancestor->bootstrap($rat->ancestor->id), '95');
$rat->ancestor->id('');
# maybe this can be auto-detected, but then can't distinguish
# between internal node labels and bootstraps...
is($rat->ancestor->bootstrap, '95');
is($rat->ancestor->branch_length, '0.18794');
is($rat->ancestor->id, '');
if ($verbose) {
foreach my $node ( $tree->get_root_node()->each_Descendent() ) {
print "node: ", $node->to_string(), "\n";
my @ch = $node->each_Descendent();
if( @ch ) {
print "\tchildren are: \n";
foreach my $node ( $node->each_Descendent() ) {
print "\t\t ", $node->to_string(), "\n";
}
}
}
}
my $FILE1 = test_output_file();
$treeio = Bio::TreeIO->new(-verbose => $verbose,
-format => 'newick',
-file => ">$FILE1");
$treeio->write_tree($tree);
undef $treeio;
ok( -s $FILE1 );
$treeio = Bio::TreeIO->new(-verbose => $verbose,
-format => 'newick',
-file => test_input_file('LOAD_Ccd1.dnd'));
ok($treeio);
$tree = $treeio->next_tree;
isa_ok($tree,'Bio::Tree::TreeI');
@nodes = $tree->get_nodes;
is(@nodes, 52);
if( $verbose ) {
foreach my $node ( @nodes ) {
print "node: ", $node->to_string(), "\n";
my @ch = $node->each_Descendent();
if( @ch ) {
print "\tchildren are: \n";
foreach my $node ( $node->each_Descendent() ) {
print "\t\t ", $node->to_string(), "\n";
}
}
}
}
is($tree->total_branch_length, 7.12148);
my $FILE2 = test_output_file();
$treeio = Bio::TreeIO->new(-verbose => $verbose,
-format => 'newick',
-file => ">$FILE2");
$treeio->write_tree($tree);
undef $treeio;
ok(-s $FILE2);
$treeio = Bio::TreeIO->new(-verbose => $verbose,
-format => 'newick',
-file => test_input_file('hs_fugu.newick'));
$tree = $treeio->next_tree();
@nodes = $tree->get_nodes();
is(@nodes, 5);
# no relable order for the bottom nodes because they have no branchlen
my @vals = qw(SINFRUP0000006110);
my $saw = 0;
foreach my $node ( $tree->get_root_node()->each_Descendent() ) {
foreach my $v ( @vals ) {
if( defined $node->id &&
$node->id eq $v ){ $saw = 1; last; }
}
last if $saw;
}
is($saw, 1, "Saw $vals[0] as expected");
if( $verbose ) {
foreach my $node ( @nodes ) {
print "\t", $node->id, "\n" if $node->id;
}
}
# parse trees with scores
$treeio = Bio::TreeIO->new(-format => 'newick',
-file => test_input_file('puzzle.tre'));
$tree = $treeio->next_tree;
ok($tree);
is($tree->score, '-2673.059726');
# no semi-colon
$treeio = Bio::TreeIO->new(-format => 'newick',
-file=> test_input_file('semicolon.newick'));
$tree = $treeio->next_tree;
ok($tree);
is($tree->get_nodes, 15);
$treeio = Bio::TreeIO->new(-format => 'newick',
-file=> test_input_file('no_semicolon.newick'));
$tree = $treeio->next_tree;
ok($tree);
is($tree->get_nodes, 15);
test_roundtrip('((a,b),c);','Round trip: simple newick');
test_roundtrip('(a:1,b:2,c:3,d:4)TEST:1.2345;','Round trip: Root node branch length');
test_roundtrip('(a:1,b:2,c:3,d:4):1.2345;','Round trip: Root node branch length');
test_roundtrip('(A:0.1,B:0.2,(C:0.3,D:0.4)E:0.5)F;','Round trip: from Wikipedia');
test_roundtrip('(a:1,b:2):0.0;','Branch length on root');
test_roundtrip('(a:1,b:2):0.001;','Tiny branch length on root');
test_roundtrip('(a:0,b:00):0.0;','Zero branch lenghts');
# From Wikipedia:
test_roundtrip('(,,(,));','wkp blank tree');
test_roundtrip('(A,B,(C,D));','wkp only leaves labeled');
test_roundtrip('(A,B,(C,D)E)F;','wkp all nodes labeled');
test_roundtrip('(:0.1,:0.2,(:0.3,:0.4):0.5);','wkp branch lengths, no labels');
test_roundtrip('(:0.1,:0.2,(:0.3,:0.4):0.5):0.0;','wkp branch lengths, including root');
test_roundtrip('(A:0.1,B:0.2,(C:0.3,D:0.4):0.5);','wkp distances and leaf names');
test_roundtrip('(A:0.1,B:0.2,(C:0.3,D:0.4)E:0.5)F;','wkp distances and all names');
test_roundtrip('((B:0.2,(C:0.3,D:0.4)E:0.5)F:0.1)A;','wkp rooted on leaf node');
# From the PHYLIP site:
test_roundtrip('(B,(A,C,E),D);','phylip simple tree');
test_roundtrip('(,(,,),);','phylip no labels');
test_roundtrip('(B:6.0,(A:5.0,C:3.0,E:4.0):5.0,D:11.0);','phylip w/ branch lengths');
test_roundtrip('(B:6.0,(A:5.0,C:3.0,E:4.0)Ancestor1:5.0,D:11.0);','phylip w/ internal label');
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');
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');
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');
test_roundtrip('A;','phylip single node');
test_roundtrip('((A,B),(C,D));','phylip_quartet');
test_roundtrip('(Alpha,Beta,Gamma,Delta,,Epsilon,,,);','phylip greek');
sub test_roundtrip {
my $string = shift;
my $desc = shift;
my $in = Bio::TreeIO->new(-format => 'newick',
-string => $string,
-verbose => $verbose
);
my $out = '';
eval {
my $t = $in->next_tree;
$out = $t->as_text('newick');
};
return is($out,$string,$desc);
}
sub read_file {
my $file = shift;
open(IN,"<$file");
my (@lines) = <IN>;
@lines = map {$_ =~ s/\\n//g} @lines;
return join("",@lines);
}