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