t/nexml.t

   1 #-*-perl-*-
   2 # $Id$
   3
   4 use strict;
   5
   6 use Bio::Root::Test;
   7 use Bio::Tree::Tree;
   8 use Bio::TreeIO;
   9 test_begin( -tests=>125,
  10             -requires_modules => [qw(Bio::Phylo)]);
  11
  12 use_ok('Bio::NexmlIO');
  13
  14
  15 #Read in Data
  16 my $in_nexmlIO = Bio::NexmlIO->new(-file => test_input_file('characters+trees.nexml.xml'));
  17
  18         #Read in some alignments
  19         my $aln1 = $in_nexmlIO->next_aln();#, 'nexml matrix to aln' );
  20         isa_ok($aln1, 'Bio::SimpleAlign', 'obj ok');
  21         is ($aln1->id,  'DNA sequences', 'aln id');
  22         my $num =0;
  23         my @expected_seqs = ('ACGCTCGCATCGCATC', 'ACGCTCGCATCGCATT', 'ACGCTCGCATCGCATG');
  24         #checking sequence objects
  25         foreach my $seq_obj ($aln1->each_seq()) {
  26                 $num++;
  27
  28                 is( $seq_obj->alphabet, 'dna', "alphabet" );
  29                 is( $seq_obj->display_id, "dna_seq_$num", "display_id");
  30                 is( $seq_obj->seq, $expected_seqs[$num-1], "sequence correct");
  31         }
  32         my $aln2 = $in_nexmlIO->next_aln();
  33         my @alns1;
  34         push @alns1, $aln1;
  35         push @alns1, $aln2;
  36         #checking taxa object
  37         my %expected_taxa = (dna_seq_1 => 'Homo sapiens', dna_seq_2 => 'Pan paniscus', dna_seq_3 => 'Pan troglodytes');
  38         my @feats = $aln1->get_all_SeqFeatures();
  39         foreach my $feat (@feats) {
  40                 if ($feat->has_tag('taxa_id')){
  41                         is ( ($feat->get_tag_values('taxa_id'))[0], 'taxa1', 'taxa id ok' );
  42                         is ( ($feat->get_tag_values('taxa_label'))[0], 'Primary taxa block', 'taxa label ok');
  43                         is ( $feat->get_tag_values('taxon'), 5, 'Number of taxa ok')
  44                 }
  45                 else{
  46                         my $seq_num = ($feat->get_tag_values('id'))[0];
  47                         is ( ($feat->get_tag_values('taxon'))[0], $expected_taxa{$seq_num}, "$seq_num taxon ok" )
  48                 }
  49         }
  50
  51         #Read in some sequences
  52         ok( my $seq1 = $in_nexmlIO->next_seq() );
  53         isa_ok($seq1, 'Bio::Seq');
  54         is( $seq1->alphabet,            'dna',                                  "alphabet" );
  55         is( $seq1->primary_id,  'dna_seq_1',    "primary_id");
  56         is( $seq1->display_id,  'dna_seq_1',                    "display_id");
  57         is( $seq1->seq,                 'ACGCTCGCATCGCATC',             "sequence");
  58
  59         #checking second sequence object
  60         ok( my $seq2 = $in_nexmlIO->next_seq() );
  61         is( $seq2->alphabet,            'dna',                                  "alphabet" );
  62         is( $seq2->primary_id,  'dna_seq_2',    "primary_id");
  63         is( $seq2->display_id,  'dna_seq_2',                    "display_id");
  64         is( $seq2->seq,                 'ACGCTCGCATCGCATT',             "sequence");
  65         ok( my $seq3 = $in_nexmlIO->next_seq() );
  66         ok( my $seq4 = $in_nexmlIO->next_seq() );
  67         my @seqs1;
  68         push @seqs1, $seq1;
  69         push @seqs1, $seq2;
  70         push @seqs1, $seq3;
  71         push @seqs1, $seq4;
  72
  73         #Read in some trees
  74         ok( my $tree1 = $in_nexmlIO->next_tree() );
  75         isa_ok($tree1, 'Bio::Tree::Tree');
  76         is( $tree1->get_root_node()->id(), 'n1', "root node");
  77         my @nodes = $tree1->get_nodes();
  78         is( @nodes, 9, "number of nodes");
  79         ok ( my $node7 = $tree1->find_node('n7') );
  80         is( $node7->branch_length, 0.3247, "branch length");
  81         is( $node7->ancestor->id, 'n3');
  82         is( $node7->ancestor->branch_length, '0.34534');
  83         #Check leaf nodes and taxa
  84         my %expected_leaves = (
  85                                                         'n8'    =>      'bird',
  86                                                         'n9'    =>      'worm',
  87                                                         'n5'    =>      'dog',
  88                                                         'n6'    =>      'mouse',
  89                                                         'n2'    =>      'human'
  90         );
  91         ok( my @leaves = $tree1->get_leaf_nodes() );
  92         is( @leaves, 5, "number of leaf nodes");
  93         foreach my $leaf (@leaves) {
  94                 my $leafID = $leaf->id();
  95                 ok( exists $expected_leaves{$leaf->id()}, "$leafID exists"  );
  96                 is( $leaf->get_tag_values('taxon'), $expected_leaves{$leaf->id()}, "$leafID taxon");
  97         }
  98         my $tree2 = $in_nexmlIO->next_tree();
  99         my @trees1;
 100         push @trees1, $tree1;
 101         push @trees1, $tree2;
 102
 103
 104 #Write Data
 105 diag('Begin tests for write/read roundtrip');
 106 my $outdata = test_output_file();
 107
 108
 109 my $nexml_out = Bio::NexmlIO->new(-file => ">$outdata", -format => 'Nexml');
 110
 111 ok( $nexml_out->write(-seqs => \@seqs1, -alns =>\@alns1, -trees => \@trees1), "write to stream" );
 112 close($outdata);
 113
 114 #Read in the out file to test roundtrip
 115 my $in_nexmlIO_roundtrip = Bio::NexmlIO->new(-file => $outdata);
 116
 117
 118         #Read in some alignments
 119         my $aln3 = $in_nexmlIO_roundtrip->next_aln();#, 'nexml matrix to aln' );
 120         isa_ok($aln3, 'Bio::SimpleAlign', 'obj ok');
 121         is ($aln3->id,  'DNA sequences', 'aln id');
 122         $num =0;
 123         #checking sequence objects
 124         foreach my $seq_obj ($aln3->each_seq()) {
 125                 $num++;
 126
 127                 is( $seq_obj->alphabet, 'dna', "alphabet" );
 128                 is( $seq_obj->display_id, "dna_seq_$num", "display_id");
 129                 is( $seq_obj->seq, $expected_seqs[$num-1], "sequence correct");
 130         }
 131         #checking taxa object
 132         my @feats_r = $aln3->get_all_SeqFeatures();
 133         foreach my $feat (@feats_r) {
 134                 if ($feat->has_tag('taxa_id')){
 135                         is ( ($feat->get_tag_values('taxa_id'))[0], 'taxa1', 'taxa id ok' );
 136                         is ( ($feat->get_tag_values('taxa_label'))[0], 'Primary taxa block', 'taxa label ok');
 137                         is ( $feat->get_tag_values('taxon'), 5, 'Number of taxa ok')
 138                 }
 139                 else{
 140                         my $seq_num = ($feat->get_tag_values('id'))[0];
 141                         is ( ($feat->get_tag_values('taxon'))[0], $expected_taxa{$seq_num}, "$seq_num taxon ok" )
 142                 }
 143         }
 144         #check extract_alns method
 145         my $alns_outfile = test_output_file();
 146         ok ( $in_nexmlIO_roundtrip->extract_alns(-file => ">$alns_outfile", -format => "fasta"), 'extract_alns write' );
 147         close($alns_outfile);
 148         my $alnIO = Bio::SeqIO->new(-file => "$alns_outfile", -format => 'fasta');
 149         my $alns_array = $in_nexmlIO_roundtrip->{_seqs};
 150         my $alnNum = 1;
 151         while (my $aln = $alnIO->next_seq()) {
 152                 is( $aln->seq, $alns_array->[$alnNum-1]->seq, "extract_alns roundtrip $alnNum" );
 153                 $alnNum++;
 154         }
 155
 156         #Read in some sequences
 157         ok( my $seq5 = $in_nexmlIO_roundtrip->next_seq() );
 158         isa_ok($seq5, 'Bio::Seq');
 159         is( $seq5->alphabet,            'dna',                                  "alphabet" );
 160         is( $seq5->primary_id,  'dna_seq_1',    "primary_id");
 161         is( $seq5->display_id,  'dna_seq_1',                    "display_id");
 162         is( $seq5->seq,                 'ACGCTCGCATCGCATC',             "sequence");
 163
 164         #checking second sequence object
 165         ok( my $seq6 = $in_nexmlIO_roundtrip->next_seq() );
 166         is( $seq6->alphabet,            'dna',                                  "alphabet" );
 167         is( $seq6->primary_id,  'dna_seq_2',    "primary_id");
 168         is( $seq6->display_id,  'dna_seq_2',                    "display_id");
 169         is( $seq6->seq,                 'ACGCTCGCATCGCATT',             "sequence");
 170         #check extract_seqs method
 171         my $seqs_outfile = test_output_file();
 172         ok ( $in_nexmlIO_roundtrip->extract_seqs(-file => ">$seqs_outfile", -format => "fasta"), 'extract_seqs write' );
 173         close($seqs_outfile);
 174         my $seqIO = Bio::SeqIO->new(-file => "$seqs_outfile", -format => 'fasta');
 175         my $seqs_array = $in_nexmlIO_roundtrip->{_seqs};
 176         my $seqNum = 1;
 177         while (my $seq = $seqIO->next_seq()) {
 178                 is( $seq->seq, $seqs_array->[$seqNum-1]->seq, "extract_seqs roundtrip $seqNum" );
 179                 $seqNum++;
 180         }
 181
 182         #Read in some trees
 183         ok( my $tree3 = $in_nexmlIO_roundtrip->next_tree() );
 184         isa_ok($tree3, 'Bio::Tree::Tree');
 185         is( $tree3->get_root_node()->id(), 'n1', "root node");
 186         my @nodes3 = $tree3->get_nodes();
 187         is( @nodes3, 9, "number of nodes");
 188         ok ( my $node7_r = $tree3->find_node('n7') );
 189         is( $node7_r->branch_length, 0.3247, "branch length");
 190         is( $node7_r->ancestor->id, 'n3');
 191         is( $node7_r->ancestor->branch_length, '0.34534');
 192         #Check leaf nodes and taxa
 193         ok( my @leaves3 = $tree3->get_leaf_nodes() );
 194         is( @leaves3, 5, "number of leaf nodes");
 195         foreach my $leaf (@leaves3) {
 196                 my $leafID = $leaf->id();
 197                 ok( exists $expected_leaves{$leaf->id()}, "$leafID exists"  );
 198                 is( $leaf->get_tag_values('taxon'), $expected_leaves{$leaf->id()}, "$leafID taxon");
 199         }
 200         #check extract_trees method
 201         my $trees_outfile = test_output_file();
 202         ok ( $in_nexmlIO_roundtrip->extract_trees(-file => ">$trees_outfile", -format => "nexus"), 'extract_trees write' );
 203         close($seqs_outfile);
 204         my $treeIO = Bio::TreeIO->new(-file => "$trees_outfile", -format => 'nexus');
 205         my $trees_array = $in_nexmlIO_roundtrip->{_trees};
 206         my $treeNum = 1;
 207         while (my $tree = $treeIO->next_tree()) {
 208                 is( $tree->id, $trees_array->[$treeNum-1]->id, "extract_trees roundtrip $treeNum" );
 209                 $treeNum++;
 210         }
 211