t/Annotation.t

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