# -*-Perl-*- Test Harness script for Bioperl # $Id: TreeIO.t 15635 2009-04-14 19:11:13Z cjfields $ use strict; BEGIN { use lib '.'; use Bio::Root::Test; test_begin(-tests => 74); 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; } } $treeio = Bio::TreeIO->new(-format => 'newick', -fh => \*DATA); my $treeout = Bio::TreeIO->new(-format => 'tabtree'); my $treeout2 = Bio::TreeIO->new(-format => 'newick'); $tree = $treeio->next_tree; if( $verbose > 0 ) { $treeout->write_tree($tree); $treeout2->write_tree($tree); } $treeio = Bio::TreeIO->new(-verbose => $verbose, -file => test_input_file('test.nhx')); SKIP: { test_skip(-tests => 2, -requires_module => 'SVG::Graph'); my $FILE3 = test_output_file(); my $treeout3 = Bio::TreeIO->new(-format => 'svggraph', -file => ">$FILE3"); ok($treeout3); eval {$treeout3->write_tree($tree);}; ok (-s $FILE3); } ok($treeio); $tree = $treeio->next_tree; isa_ok($tree, 'Bio::Tree::TreeI'); @nodes = $tree->get_nodes; is(@nodes, 13, "Total Nodes"); my $adhy = $tree->find_node('ADHY'); is($adhy->branch_length, 0.1); is(($adhy->get_tag_values('S'))[0], 'nematode'); is(($adhy->get_tag_values('E'))[0], '1.1.1.1'); # try lintree parsing $treeio = Bio::TreeIO->new(-format => 'lintree', -file => test_input_file('crab.njb')); my (@leaves, $node); while( $tree = $treeio->next_tree ) { isa_ok($tree, 'Bio::Tree::TreeI'); @nodes = $tree->get_nodes; @leaves = $tree->get_leaf_nodes; is(@leaves, 13); #/maj is(@nodes, 25); is(@nodes, 24); # this is clear from the datafile and counting \maj ($node) = $tree->find_node(-id => '18'); ok($node); is($node->id, '18'); is($node->branch_length, '0.030579'); is($node->bootstrap, 998); } $treeio = Bio::TreeIO->new(-format => 'lintree', -file => test_input_file('crab.nj')); $tree = $treeio->next_tree; isa_ok($tree, 'Bio::Tree::TreeI'); @nodes = $tree->get_nodes; @leaves = $tree->get_leaf_nodes; is(@leaves, 13); #/maj is(@nodes, 25); is(@nodes, 24); #/maj ($node) = $tree->find_node('18'); is($node->id, '18'); is($node->branch_length, '0.028117'); ($node) = $tree->find_node(-id => 'C-vittat'); is($node->id, 'C-vittat'); is($node->branch_length, '0.087619'); is($node->ancestor->id, '14'); $treeio = Bio::TreeIO->new(-format => 'lintree', -file => test_input_file('crab.dat.cn')); $tree = $treeio->next_tree; isa_ok($tree, 'Bio::Tree::TreeI'); @nodes = $tree->get_nodes; @leaves = $tree->get_leaf_nodes; is(@leaves, 13, "Leaf nodes"); #/maj is(@nodes, 25, "All nodes"); is(@nodes, 24, "All nodes"); ($node) = $tree->find_node('18'); is($node->id, '18'); is($node->branch_length, '0.029044'); ($node) = $tree->find_node(-id => 'C-vittat'); is($node->id, 'C-vittat'); is($node->branch_length, '0.097855'); is($node->ancestor->id, '14'); SKIP: { test_skip(-tests => 8, -requires_module => 'IO::String'); # test nexus tree parsing $treeio = Bio::TreeIO->new(-format => 'nexus', -verbose => $verbose, -file => test_input_file('urease.tre.nexus')); $tree = $treeio->next_tree; ok($tree); is($tree->id, 'PAUP_1'); is($tree->get_leaf_nodes, 6); ($node) = $tree->find_node(-id => 'Spombe'); is($node->branch_length,0.221404); # test nexus MrBayes tree parsing $treeio = Bio::TreeIO->new(-format => 'nexus', -file => test_input_file('adh.mb_tree.nexus')); $tree = $treeio->next_tree; my $ct = 1; ok($tree); is($tree->id, 'rep.1'); is($tree->get_leaf_nodes, 54); ($node) = $tree->find_node(-id => 'd.madeirensis'); is($node->branch_length,0.039223); while ($tree = $treeio->next_tree) { $ct++; } is($ct,13,'bug 2356'); } # bug #1854 # process no-newlined tree $treeio = Bio::TreeIO->new(-format => 'nexus', -verbose => $verbose, -file => test_input_file('tree_nonewline.nexus')); $tree = $treeio->next_tree; ok($tree); ok($tree->find_node('TRXHomo')); # 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'); # bug #2205 # process trees with node IDs containing spaces $treeio = Bio::TreeIO->new(-format => 'nexus', -verbose => $verbose, -file => test_input_file('spaces.nex')); $tree = $treeio->next_tree; my @nodeids = ("'Allium drummondii'", "'Allium cernuum'",'A.cyaneum'); ok($tree); for my $node ($tree->get_leaf_nodes) { is($node->id, shift @nodeids); } # bug #2221 # process tree with names containing quoted commas $tree = $treeio->next_tree; @nodeids = ("'Allium drummondii, USA'", "'Allium drummondii, Russia'",'A.cyaneum'); ok($tree); for my $node ($tree->get_leaf_nodes) { is($node->id, shift @nodeids); } # bug #2221 # process tree with names containing quoted commas on one line $tree = $treeio->next_tree; @nodeids = ("'Allium drummondii, Russia'", "'Allium drummondii, USA'",'A.cyaneum'); ok($tree); for my $node ($tree->get_leaf_nodes) { is($node->id, shift @nodeids); } __DATA__ (((A:1,B:1):1,(C:1,D:1):1):1,((E:1,F:1):1,(G:1,H:1):1):1);