0
|
1 # $Id: Collection.pm,v 1.16 2002/11/22 22:48:25 birney Exp $
|
|
2
|
|
3 #
|
|
4 # BioPerl module for Bio::Annotation::Collection.pm
|
|
5 #
|
|
6 # Cared for by Ewan Birney <birney@ebi.ac.uk>
|
|
7 #
|
|
8 # Copyright Ewan Birney
|
|
9 #
|
|
10 # You may distribute this module under the same terms as perl itself
|
|
11
|
|
12 # POD documentation - main docs before the code
|
|
13
|
|
14 =head1 NAME
|
|
15
|
|
16 Bio::Annotation::Collection - Default Perl implementation of AnnotationCollectionI
|
|
17
|
|
18 =head1 SYNOPSIS
|
|
19
|
|
20 # get an AnnotationCollectionI somehow, eg
|
|
21
|
|
22 $ac = $seq->annotation();
|
|
23
|
|
24 foreach $key ( $ac->get_all_annotation_keys() ) {
|
|
25 @values = $ac->get_Annotations($key);
|
|
26 foreach $value ( @values ) {
|
|
27 # value is an Bio::AnnotationI, and defines a "as_text" method
|
|
28 print "Annotation ",$key," stringified value ",$value->as_text,"\n";
|
|
29
|
|
30 # also defined hash_tree method, which allows data orientated
|
|
31 # access into this object
|
|
32 $hash = $value->hash_tree();
|
|
33 }
|
|
34 }
|
|
35
|
|
36 =head1 DESCRIPTION
|
|
37
|
|
38 Bioperl implementation for Bio::AnnotationCollecitonI
|
|
39
|
|
40 =head1 FEEDBACK
|
|
41
|
|
42 =head2 Mailing Lists
|
|
43
|
|
44 User feedback is an integral part of the evolution of this and other
|
|
45 Bioperl modules. Send your comments and suggestions preferably to one
|
|
46 of the Bioperl mailing lists. Your participation is much appreciated.
|
|
47
|
|
48 bioperl-l@bioperl.org - General discussion
|
|
49 http://bio.perl.org/MailList.html - About the mailing lists
|
|
50
|
|
51 =head2 Reporting Bugs
|
|
52
|
|
53 Report bugs to the Bioperl bug tracking system to help us keep track
|
|
54 the bugs and their resolution. Bug reports can be submitted via email
|
|
55 or the web:
|
|
56
|
|
57 bioperl-bugs@bioperl.org
|
|
58 http://bugzilla.bioperl.org/
|
|
59
|
|
60 =head1 AUTHOR - Ewan Birney
|
|
61
|
|
62 Email birney@ebi.ac.uk
|
|
63
|
|
64 =head1 APPENDIX
|
|
65
|
|
66 The rest of the documentation details each of the object
|
|
67 methods. Internal methods are usually preceded with a _
|
|
68
|
|
69 =cut
|
|
70
|
|
71
|
|
72 # Let the code begin...
|
|
73
|
|
74
|
|
75 package Bio::Annotation::Collection;
|
|
76
|
|
77 use vars qw(@ISA);
|
|
78 use strict;
|
|
79
|
|
80 # Object preamble - inherits from Bio::Root::Root
|
|
81
|
|
82 use Bio::AnnotationCollectionI;
|
|
83 use Bio::AnnotationI;
|
|
84 use Bio::Root::Root;
|
|
85 use Bio::Annotation::TypeManager;
|
|
86 use Bio::Annotation::SimpleValue;
|
|
87
|
|
88
|
|
89 @ISA = qw(Bio::Root::Root Bio::AnnotationCollectionI Bio::AnnotationI);
|
|
90
|
|
91
|
|
92 =head2 new
|
|
93
|
|
94 Title : new
|
|
95 Usage : $coll = Bio::Annotation::Collection->new()
|
|
96 Function: Makes a new Annotation::Collection object.
|
|
97 Returns : Bio::Annotation::Collection
|
|
98 Args : none
|
|
99
|
|
100 =cut
|
|
101
|
|
102 sub new{
|
|
103 my ($class,@args) = @_;
|
|
104
|
|
105 my $self = $class->SUPER::new(@args);
|
|
106
|
|
107 $self->{'_annotation'} = {};
|
|
108 $self->_typemap(Bio::Annotation::TypeManager->new());
|
|
109
|
|
110 return $self;
|
|
111 }
|
|
112
|
|
113
|
|
114 =head1 L<Bio::AnnotationCollectionI> implementing methods
|
|
115
|
|
116 =cut
|
|
117
|
|
118 =head2 get_all_annotation_keys
|
|
119
|
|
120 Title : get_all_annotation_keys
|
|
121 Usage : $ac->get_all_annotation_keys()
|
|
122 Function: gives back a list of annotation keys, which are simple text strings
|
|
123 Returns : list of strings
|
|
124 Args : none
|
|
125
|
|
126 =cut
|
|
127
|
|
128 sub get_all_annotation_keys{
|
|
129 my ($self) = @_;
|
|
130 return keys %{$self->{'_annotation'}};
|
|
131 }
|
|
132
|
|
133 =head2 get_Annotations
|
|
134
|
|
135 Title : get_Annotations
|
|
136 Usage : my @annotations = $collection->get_Annotations('key')
|
|
137 Function: Retrieves all the Bio::AnnotationI objects for one or more
|
|
138 specific key(s).
|
|
139
|
|
140 If no key is given, returns all annotation objects.
|
|
141
|
|
142 The returned objects will have their tagname() attribute set to
|
|
143 the key under which they were attached, unless the tagname was
|
|
144 already set.
|
|
145
|
|
146 Returns : list of Bio::AnnotationI - empty if no objects stored for a key
|
|
147 Args : keys (list of strings) for annotations (optional)
|
|
148
|
|
149 =cut
|
|
150
|
|
151 sub get_Annotations{
|
|
152 my ($self,@keys) = @_;
|
|
153
|
|
154 my @anns = ();
|
|
155 @keys = $self->get_all_annotation_keys() unless @keys;
|
|
156 foreach my $key (@keys) {
|
|
157 if(exists($self->{'_annotation'}->{$key})) {
|
|
158 push(@anns,
|
|
159 map {
|
|
160 $_->tagname($key) if ! $_->tagname(); $_;
|
|
161 } @{$self->{'_annotation'}->{$key}});
|
|
162 }
|
|
163 }
|
|
164 return @anns;
|
|
165 }
|
|
166
|
|
167 =head2 get_all_Annotations
|
|
168
|
|
169 Title : get_all_Annotations
|
|
170 Usage :
|
|
171 Function: Similar to get_Annotations, but traverses and flattens nested
|
|
172 annotation collections. This means that collections in the
|
|
173 tree will be replaced by their components.
|
|
174
|
|
175 Keys will not be passed on to nested collections. I.e., if the
|
|
176 tag name of a nested collection matches the key, it will be
|
|
177 flattened in its entirety.
|
|
178
|
|
179 Hence, for un-nested annotation collections this will be identical
|
|
180 to get_Annotations.
|
|
181 Example :
|
|
182 Returns : an array of L<Bio::AnnotationI> compliant objects
|
|
183 Args : keys (list of strings) for annotations (optional)
|
|
184
|
|
185
|
|
186 =cut
|
|
187
|
|
188 sub get_all_Annotations{
|
|
189 my ($self,@keys) = @_;
|
|
190
|
|
191 return map {
|
|
192 $_->isa("Bio::AnnotationCollectionI") ?
|
|
193 $_->get_all_Annotations() : $_;
|
|
194 } $self->get_Annotations(@keys);
|
|
195 }
|
|
196
|
|
197 =head2 get_num_of_annotations
|
|
198
|
|
199 Title : get_num_of_annotations
|
|
200 Usage : my $count = $collection->get_num_of_annotations()
|
|
201 Function: Returns the count of all annotations stored in this collection
|
|
202 Returns : integer
|
|
203 Args : none
|
|
204
|
|
205
|
|
206 =cut
|
|
207
|
|
208 sub get_num_of_annotations{
|
|
209 my ($self) = @_;
|
|
210 my $count = 0;
|
|
211 map { $count += scalar @$_ } values %{$self->{'_annotation'}};
|
|
212 return $count;
|
|
213 }
|
|
214
|
|
215 =head1 Implementation specific functions - mainly for adding
|
|
216
|
|
217 =cut
|
|
218
|
|
219 =head2 add_Annotation
|
|
220
|
|
221 Title : add_Annotation
|
|
222 Usage : $self->add_Annotation('reference',$object);
|
|
223 $self->add_Annotation($object,'Bio::MyInterface::DiseaseI');
|
|
224 $self->add_Annotation($object);
|
|
225 $self->add_Annotation('disease',$object,'Bio::MyInterface::DiseaseI');
|
|
226 Function: Adds an annotation for a specific key.
|
|
227
|
|
228 If the key is omitted, the object to be added must provide a value
|
|
229 via its tagname().
|
|
230
|
|
231 If the archetype is provided, this and future objects added under
|
|
232 that tag have to comply with the archetype and will be rejected
|
|
233 otherwise.
|
|
234
|
|
235 Returns : none
|
|
236 Args : annotation key ('disease', 'dblink', ...)
|
|
237 object to store (must be Bio::AnnotationI compliant)
|
|
238 [optional] object archetype to map future storage of object
|
|
239 of these types to
|
|
240
|
|
241 =cut
|
|
242
|
|
243 sub add_Annotation{
|
|
244 my ($self,$key,$object,$archetype) = @_;
|
|
245
|
|
246 # if there's no key we use the tagname() as key
|
|
247 if(ref($key) && $key->isa("Bio::AnnotationI") &&
|
|
248 (! ($object && ref($object)))) {
|
|
249 $archetype = $object if $object;
|
|
250 $object = $key;
|
|
251 $key = $object->tagname();
|
|
252 $key = $key->name() if $key && ref($key); # OntologyTermI
|
|
253 $self->throw("Annotation object must have a tagname if key omitted")
|
|
254 unless $key;
|
|
255 }
|
|
256
|
|
257 if( !defined $object ) {
|
|
258 $self->throw("Must have at least key and object in add_Annotation");
|
|
259 }
|
|
260
|
|
261 if( !ref $object ) {
|
|
262 $self->throw("Must add an object. Use Bio::Annotation::{Comment,SimpleValue,OntologyTerm} for simple text additions");
|
|
263 }
|
|
264
|
|
265 if( !$object->isa("Bio::AnnotationI") ) {
|
|
266 $self->throw("object must be AnnotationI compliant, otherwise we wont add it!");
|
|
267 }
|
|
268
|
|
269 # ok, now we are ready! If we don't have an archetype, set it
|
|
270 # from the type of the object
|
|
271
|
|
272 if( !defined $archetype ) {
|
|
273 $archetype = ref $object;
|
|
274 }
|
|
275
|
|
276 # check typemap, storing if needed.
|
|
277 my $stored_map = $self->_typemap->type_for_key($key);
|
|
278
|
|
279 if( defined $stored_map ) {
|
|
280 # check validity, irregardless of archetype. A little cheeky
|
|
281 # this means isa stuff is executed correctly
|
|
282
|
|
283 if( !$self->_typemap()->is_valid($key,$object) ) {
|
|
284 $self->throw("Object $object was not valid with key $key. If you were adding new keys in, perhaps you want to make use of the archetype method to allow registration to a more basic type");
|
|
285 }
|
|
286 } else {
|
|
287 $self->_typemap->_add_type_map($key,$archetype);
|
|
288 }
|
|
289
|
|
290 # we are ok to store
|
|
291
|
|
292 if( !defined $self->{'_annotation'}->{$key} ) {
|
|
293 $self->{'_annotation'}->{$key} = [];
|
|
294 }
|
|
295
|
|
296 push(@{$self->{'_annotation'}->{$key}},$object);
|
|
297
|
|
298 return 1;
|
|
299 }
|
|
300
|
|
301 =head2 remove_Annotations
|
|
302
|
|
303 Title : remove_Annotations
|
|
304 Usage :
|
|
305 Function: Remove the annotations for the specified key from this collection.
|
|
306 Example :
|
|
307 Returns : an array Bio::AnnotationI compliant objects which were stored
|
|
308 under the given key(s)
|
|
309 Args : the key(s) (tag name(s), one or more strings) for which to
|
|
310 remove annotations (optional; if none given, flushes all
|
|
311 annotations)
|
|
312
|
|
313
|
|
314 =cut
|
|
315
|
|
316 sub remove_Annotations{
|
|
317 my ($self, @keys) = @_;
|
|
318
|
|
319 @keys = $self->get_all_annotation_keys() unless @keys;
|
|
320 my @anns = $self->get_Annotations(@keys);
|
|
321 # flush
|
|
322 foreach (@keys) {
|
|
323 delete $self->{'_annotation'}->{$_};
|
|
324 }
|
|
325 return @anns;
|
|
326 }
|
|
327
|
|
328 =head2 flatten_Annotations
|
|
329
|
|
330 Title : flatten_Annotations
|
|
331 Usage :
|
|
332 Function: Flattens part or all of the annotations in this collection.
|
|
333
|
|
334 This is a convenience method for getting the flattened
|
|
335 annotation for the given keys, removing the annotation for
|
|
336 those keys, and adding back the flattened array.
|
|
337
|
|
338 This should not change anything for un-nested collections.
|
|
339 Example :
|
|
340 Returns : an array Bio::AnnotationI compliant objects which were stored
|
|
341 under the given key(s)
|
|
342 Args : list of keys (strings) the annotation for which to flatten,
|
|
343 defaults to all keys if not given
|
|
344
|
|
345
|
|
346 =cut
|
|
347
|
|
348 sub flatten_Annotations{
|
|
349 my ($self,@keys) = @_;
|
|
350
|
|
351 my @anns = $self->get_all_Annotations(@keys);
|
|
352 my @origanns = $self->remove_Annotations(@keys);
|
|
353 foreach (@anns) {
|
|
354 $self->add_Annotation($_);
|
|
355 }
|
|
356 return @origanns;
|
|
357 }
|
|
358
|
|
359 =head1 Bio::AnnotationI methods implementations
|
|
360
|
|
361 This is to allow nested annotation: you can a collection as an
|
|
362 annotation object to an annotation collection.
|
|
363
|
|
364 =cut
|
|
365
|
|
366 =head2 as_text
|
|
367
|
|
368 Title : as_text
|
|
369 Usage :
|
|
370 Function: See L<Bio::AnnotationI>
|
|
371 Example :
|
|
372 Returns : a string
|
|
373 Args : none
|
|
374
|
|
375
|
|
376 =cut
|
|
377
|
|
378 sub as_text{
|
|
379 my $self = shift;
|
|
380
|
|
381 my $txt = "Collection consisting of ";
|
|
382 my @texts = ();
|
|
383 foreach my $ann ($self->get_Annotations()) {
|
|
384 push(@texts, $ann->as_text());
|
|
385 }
|
|
386 if(@texts) {
|
|
387 $txt .= join(", ", map { '['.$_.']'; } @texts);
|
|
388 } else {
|
|
389 $txt .= "no elements";
|
|
390 }
|
|
391 return $txt;
|
|
392 }
|
|
393
|
|
394 =head2 hash_tree
|
|
395
|
|
396 Title : hash_tree
|
|
397 Usage :
|
|
398 Function: See L<Bio::AnnotationI>
|
|
399 Example :
|
|
400 Returns : a hash reference
|
|
401 Args : none
|
|
402
|
|
403
|
|
404 =cut
|
|
405
|
|
406 sub hash_tree{
|
|
407 my $self = shift;
|
|
408 my $tree = {};
|
|
409
|
|
410 foreach my $key ($self->get_all_annotation_keys()) {
|
|
411 # all contained objects will support hash_tree()
|
|
412 # (they are AnnotationIs)
|
|
413 $tree->{$key} = [$self->get_Annotations($key)];
|
|
414 }
|
|
415 return $tree;
|
|
416 }
|
|
417
|
|
418 =head2 tagname
|
|
419
|
|
420 Title : tagname
|
|
421 Usage : $obj->tagname($newval)
|
|
422 Function: Get/set the tagname for this annotation value.
|
|
423
|
|
424 Setting this is optional. If set, it obviates the need to
|
|
425 provide a tag to Bio::AnnotationCollectionI when adding
|
|
426 this object. When obtaining an AnnotationI object from the
|
|
427 collection, the collection will set the value to the tag
|
|
428 under which it was stored unless the object has a tag
|
|
429 stored already.
|
|
430
|
|
431 Example :
|
|
432 Returns : value of tagname (a scalar)
|
|
433 Args : new value (a scalar, optional)
|
|
434
|
|
435
|
|
436 =cut
|
|
437
|
|
438 sub tagname{
|
|
439 my $self = shift;
|
|
440
|
|
441 return $self->{'tagname'} = shift if @_;
|
|
442 return $self->{'tagname'};
|
|
443 }
|
|
444
|
|
445
|
|
446 =head1 Backward compatible functions
|
|
447
|
|
448 Functions put in for backward compatibility with old
|
|
449 Bio::Annotation.pm stuff
|
|
450
|
|
451 =cut
|
|
452
|
|
453 =head2 description
|
|
454
|
|
455 Title : description
|
|
456 Usage :
|
|
457 Function:
|
|
458 Example :
|
|
459 Returns :
|
|
460 Args :
|
|
461
|
|
462
|
|
463 =cut
|
|
464
|
|
465 sub description{
|
|
466 my ($self,$value) = @_;
|
|
467
|
|
468 $self->deprecated("Using old style annotation call on new Annotation::Collection object");
|
|
469
|
|
470 if( defined $value ) {
|
|
471 my $val = Bio::Annotation::SimpleValue->new();
|
|
472 $val->value($value);
|
|
473 $self->add_Annotation('description',$val);
|
|
474 }
|
|
475
|
|
476 my ($desc) = $self->get_Annotations('description');
|
|
477
|
|
478 # If no description tag exists, do not attempt to call value on undef:
|
|
479 return $desc ? $desc->value : undef;
|
|
480 }
|
|
481
|
|
482
|
|
483 =head2 add_gene_name
|
|
484
|
|
485 Title : add_gene_name
|
|
486 Usage :
|
|
487 Function:
|
|
488 Example :
|
|
489 Returns :
|
|
490 Args :
|
|
491
|
|
492
|
|
493 =cut
|
|
494
|
|
495 sub add_gene_name{
|
|
496 my ($self,$value) = @_;
|
|
497
|
|
498 $self->deprecated("Old style add_gene_name called on new style Annotation::Collection");
|
|
499
|
|
500 my $val = Bio::Annotation::SimpleValue->new();
|
|
501 $val->value($value);
|
|
502 $self->add_Annotation('gene_name',$val);
|
|
503 }
|
|
504
|
|
505 =head2 each_gene_name
|
|
506
|
|
507 Title : each_gene_name
|
|
508 Usage :
|
|
509 Function:
|
|
510 Example :
|
|
511 Returns :
|
|
512 Args :
|
|
513
|
|
514
|
|
515 =cut
|
|
516
|
|
517 sub each_gene_name{
|
|
518 my ($self) = @_;
|
|
519
|
|
520 $self->deprecated("Old style each_gene_name called on new style Annotation::Collection");
|
|
521
|
|
522 my @out;
|
|
523 my @gene = $self->get_Annotations('gene_name');
|
|
524
|
|
525 foreach my $g ( @gene ) {
|
|
526 push(@out,$g->value);
|
|
527 }
|
|
528
|
|
529 return @out;
|
|
530 }
|
|
531
|
|
532 =head2 add_Reference
|
|
533
|
|
534 Title : add_Reference
|
|
535 Usage :
|
|
536 Function:
|
|
537 Example :
|
|
538 Returns :
|
|
539 Args :
|
|
540
|
|
541
|
|
542 =cut
|
|
543
|
|
544 sub add_Reference{
|
|
545 my ($self, @values) = @_;
|
|
546
|
|
547 $self->deprecated("add_Reference (old style Annotation) on new style Annotation::Collection");
|
|
548
|
|
549 # Allow multiple (or no) references to be passed, as per old method
|
|
550 foreach my $value (@values) {
|
|
551 $self->add_Annotation('reference',$value);
|
|
552 }
|
|
553 }
|
|
554
|
|
555 =head2 each_Reference
|
|
556
|
|
557 Title : each_Reference
|
|
558 Usage :
|
|
559 Function:
|
|
560 Example :
|
|
561 Returns :
|
|
562 Args :
|
|
563
|
|
564
|
|
565 =cut
|
|
566
|
|
567 sub each_Reference{
|
|
568 my ($self) = @_;
|
|
569
|
|
570 $self->deprecated("each_Reference (old style Annotation) on new style Annotation::Collection");
|
|
571
|
|
572 return $self->get_Annotations('reference');
|
|
573 }
|
|
574
|
|
575
|
|
576 =head2 add_Comment
|
|
577
|
|
578 Title : add_Comment
|
|
579 Usage :
|
|
580 Function:
|
|
581 Example :
|
|
582 Returns :
|
|
583 Args :
|
|
584
|
|
585
|
|
586 =cut
|
|
587
|
|
588 sub add_Comment{
|
|
589 my ($self,$value) = @_;
|
|
590
|
|
591 $self->deprecated("add_Comment (old style Annotation) on new style Annotation::Collection");
|
|
592
|
|
593 $self->add_Annotation('comment',$value);
|
|
594
|
|
595 }
|
|
596
|
|
597 =head2 each_Comment
|
|
598
|
|
599 Title : each_Comment
|
|
600 Usage :
|
|
601 Function:
|
|
602 Example :
|
|
603 Returns :
|
|
604 Args :
|
|
605
|
|
606
|
|
607 =cut
|
|
608
|
|
609 sub each_Comment{
|
|
610 my ($self) = @_;
|
|
611
|
|
612 $self->deprecated("each_Comment (old style Annotation) on new style Annotation::Collection");
|
|
613
|
|
614 return $self->get_Annotations('comment');
|
|
615 }
|
|
616
|
|
617
|
|
618
|
|
619 =head2 add_DBLink
|
|
620
|
|
621 Title : add_DBLink
|
|
622 Usage :
|
|
623 Function:
|
|
624 Example :
|
|
625 Returns :
|
|
626 Args :
|
|
627
|
|
628
|
|
629 =cut
|
|
630
|
|
631 sub add_DBLink{
|
|
632 my ($self,$value) = @_;
|
|
633
|
|
634 $self->deprecated("add_DBLink (old style Annotation) on new style Annotation::Collection");
|
|
635
|
|
636 $self->add_Annotation('dblink',$value);
|
|
637
|
|
638 }
|
|
639
|
|
640 =head2 each_DBLink
|
|
641
|
|
642 Title : each_DBLink
|
|
643 Usage :
|
|
644 Function:
|
|
645 Example :
|
|
646 Returns :
|
|
647 Args :
|
|
648
|
|
649
|
|
650 =cut
|
|
651
|
|
652 sub each_DBLink{
|
|
653 my ($self) = @_;
|
|
654
|
|
655 $self->deprecated("each_DBLink (old style Annotation) on new style Annotation::Collection - use get_Annotations('dblink')");
|
|
656
|
|
657 return $self->get_Annotations('dblink');
|
|
658 }
|
|
659
|
|
660
|
|
661
|
|
662 =head1 Implementation management functions
|
|
663
|
|
664 =cut
|
|
665
|
|
666 =head2 _typemap
|
|
667
|
|
668 Title : _typemap
|
|
669 Usage : $obj->_typemap($newval)
|
|
670 Function:
|
|
671 Example :
|
|
672 Returns : value of _typemap
|
|
673 Args : newvalue (optional)
|
|
674
|
|
675
|
|
676 =cut
|
|
677
|
|
678 sub _typemap{
|
|
679 my ($self,$value) = @_;
|
|
680 if( defined $value) {
|
|
681 $self->{'_typemap'} = $value;
|
|
682 }
|
|
683 return $self->{'_typemap'};
|
|
684
|
|
685 }
|
|
686
|
|
687 1;
|