Allow falling back to any strigified Bio::AnnotationI for 'gene_name'
[bioperl-live.git] / t / Annotation / Annotation.t
blob2394b8a2bd891bc16ad15c2a5003f7f01a03b45c
1 # -*-Perl-*- Test Harness script for Bioperl
2 # $Id$
4 use strict;
6 BEGIN { 
7     use lib '.';
8     use Bio::Root::Test;
9     
10     test_begin(-tests => 159);
11         
12     use_ok('Bio::Annotation::Collection');
13     use_ok('Bio::Annotation::DBLink');
14     use_ok('Bio::Annotation::Comment');
15     use_ok('Bio::Annotation::Reference');
16     use_ok('Bio::Annotation::SimpleValue');
17     use_ok('Bio::Annotation::Target');
18     use_ok('Bio::Annotation::AnnotationFactory');
19     use_ok('Bio::Annotation::StructuredValue');
20     use_ok('Bio::Annotation::TagTree');
21     use_ok('Bio::Annotation::Tree');
22     use_ok('Bio::Seq');
23     use_ok('Bio::SimpleAlign');
24     use_ok('Bio::Cluster::UniGene');
27 my $DEBUG = test_debug();
29 #simple value
31 my $simple = Bio::Annotation::SimpleValue->new(-tagname => 'colour',
32                                                -value   => '1',
33                                               );
35 isa_ok($simple, 'Bio::AnnotationI');
36 is $simple->display_text, 1;
37 is $simple->value, 1;
38 is $simple->tagname, 'colour';
40 is $simple->value(0), 0;
41 is $simple->value, 0;
42 is $simple->display_text, 0;
44 # link
46 my $link1 = Bio::Annotation::DBLink->new(-database => 'TSC',
47                                          -primary_id => 'TSC0000030',
48                                         );
49 isa_ok($link1,'Bio::AnnotationI');
50 is $link1->database(), 'TSC';
51 is $link1->primary_id(), 'TSC0000030';
52 is $link1->as_text, 'Direct database link to TSC0000030 in database TSC';
53 my $ac = Bio::Annotation::Collection->new();
54 isa_ok($ac,'Bio::AnnotationCollectionI');
56 $ac->add_Annotation('dblink',$link1);
57 $ac->add_Annotation('dblink',
58                     Bio::Annotation::DBLink->new(-database => 'TSC',
59                                                  -primary_id => 'HUM_FABV'));
61 my $comment = Bio::Annotation::Comment->new( '-text' => 'sometext');
62 is $comment->text, 'sometext';
63 is $comment->as_text, 'Comment: sometext';
64 $ac->add_Annotation('comment', $comment);
68 my $target = Bio::Annotation::Target->new(-target_id  => 'F321966.1',
69                                           -start      => 1,
70                                           -end        => 200,
71                                           -strand     => 1,
72                                          );
73 isa_ok($target,'Bio::AnnotationI');
74 ok $ac->add_Annotation('target', $target);
77 my $ref = Bio::Annotation::Reference->new( -authors  => 'author line',
78                                            -title    => 'title line',
79                                            -location => 'location line',
80                                            -start    => 12);
81 isa_ok($ref,'Bio::AnnotationI');
82 is $ref->authors, 'author line';
83 is $ref->title,  'title line';
84 is $ref->location, 'location line';
85 is $ref->start, 12;
86 is $ref->database, 'MEDLINE';
87 is $ref->as_text, 'Reference: title line';
88 $ac->add_Annotation('reference', $ref);
91 my $n = 0;
92 foreach my $link ( $ac->get_Annotations('dblink') ) {
93     is $link->database, 'TSC';
94     is $link->tagname(), 'dblink';
95     $n++;
97 is ($n, 2);
99 $n = 0;
100 my @keys = $ac->get_all_annotation_keys();
101 is (scalar(@keys), 4);
102 foreach my $ann ( $ac->get_Annotations() ) {
103     shift(@keys) if ($n > 0) && ($ann->tagname ne $keys[0]);
104     is $ann->tagname(), $keys[0];
105     $n++;
107 is ($n, 5);
109 $ac->add_Annotation($link1);
111 $n = 0;
112 foreach my $link ( $ac->get_Annotations('dblink') ) {
113     is $link->tagname(), 'dblink';
114     $n++;
116 is ($n, 3);
118 # annotation of structured simple values (like swissprot''is GN line)
119 my $ann = Bio::Annotation::StructuredValue->new();
120 isa_ok($ann, "Bio::AnnotationI");
122 $ann->add_value([-1], "val1");
123 is ($ann->value(), "val1");
124 $ann->value("compat test");
125 is ($ann->value(), "compat test");
126 $ann->add_value([-1], "val2");
127 is ($ann->value(-joins => [" AND "]), "compat test AND val2");
128 $ann->add_value([0], "val1");
129 is ($ann->value(-joins => [" AND "]), "val1 AND val2");
130 $ann->add_value([-1,-1], "val3", "val4");
131 $ann->add_value([-1,-1], "val5", "val6");
132 $ann->add_value([-1,-1], "val7");
133 is ($ann->value(-joins => [" AND "]), "val1 AND val2 AND (val3 AND val4) AND (val5 AND val6) AND val7");
134 is ($ann->value(-joins => [" AND ", " OR "]), "val1 AND val2 AND (val3 OR val4) AND (val5 OR val6) AND val7");
136 $n = 1;
137 foreach ($ann->get_all_values()) {
138     is ($_, "val".$n++);
141 # nested collections
142 my $nested_ac = Bio::Annotation::Collection->new();
143 $nested_ac->add_Annotation('nested', $ac);
145 is (scalar($nested_ac->get_Annotations()), 1);
146 ($ac) = $nested_ac->get_Annotations();
147 isa_ok($ac, "Bio::AnnotationCollectionI");
148 is (scalar($nested_ac->get_all_Annotations()), 6);
149 $nested_ac->add_Annotation('gene names', $ann);
150 is (scalar($nested_ac->get_Annotations()), 2);
151 is (scalar($nested_ac->get_all_Annotations()), 7);
152 is (scalar($nested_ac->get_Annotations('dblink')), 0);
153 my @anns = $nested_ac->get_Annotations('gene names');
154 isa_ok($anns[0], "Bio::Annotation::StructuredValue");
155 @anns = map { $_->get_Annotations('dblink');
156           } $nested_ac->get_Annotations('nested');
157 is (scalar(@anns), 3);
158 is (scalar($nested_ac->flatten_Annotations()), 2);
159 is (scalar($nested_ac->get_Annotations()), 7);
160 is (scalar($nested_ac->get_all_Annotations()), 7);
162 SKIP: {
163   test_skip(-tests => 7, -requires_modules => [qw(Graph::Directed Bio::Annotation::OntologyTerm)]);
164   use_ok('Bio::Annotation::OntologyTerm');
165   # OntologyTerm annotation
166   my $termann = Bio::Annotation::OntologyTerm->new(-label => 'test case',
167                                                    -identifier => 'Ann:00001',
168                                                    -ontology => 'dumpster');
169   isa_ok($termann->term,'Bio::Ontology::Term');
170   is ($termann->term->name, 'test case');
171   is ($termann->term->identifier, 'Ann:00001');
172   is ($termann->tagname, 'dumpster');
173   is ($termann->ontology->name, 'dumpster');
174   is ($termann->as_text, "dumpster|test case|");
177 # AnnotatableI
178 my $seq = Bio::Seq->new();
179 isa_ok($seq,"Bio::AnnotatableI");
180 SKIP: {
181         test_skip(-requires_modules => [qw(Bio::SeqFeature::Annotated URI::Escape)],
182                           -tests => 4);
183         my $fea = Bio::SeqFeature::Annotated->new();
184         isa_ok($fea, "Bio::SeqFeatureI",'isa SeqFeatureI');
185         isa_ok($fea, "Bio::AnnotatableI",'isa AnnotatableI');
186         $fea = Bio::SeqFeature::Generic->new();
187         isa_ok($fea, "Bio::SeqFeatureI",'isa SeqFeatureI');
188         isa_ok($fea, "Bio::AnnotatableI",'isa AnnotatableI');
190 my $clu = Bio::Cluster::UniGene->new();
191 isa_ok($clu, "Bio::AnnotatableI");
192 my $aln = Bio::SimpleAlign->new();
193 isa_ok($clu,"Bio::AnnotatableI");
195 # tests for Bio::Annotation::AnnotationFactory
197 my $factory = Bio::Annotation::AnnotationFactory->new;
198 isa_ok($factory, 'Bio::Factory::ObjectFactoryI');
200 # defaults to SimpleValue
201 $ann = $factory->create_object(-value => 'peroxisome',
202                                -tagname => 'cellular component');
203 isa_ok($ann, 'Bio::Annotation::SimpleValue');
205 $factory->type('Bio::Annotation::OntologyTerm');
207 $ann = $factory->create_object(-name => 'peroxisome',
208                                -tagname => 'cellular component');
209 ok(defined $ann);
210 isa_ok($ann, 'Bio::Annotation::OntologyTerm');
212 # unset type()
213 $factory->type(undef);
214 $ann = $factory->create_object(-text => 'this is a comment');
215 ok(defined $ann,'Bio::Annotation::Comment');
217 isa_ok($ann,'Bio::Annotation::Comment');
219 ok $factory->type('Bio::Annotation::Comment');
220 $ann = $factory->create_object(-text => 'this is a comment');
221 ok(defined $ann,'Bio::Annotation::Comment');
222 isa_ok($ann,'Bio::Annotation::Comment');
224 # factory guessing the type: Comment
225 $factory = Bio::Annotation::AnnotationFactory->new();
226 $ann = $factory->create_object(-text => 'this is a comment');
227 ok(defined $ann,'Bio::Annotation::Comment');
228 isa_ok($ann,'Bio::Annotation::Comment');
230 # factory guessing the type: Target
231 $factory = Bio::Annotation::AnnotationFactory->new();
232 $ann = $factory->create_object(-target_id => 'F1234',
233                                -start     => 1,
234                                -end       => 10 );
235 ok defined $ann;
236 isa_ok($ann,'Bio::Annotation::Target');
238 # factory guessing the type: OntologyTerm
239 $factory = Bio::Annotation::AnnotationFactory->new();
240 ok(defined ($ann = $factory->create_object(-name => 'peroxisome',
241                                            -tagname => 'cellular component')));
242 like(ref $ann, qr(Bio::Annotation::OntologyTerm));
244 # tree
245 my $tree_filename = test_input_file('longnames.dnd');
246 my $tree = Bio::TreeIO->new(-file=>$tree_filename)->next_tree();
247 my $ann_tree = Bio::Annotation::Tree->new(
248                                           -tagname  => 'tree',
249                                           -tree_obj => $tree,
250                                          );
252 isa_ok($ann_tree, 'Bio::AnnotationI');
253 $ann_tree->tree_id('test');
254 is $ann_tree->tree_id(), 'test', "tree_id()";
255 $ann_tree->tagname('tree'); 
256 is $ann_tree->tagname(), 'tree', "tagname()";
257 my $aln_filename = test_input_file('longnames.aln');
258 use Bio::AlignIO;
259 $aln = Bio::AlignIO->new(-file  => $aln_filename,
260                          -format=>'clustalw')->next_aln();
261 isa_ok($aln, 'Bio::AnnotatableI');
262 $ac = Bio::Annotation::Collection->new();
263 $ac->add_Annotation('tree',$ann_tree);
264 $aln->annotation($ac);
265 for my $treeblock ( $aln->annotation->get_Annotations('tree') ) {
266   my $treeref = $treeblock->tree();
267   my @nodes = sort { defined $a->id &&
268                        defined $b->id &&
269                          $a->id cmp $b->id } $treeref->get_nodes();
270   is(@nodes, 26);
271   is $nodes[12]->id, 'Skud_Contig1703.7', "add tree to AlignI";
272   my $str;
273   for my $seq ($aln->each_seq_with_id($nodes[12]->id)) {
274     $str = $seq->subseq(1,20);
275   }
276   is( $str, "-------------MPFAQIV", "get seq from node id");
279 # factory guessing the type: Tree
280 $factory = Bio::Annotation::AnnotationFactory->new();
281 $ann = $factory->create_object(-tree_obj => $tree);
282 ok defined $ann;
283 isa_ok($ann,'Bio::Annotation::Tree');
285 #tagtree
286 my $struct = [ 'genenames' => [
287                                ['genename' => [
288                                                [ 'Name' => 'CALM1' ],
289                                                ['Synonyms'=> 'CAM1'],
290                                                ['Synonyms'=> 'CALM'],
291                                                ['Synonyms'=> 'CAM' ] ] ],
292                                ['genename'=> [
293                                               [ 'Name'=> 'CALM2' ],
294                                               [ 'Synonyms'=> 'CAM2'],
295                                               [ 'Synonyms'=> 'CAMB'] ] ],
296                                [ 'genename'=> [
297                                                [ 'Name'=> 'CALM3' ],
298                                                [ 'Synonyms'=> 'CAM3' ],
299                                                [ 'Synonyms'=> 'CAMC' ] ] ]
300                               ] ];
302 my $ann_struct = Bio::Annotation::TagTree->new(-tagname => 'gn',
303                                                -value => $struct);
305 isa_ok($ann_struct, 'Bio::AnnotationI');
306 my $val = $ann_struct->value;
307 like($val, qr/Name: CALM1/,'default itext');
309 # roundtrip
310 my $ann_struct2 = Bio::Annotation::TagTree->new(-tagname => 'gn',
311                                                 -value => $val);
312 is($ann_struct2->value, $val,'roundtrip');
314 # formats 
315 like($ann_struct2->value, qr/Name: CALM1/,'itext');
316 $ann_struct2->tagformat('sxpr');
317 like($ann_struct2->value, qr/\(Name "CALM1"\)/,'spxr');
318 $ann_struct2->tagformat('indent');
319 like($ann_struct2->value, qr/Name "CALM1"/,'indent');
321 SKIP: {
322     eval {require XML::Parser::PerlSAX};
323     skip ("XML::Parser::PerlSAX rquired for XML",1) if $@;
324     $ann_struct2->tagformat('xml');
325     like($ann_struct2->value, qr/<Name>CALM1<\/Name>/,'xml');
328 # grab Data::Stag nodes, use Data::Stag methods
329 my @nodes = $ann_struct2->children;
330 for my $node (@nodes) {
331     isa_ok($node, 'Data::Stag::StagI');
332     is($node->element, 'genename');
333     # add tag-value data to node
334     $node->set('foo', 'bar');
335     # check output
336     like($node->itext, qr/foo:\s+bar/,'child changes');
339 $ann_struct2->tagformat('itext');
340 like($ann_struct2->value, qr/foo:\s+bar/,'child changes in parent node');
342 # pass in a Data::Stag node to value()
343 $ann_struct = Bio::Annotation::TagTree->new(-tagname => 'mytags');
344 like($ann_struct->value, qr/^\s+:\s+$/xms, 'no tags');
345 like($ann_struct->value, qr/^\s+:\s+$/xms,'before Stag node');
346 $ann_struct->value($nodes[0]);
347 like($ann_struct->value, qr/Name: CALM1/,'after Stag node');
348 is(ref $ann_struct->node, ref $nodes[0], 'both stag nodes');
349 isnt($ann_struct->node, $nodes[0], 'different instances');
351 # pass in another TagTree to value()
352 $ann_struct = Bio::Annotation::TagTree->new(-tagname => 'mytags');
353 like($ann_struct->value, qr/^\s+:\s+$/xms,'before TagTree');
354 $ann_struct->value($ann_struct2);
355 like($ann_struct->value, qr/Name: CALM2/,'after TagTree');
356 is(ref $ann_struct->node, ref $ann_struct2->node, 'both stag nodes');
357 isnt($ann_struct->node, $ann_struct2->node, 'different instances');
359 # replace the Data::Stag node in the annotation (no copy)
360 $ann_struct = Bio::Annotation::TagTree->new(-tagname => 'mytags');
361 like($ann_struct->value, qr/^\s+:\s+$/xms,'before TagTree');
362 $ann_struct->node($nodes[1]);
363 like($ann_struct->value, qr/Name: CALM2/,'after TagTree');
364 is(ref $ann_struct->node, ref $ann_struct2->node, 'stag nodes');
365 is($ann_struct->node, $nodes[1], 'same instance');
366 # replace the Data::Stag node in the annotation (use duplicate)
367 $ann_struct = Bio::Annotation::TagTree->new(-tagname => 'mytags');
368 like($ann_struct->value, qr/^\s+:\s+$/xms,'before TagTree');
369 $ann_struct->node($nodes[1],'copy');
370 like($ann_struct->value, qr/Name: CALM2/,'after TagTree');
371 is(ref $ann_struct->node, ref $ann_struct2->node, 'stag nodes');
372 isnt($ann_struct->node, $nodes[1], 'different instance');
374 #check insertion in to collection
375 $ann_struct = Bio::Annotation::TagTree->new(-value => $struct);
376 $ac = Bio::Annotation::Collection->new();
378 $ac->add_Annotation('genenames',$ann_struct);
379 my $ct = 0;
380 for my $tagtree ( $ac->get_Annotations('genenames') ) {
381   isa_ok($tagtree, 'Bio::AnnotationI');
382   for my $node ($tagtree->children) {
383     isa_ok($node, 'Data::Stag::StagI');
384     like($node->itext, qr/Name:\s+CALM/,'child changes');
385     $ct++;
386   }
388 is($ct,3);
390 # factory guessing the type: TagTree
391 $factory = Bio::Annotation::AnnotationFactory->new();
392 $ann = $factory->create_object(-value => $struct);
393 ok defined $ann;
394 isa_ok($ann,'Bio::Annotation::TagTree');