9 test_begin( -tests=>125,
10 -requires_modules => [qw(Bio::Phylo)]);
12 use_ok('Bio::NexmlIO');
16 my $in_nexmlIO = Bio::NexmlIO->new(-file => test_input_file('characters+trees.nexml.xml'));
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');
23 my @expected_seqs = ('ACGCTCGCATCGCATC', 'ACGCTCGCATCGCATT', 'ACGCTCGCATCGCATG');
24 #checking sequence objects
25 foreach my $seq_obj ($aln1->each_seq()) {
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");
32 my $aln2 = $in_nexmlIO->next_aln();
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')
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" )
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");
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() );
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 = (
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");
98 my $tree2 = $in_nexmlIO->next_tree();
100 push @trees1, $tree1;
101 push @trees1, $tree2;
105 diag('Begin tests for write/read roundtrip');
106 my $outdata = test_output_file();
109 my $nexml_out = Bio::NexmlIO->new(-file => ">$outdata", -format => 'Nexml');
111 ok( $nexml_out->write(-seqs => \@seqs1, -alns =>\@alns1, -trees => \@trees1), "write to stream" );
114 #Read in the out file to test roundtrip
115 my $in_nexmlIO_roundtrip = Bio::NexmlIO->new(-file => $outdata);
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');
123 #checking sequence objects
124 foreach my $seq_obj ($aln3->each_seq()) {
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");
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')
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" )
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};
151 while (my $aln = $alnIO->next_seq()) {
152 is( $aln->seq, $alns_array->[$alnNum-1]->seq, "extract_alns roundtrip $alnNum" );
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");
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};
177 while (my $seq = $seqIO->next_seq()) {
178 is( $seq->seq, $seqs_array->[$seqNum-1]->seq, "extract_seqs roundtrip $seqNum" );
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");
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};
207 while (my $tree = $treeIO->next_tree()) {
208 is( $tree->id, $trees_array->[$treeNum-1]->id, "extract_trees roundtrip $treeNum" );