Used quoted strings in Bio::Species to avoid a 'Invalid [] range in regex' error...
[bioperl-live.git] / t / Annotation / Annotation.t
blob0b5abf89fbeb4d67749c6d562203a5de14700b07
1 # -*-Perl-*- Test Harness script for Bioperl
2 # $Id$
4 use strict;
6 BEGIN {
7     use lib '.';
8     use Bio::Root::Test;
10     test_begin(-tests => 152);
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');
24 my $DEBUG = test_debug();
26 #simple value
28 my $simple = Bio::Annotation::SimpleValue->new(-tagname => 'colour',
29                                                -value   => '1',
30                                               );
32 isa_ok($simple, 'Bio::AnnotationI');
33 is $simple->display_text, 1;
34 is $simple->value, 1;
35 is $simple->tagname, 'colour';
37 is $simple->value(0), 0;
38 is $simple->value, 0;
39 is $simple->display_text, 0;
41 # link
43 my $link1 = Bio::Annotation::DBLink->new(-database => 'TSC',
44                                          -primary_id => 'TSC0000030',
45                                         );
46 isa_ok($link1,'Bio::AnnotationI');
47 is $link1->database(), 'TSC';
48 is $link1->primary_id(), 'TSC0000030';
49 is $link1->as_text, 'Direct database link to TSC0000030 in database TSC';
50 my $ac = Bio::Annotation::Collection->new();
51 isa_ok($ac,'Bio::AnnotationCollectionI');
53 $ac->add_Annotation('dblink',$link1);
54 $ac->add_Annotation('dblink',
55                     Bio::Annotation::DBLink->new(-database => 'TSC',
56                                                  -primary_id => 'HUM_FABV'));
58 my $comment = Bio::Annotation::Comment->new( '-text' => 'sometext');
59 is $comment->text, 'sometext';
60 is $comment->as_text, 'Comment: sometext';
61 $ac->add_Annotation('comment', $comment);
65 my $target = Bio::Annotation::Target->new(-target_id  => 'F321966.1',
66                                           -start      => 1,
67                                           -end        => 200,
68                                           -strand     => 1,
69                                          );
70 isa_ok($target,'Bio::AnnotationI');
71 ok $ac->add_Annotation('target', $target);
74 my $ref = Bio::Annotation::Reference->new( -authors  => 'author line',
75                                            -title    => 'title line',
76                                            -location => 'location line',
77                                            -start    => 12);
78 isa_ok($ref,'Bio::AnnotationI');
79 is $ref->authors, 'author line';
80 is $ref->title,  'title line';
81 is $ref->location, 'location line';
82 is $ref->start, 12;
83 is $ref->database, 'MEDLINE';
84 is $ref->as_text, 'Reference: title line';
85 $ac->add_Annotation('reference', $ref);
88 my $n = 0;
89 foreach my $link ( $ac->get_Annotations('dblink') ) {
90     is $link->database, 'TSC';
91     is $link->tagname(), 'dblink';
92     $n++;
94 is ($n, 2);
96 $n = 0;
97 my @keys = $ac->get_all_annotation_keys();
98 is (scalar(@keys), 4);
99 foreach my $ann ( $ac->get_Annotations() ) {
100     shift(@keys) if ($n > 0) && ($ann->tagname ne $keys[0]);
101     is $ann->tagname(), $keys[0];
102     $n++;
104 is ($n, 5);
106 $ac->add_Annotation($link1);
108 $n = 0;
109 foreach my $link ( $ac->get_Annotations('dblink') ) {
110     is $link->tagname(), 'dblink';
111     $n++;
113 is ($n, 3);
115 # annotation of structured simple values (like swissprot''is GN line)
116 my $ann = Bio::Annotation::StructuredValue->new();
117 isa_ok($ann, "Bio::AnnotationI");
119 $ann->add_value([-1], "val1");
120 is ($ann->value(), "val1");
121 $ann->value("compat test");
122 is ($ann->value(), "compat test");
123 $ann->add_value([-1], "val2");
124 is ($ann->value(-joins => [" AND "]), "compat test AND val2");
125 $ann->add_value([0], "val1");
126 is ($ann->value(-joins => [" AND "]), "val1 AND val2");
127 $ann->add_value([-1,-1], "val3", "val4");
128 $ann->add_value([-1,-1], "val5", "val6");
129 $ann->add_value([-1,-1], "val7");
130 is ($ann->value(-joins => [" AND "]), "val1 AND val2 AND (val3 AND val4) AND (val5 AND val6) AND val7");
131 is ($ann->value(-joins => [" AND ", " OR "]), "val1 AND val2 AND (val3 OR val4) AND (val5 OR val6) AND val7");
133 $n = 1;
134 foreach ($ann->get_all_values()) {
135     is ($_, "val".$n++);
138 # nested collections
139 my $nested_ac = Bio::Annotation::Collection->new();
140 $nested_ac->add_Annotation('nested', $ac);
142 is (scalar($nested_ac->get_Annotations()), 1);
143 ($ac) = $nested_ac->get_Annotations();
144 isa_ok($ac, "Bio::AnnotationCollectionI");
145 is (scalar($nested_ac->get_all_Annotations()), 6);
146 $nested_ac->add_Annotation('gene names', $ann);
147 is (scalar($nested_ac->get_Annotations()), 2);
148 is (scalar($nested_ac->get_all_Annotations()), 7);
149 is (scalar($nested_ac->get_Annotations('dblink')), 0);
150 my @anns = $nested_ac->get_Annotations('gene names');
151 isa_ok($anns[0], "Bio::Annotation::StructuredValue");
152 @anns = map { $_->get_Annotations('dblink');
153           } $nested_ac->get_Annotations('nested');
154 is (scalar(@anns), 3);
155 is (scalar($nested_ac->flatten_Annotations()), 2);
156 is (scalar($nested_ac->get_Annotations()), 7);
157 is (scalar($nested_ac->get_all_Annotations()), 7);
159 SKIP: {
160   test_skip(-tests => 7, -requires_modules => [qw(Bio::Annotation::OntologyTerm)]);
161   use_ok('Bio::Annotation::OntologyTerm');
162   # OntologyTerm annotation
163   my $termann = Bio::Annotation::OntologyTerm->new(-label => 'test case',
164                                                    -identifier => 'Ann:00001',
165                                                    -ontology => 'dumpster');
166   isa_ok($termann->term,'Bio::Ontology::Term');
167   is ($termann->term->name, 'test case');
168   is ($termann->term->identifier, 'Ann:00001');
169   is ($termann->tagname, 'dumpster');
170   is ($termann->ontology->name, 'dumpster');
171   is ($termann->as_text, "dumpster|test case|");
174 # AnnotatableI
175 use Bio::Seq;
176 my $seq = Bio::Seq->new();
177 SKIP: {
178         test_skip(-requires_modules => [qw(Bio::SeqFeature::Annotated URI::Escape)],
179                           -tests => 4);
180         my $fea = Bio::SeqFeature::Annotated->new();
181         isa_ok($fea, "Bio::SeqFeatureI",'isa SeqFeatureI');
182         isa_ok($fea, "Bio::AnnotatableI",'isa AnnotatableI');
183         $fea = Bio::SeqFeature::Generic->new();
184         isa_ok($fea, "Bio::SeqFeatureI",'isa SeqFeatureI');
185         isa_ok($fea, "Bio::AnnotatableI",'isa AnnotatableI');
188 # tests for Bio::Annotation::AnnotationFactory
190 my $factory = Bio::Annotation::AnnotationFactory->new;
191 isa_ok($factory, 'Bio::Factory::ObjectFactoryI');
193 # defaults to SimpleValue
194 $ann = $factory->create_object(-value => 'peroxisome',
195                                -tagname => 'cellular component');
196 isa_ok($ann, 'Bio::Annotation::SimpleValue');
198 $factory->type('Bio::Annotation::OntologyTerm');
200 $ann = $factory->create_object(-name => 'peroxisome',
201                                -tagname => 'cellular component');
202 ok(defined $ann);
203 isa_ok($ann, 'Bio::Annotation::OntologyTerm');
205 # unset type()
206 $factory->type(undef);
207 $ann = $factory->create_object(-text => 'this is a comment');
208 ok(defined $ann,'Bio::Annotation::Comment');
210 isa_ok($ann,'Bio::Annotation::Comment');
212 ok $factory->type('Bio::Annotation::Comment');
213 $ann = $factory->create_object(-text => 'this is a comment');
214 ok(defined $ann,'Bio::Annotation::Comment');
215 isa_ok($ann,'Bio::Annotation::Comment');
217 # factory guessing the type: Comment
218 $factory = Bio::Annotation::AnnotationFactory->new();
219 $ann = $factory->create_object(-text => 'this is a comment');
220 ok(defined $ann,'Bio::Annotation::Comment');
221 isa_ok($ann,'Bio::Annotation::Comment');
223 # factory guessing the type: Target
224 $factory = Bio::Annotation::AnnotationFactory->new();
225 $ann = $factory->create_object(-target_id => 'F1234',
226                                -start     => 1,
227                                -end       => 10 );
228 ok defined $ann;
229 isa_ok($ann,'Bio::Annotation::Target');
231 # factory guessing the type: OntologyTerm
232 $factory = Bio::Annotation::AnnotationFactory->new();
233 ok(defined ($ann = $factory->create_object(-name => 'peroxisome',
234                                            -tagname => 'cellular component')));
235 like(ref $ann, qr(Bio::Annotation::OntologyTerm));
237 # tree
238 my $tree_filename = test_input_file('longnames.dnd');
239 my $tree = Bio::TreeIO->new(-file=>$tree_filename)->next_tree();
240 my $ann_tree = Bio::Annotation::Tree->new(
241                                           -tagname  => 'tree',
242                                           -tree_obj => $tree,
243                                          );
245 isa_ok($ann_tree, 'Bio::AnnotationI');
246 $ann_tree->tree_id('test');
247 is $ann_tree->tree_id(), 'test', "tree_id()";
248 $ann_tree->tagname('tree');
249 is $ann_tree->tagname(), 'tree', "tagname()";
250 use Bio::AlignIO;
251 my $aln = Bio::AlignIO->new(-file  => test_input_file('longnames.aln'),
252                          -format=>'clustalw')->next_aln();
253 $ac = Bio::Annotation::Collection->new();
254 $ac->add_Annotation('tree',$ann_tree);
255 $aln->annotation($ac);
256 for my $treeblock ( $aln->annotation->get_Annotations('tree') ) {
257   my $treeref = $treeblock->tree();
258   my @nodes = sort { defined $a->id &&
259                        defined $b->id &&
260                          $a->id cmp $b->id } $treeref->get_nodes();
261   is(@nodes, 26);
262   is $nodes[12]->id, 'Skud_Contig1703.7', "add tree to AlignI";
263   my $str;
264   for my $seq ($aln->each_seq_with_id($nodes[12]->id)) {
265     $str = $seq->subseq(1,20);
266   }
267   is( $str, "-------------MPFAQIV", "get seq from node id");
270 # factory guessing the type: Tree
271 $factory = Bio::Annotation::AnnotationFactory->new();
272 $ann = $factory->create_object(-tree_obj => $tree);
273 ok defined $ann;
274 isa_ok($ann,'Bio::Annotation::Tree');
276 #tagtree
277 my $struct = [ 'genenames' => [
278                                ['genename' => [
279                                                [ 'Name' => 'CALM1' ],
280                                                ['Synonyms'=> 'CAM1'],
281                                                ['Synonyms'=> 'CALM'],
282                                                ['Synonyms'=> 'CAM' ] ] ],
283                                ['genename'=> [
284                                               [ 'Name'=> 'CALM2' ],
285                                               [ 'Synonyms'=> 'CAM2'],
286                                               [ 'Synonyms'=> 'CAMB'] ] ],
287                                [ 'genename'=> [
288                                                [ 'Name'=> 'CALM3' ],
289                                                [ 'Synonyms'=> 'CAM3' ],
290                                                [ 'Synonyms'=> 'CAMC' ] ] ]
291                               ] ];
293 my $ann_struct = Bio::Annotation::TagTree->new(-tagname => 'gn',
294                                                -value => $struct);
296 isa_ok($ann_struct, 'Bio::AnnotationI');
297 my $val = $ann_struct->value;
298 like($val, qr/Name: CALM1/,'default itext');
300 # roundtrip
301 my $ann_struct2 = Bio::Annotation::TagTree->new(-tagname => 'gn',
302                                                 -value => $val);
303 is($ann_struct2->value, $val,'roundtrip');
305 # formats
306 like($ann_struct2->value, qr/Name: CALM1/,'itext');
307 $ann_struct2->tagformat('sxpr');
308 like($ann_struct2->value, qr/\(Name "CALM1"\)/,'spxr');
309 $ann_struct2->tagformat('indent');
310 like($ann_struct2->value, qr/Name "CALM1"/,'indent');
312 SKIP: {
313     eval {require XML::Parser::PerlSAX};
314     skip ("XML::Parser::PerlSAX rquired for XML",1) if $@;
315     $ann_struct2->tagformat('xml');
316     like($ann_struct2->value, qr/<Name>CALM1<\/Name>/,'xml');
319 # grab Data::Stag nodes, use Data::Stag methods
320 my @nodes = $ann_struct2->children;
321 for my $node (@nodes) {
322     isa_ok($node, 'Data::Stag::StagI');
323     is($node->element, 'genename');
324     # add tag-value data to node
325     $node->set('foo', 'bar');
326     # check output
327     like($node->itext, qr/foo:\s+bar/,'child changes');
330 $ann_struct2->tagformat('itext');
331 like($ann_struct2->value, qr/foo:\s+bar/,'child changes in parent node');
333 # pass in a Data::Stag node to value()
334 $ann_struct = Bio::Annotation::TagTree->new(-tagname => 'mytags');
335 like($ann_struct->value, qr/^\s+:\s+$/xms, 'no tags');
336 like($ann_struct->value, qr/^\s+:\s+$/xms,'before Stag node');
337 $ann_struct->value($nodes[0]);
338 like($ann_struct->value, qr/Name: CALM1/,'after Stag node');
339 is(ref $ann_struct->node, ref $nodes[0], 'both stag nodes');
340 isnt($ann_struct->node, $nodes[0], 'different instances');
342 # pass in another TagTree to value()
343 $ann_struct = Bio::Annotation::TagTree->new(-tagname => 'mytags');
344 like($ann_struct->value, qr/^\s+:\s+$/xms,'before TagTree');
345 $ann_struct->value($ann_struct2);
346 like($ann_struct->value, qr/Name: CALM2/,'after TagTree');
347 is(ref $ann_struct->node, ref $ann_struct2->node, 'both stag nodes');
348 isnt($ann_struct->node, $ann_struct2->node, 'different instances');
350 # replace the Data::Stag node in the annotation (no copy)
351 $ann_struct = Bio::Annotation::TagTree->new(-tagname => 'mytags');
352 like($ann_struct->value, qr/^\s+:\s+$/xms,'before TagTree');
353 $ann_struct->node($nodes[1]);
354 like($ann_struct->value, qr/Name: CALM2/,'after TagTree');
355 is(ref $ann_struct->node, ref $ann_struct2->node, 'stag nodes');
356 is($ann_struct->node, $nodes[1], 'same instance');
357 # replace the Data::Stag node in the annotation (use duplicate)
358 $ann_struct = Bio::Annotation::TagTree->new(-tagname => 'mytags');
359 like($ann_struct->value, qr/^\s+:\s+$/xms,'before TagTree');
360 $ann_struct->node($nodes[1],'copy');
361 like($ann_struct->value, qr/Name: CALM2/,'after TagTree');
362 is(ref $ann_struct->node, ref $ann_struct2->node, 'stag nodes');
363 isnt($ann_struct->node, $nodes[1], 'different instance');
365 #check insertion in to collection
366 $ann_struct = Bio::Annotation::TagTree->new(-value => $struct);
367 $ac = Bio::Annotation::Collection->new();
369 $ac->add_Annotation('genenames',$ann_struct);
370 my $ct = 0;
371 for my $tagtree ( $ac->get_Annotations('genenames') ) {
372   isa_ok($tagtree, 'Bio::AnnotationI');
373   for my $node ($tagtree->children) {
374     isa_ok($node, 'Data::Stag::StagI');
375     like($node->itext, qr/Name:\s+CALM/,'child changes');
376     $ct++;
377   }
379 is($ct,3);
381 # factory guessing the type: TagTree
382 $factory = Bio::Annotation::AnnotationFactory->new();
383 $ann = $factory->create_object(-value => $struct);
384 ok defined $ann;
385 isa_ok($ann,'Bio::Annotation::TagTree');