Bio/SeqFeature/AnnotationAdaptor.pm

   1 # $Id$
   2 #
   3 # BioPerl module for Bio::SeqFeature::AnnotationAdaptor
   4 #
   5 # Please direct questions and support issues to <bioperl-l@bioperl.org>
   6 #
   7 # Cared for by Hilmar Lapp <hlapp at gmx.net>
   8 #
   9 # Copyright Hilmar Lapp
  10 #
  11 # You may distribute this module under the same terms as perl itself
  12
  13 #
  14 # (c) Hilmar Lapp, hlapp at gmx.net, 2002.
  15 # (c) GNF, Genomics Institute of the Novartis Research Foundation, 2002.
  16 #
  17 # You may distribute this module under the same terms as perl itself.
  18 # Refer to the Perl Artistic License (see the license accompanying this
  19 # software package, or see http://www.perl.com/language/misc/Artistic.html)
  20 # for the terms under which you may use, modify, and redistribute this module.
  21 #
  22 # THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
  23 # WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
  24 # MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
  25 #
  26
  27 # POD documentation - main docs before the code
  28
  29 =head1 NAME
  30
  31 Bio::SeqFeature::AnnotationAdaptor - integrates SeqFeatureIs annotation
  32
  33 =head1 SYNOPSIS
  34
  35    use Bio::SeqFeature::Generic;
  36    use Bio::SeqFeature::AnnotationAdaptor;
  37
  38    # obtain a SeqFeatureI implementing object somehow
  39    my $feat = Bio::SeqFeature::Generic->new(-start => 10, -end => 20);
  40
  41    # add tag/value annotation
  42    $feat->add_tag_value("mytag", "value of tag mytag");
  43    $feat->add_tag_value("mytag", "another value of tag mytag");
  44
  45    # Bio::SeqFeature::Generic also provides annotation(), which returns a
  46    # Bio::AnnotationCollectionI compliant object
  47    $feat->annotation->add_Annotation("dbxref", $dblink);
  48
  49    # to integrate tag/value annotation with AnnotationCollectionI
  50    # annotation, use this adaptor, which also implements
  51    # Bio::AnnotationCollectionI
  52    my $anncoll = Bio::SeqFeature::AnnotationAdaptor->new(-feature => $feat);
  53
  54    # this will now return tag/value pairs as
  55    # Bio::Annotation::SimpleValue objects
  56    my @anns = $anncoll->get_Annotations("mytag");
  57    # other added before annotation is available too
  58    my @dblinks = $anncoll->get_Annotations("dbxref");
  59
  60    # also supports transparent adding of tag/value pairs in
  61    # Bio::AnnotationI flavor
  62    my $tagval = Bio::Annotation::SimpleValue->new(-value => "some value",
  63                                                   -tagname => "some tag");
  64    $anncoll->add_Annotation($tagval);
  65    # this is now also available from the feature's tag/value system
  66    my @vals = $feat->each_tag_value("some tag");
  67
  68 =head1 DESCRIPTION
  69
  70 L<Bio::SeqFeatureI> defines light-weight annotation of features
  71 through tag/value pairs. Conversely, L<Bio::AnnotationCollectionI>
  72 together with L<Bio::AnnotationI> defines an annotation bag, which is
  73 better typed, but more heavy-weight because it contains every single
  74 piece of annotation as objects. The frequently used base
  75 implementation of Bio::SeqFeatureI, Bio::SeqFeature::Generic, defines
  76 an additional slot for AnnotationCollectionI-compliant annotation.
  77
  78 This adaptor provides a L<Bio::AnnotationCollectionI> compliant,
  79 unified, and integrated view on the annotation of L<Bio::SeqFeatureI>
  80 objects, including tag/value pairs, and annotation through the
  81 annotation() method, if the object supports it. Code using this
  82 adaptor does not need to worry about the different ways of possibly
  83 annotating a SeqFeatureI object, but can instead assume that it
  84 strictly follows the AnnotationCollectionI scheme. The price to pay is
  85 that retrieving and adding annotation will always use objects instead
  86 of light-weight tag/value pairs.
  87
  88 In other words, this adaptor allows us to keep the best of both
  89 worlds. If you create tens of thousands of feature objects, and your
  90 only annotation is tag/value pairs, you are best off using the
  91 features' native tag/value system. If you create a smaller number of
  92 features, but with rich and typed annotation mixed with tag/value
  93 pairs, this adaptor may be for you. Since its implementation is by
  94 double-composition, you only need to create one instance of the
  95 adaptor. In order to transparently annotate a feature object, set the
  96 feature using the feature() method. Every annotation you add will be
  97 added to the feature object, and hence will not be lost when you set
  98 feature() to the next object.
  99
 100 =head1 FEEDBACK
 101
 102 =head2 Mailing Lists
 103
 104 User feedback is an integral part of the evolution of this and other
 105 Bioperl modules. Send your comments and suggestions preferably to
 106 the Bioperl mailing list.  Your participation is much appreciated.
 107
 108   bioperl-l@bioperl.org                  - General discussion
 109   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
 110
 111 =head2 Support
 112
 113 Please direct usage questions or support issues to the mailing list:
 114
 115 L<bioperl-l@bioperl.org>
 116
 117 rather than to the module maintainer directly. Many experienced and
 118 reponsive experts will be able look at the problem and quickly
 119 address it. Please include a thorough description of the problem
 120 with code and data examples if at all possible.
 121
 122 =head2 Reporting Bugs
 123
 124 Report bugs to the Bioperl bug tracking system to help us keep track
 125 of the bugs and their resolution. Bug reports can be submitted via the
 126 web:
 127
 128   http://bugzilla.open-bio.org/
 129
 130 =head1 AUTHOR - Hilmar Lapp
 131
 132 Email hlapp at gmx.net
 133
 134 =head1 APPENDIX
 135
 136 The rest of the documentation details each of the object methods.
 137 Internal methods are usually preceded with a _
 138
 139 =cut
 140
 141
 142 #' Let the code begin...
 143
 144
 145 package Bio::SeqFeature::AnnotationAdaptor;
 146 use strict;
 147
 148 # Object preamble - inherits from Bio::Root::Root
 149
 150 use Bio::Annotation::SimpleValue;
 151
 152 use base qw(Bio::Root::Root Bio::AnnotationCollectionI Bio::AnnotatableI);
 153
 154 =head2 new
 155
 156  Title   : new
 157  Usage   : my $obj = Bio::SeqFeature::AnnotationAdaptor->new();
 158  Function: Builds a new Bio::SeqFeature::AnnotationAdaptor object
 159  Returns : an instance of Bio::SeqFeature::AnnotationAdaptor
 160  Args    : Named parameters
 161             -feature    the Bio::SeqFeatureI implementing object to adapt
 162                         (mandatory to be passed here, or set via feature()
 163                         before calling other methods)
 164             -annotation the Bio::AnnotationCollectionI implementing object
 165                         for storing richer annotation (this will default to
 166                         the $feature->annotation() if it supports it)
 167             -tagvalue_factory the object factory to use for creating tag/value
 168                         pair representing objects
 169
 170
 171 =cut
 172
 173 sub new {
 174   my($class,@args) = @_;
 175
 176   my $self = $class->SUPER::new(@args);
 177
 178   my ($feat,$anncoll,$fact) =
 179         $self->_rearrange([qw(FEATURE
 180                           ANNOTATION
 181                           TAGVALUE_FACTORY)], @args);
 182
 183   $self->feature($feat) if $feat;
 184   $self->annotation($anncoll) if $feat;
 185   $self->tagvalue_object_factory($fact) if $fact;
 186
 187   return $self;
 188 }
 189
 190 =head2 feature
 191
 192  Title   : feature
 193  Usage   : $obj->feature($newval)
 194  Function: Get/set the feature that this object adapts to an
 195            AnnotationCollectionI.
 196  Example :
 197  Returns : value of feature (a Bio::SeqFeatureI compliant object)
 198  Args    : new value (a Bio::SeqFeatureI compliant object, optional)
 199
 200
 201 =cut
 202
 203 sub feature{
 204     my ($self,$value) = @_;
 205     if( defined $value) {
 206         $self->{'feature'} = $value;
 207     }
 208     return $self->{'feature'};
 209 }
 210
 211 =head2 annotation
 212
 213  Title   : annotation
 214  Usage   : $obj->annotation($newval)
 215  Function: Get/set the AnnotationCollectionI implementing object used by
 216            this adaptor to store additional annotation that cannot be stored
 217            by the SeqFeatureI itself.
 218
 219            If requested before having been set, the value will default to the
 220            annotation object of the feature if it has one.
 221  Example :
 222  Returns : value of annotation (a Bio::AnnotationCollectionI compliant object)
 223  Args    : new value (a Bio::AnnotationCollectionI compliant object, optional)
 224
 225
 226 =cut
 227
 228 sub annotation{
 229     my ($self,$value) = @_;
 230
 231     if( defined $value) {
 232         $self->{'annotation'} = $value;
 233     }
 234     if((! exists($self->{'annotation'})) &&
 235        $self->feature()->can('annotation')) {
 236         return $self->feature()->annotation();
 237     }
 238     return $self->{'annotation'};
 239 }
 240
 241 =head1 AnnotationCollectionI implementing methods
 242
 243 =cut
 244
 245 =head2 get_all_annotation_keys
 246
 247  Title   : get_all_annotation_keys
 248  Usage   : $ac->get_all_annotation_keys()
 249  Function: gives back a list of annotation keys, which are simple text strings
 250  Returns : list of strings
 251  Args    : none
 252
 253 =cut
 254
 255 sub get_all_annotation_keys{
 256     my ($self) = @_;
 257     my @keys = ();
 258
 259     # get the tags from the feature object
 260     if ($self->feature()->can('get_all_tags')) {
 261         push(@keys, $self->feature()->get_all_tags());
 262     } else {
 263         push(@keys, $self->feature()->all_tags());
 264     }
 265     # ask the annotation implementation in addition, while avoiding duplicates
 266     if($self->annotation()) {
 267         push(@keys,
 268              grep { ! $self->feature->has_tag($_); }
 269                   $self->annotation()->get_all_annotation_keys());
 270     }
 271     # done
 272     return @keys;
 273 }
 274
 275
 276 =head2 get_Annotations
 277
 278  Title   : get_Annotations
 279  Usage   : my @annotations = $collection->get_Annotations('key')
 280  Function: Retrieves all the Bio::AnnotationI objects for a specific key
 281  Returns : list of Bio::AnnotationI - empty if no objects stored for a key
 282  Args    : string which is key for annotations
 283
 284 =cut
 285
 286 sub get_Annotations{
 287     my ($self, @keys) = @_;
 288     my @anns = ();
 289
 290     # we need a annotation object factory
 291     my $fact = $self->tagvalue_object_factory();
 292
 293     # get all tags if no keys have been provided
 294     @keys = $self->feature->all_tags() unless @keys;
 295
 296     # build object for each value for each tag
 297     foreach my $key (@keys) {
 298       # protect against keys that aren't tags
 299       next unless $self->feature->has_tag($key);
 300       # add each tag/value pair as a SimpleValue object
 301       foreach my $val ($self->feature()->get_tag_values($key)) {
 302        my $ann;
 303        if($fact) {
 304           $ann = $fact->create_object(-value => $val, -tagname => $key);
 305        } else {
 306           $ann = Bio::Annotation::SimpleValue->new(-value => $val,
 307                                                    -tagname => $key);
 308        }
 309        push(@anns, $ann);
 310       }
 311     }
 312
 313     # add what is in the annotation implementation if any
 314     if($self->annotation()) {
 315       push(@anns, $self->annotation->get_Annotations(@keys));
 316     }
 317
 318     # done
 319     return @anns;
 320 }
 321
 322 =head2 get_num_of_annotations
 323
 324  Title   : get_num_of_annotations
 325  Usage   : my $count = $collection->get_num_of_annotations()
 326  Function: Returns the count of all annotations stored in this collection
 327  Returns : integer
 328  Args    : none
 329
 330
 331 =cut
 332
 333 sub get_num_of_annotations{
 334   my ($self) = @_;
 335
 336   # first, count the number of tags on the feature
 337   my $num_anns = 0;
 338
 339   foreach ($self->feature()->all_tags()) {
 340         $num_anns += scalar( $self->feature()->each_tag_value($_));
 341   }
 342
 343   # add from the annotation implementation if any
 344   if($self->annotation()) {
 345         $num_anns += $self->annotation()->get_num_of_annotations();
 346   }
 347
 348   # done
 349   return $num_anns;
 350 }
 351
 352 =head1 Implementation specific functions - to allow adding
 353
 354 =cut
 355
 356 =head2 add_Annotation
 357
 358  Title   : add_Annotation
 359  Usage   : $self->add_Annotation('reference',$object);
 360            $self->add_Annotation($object,'Bio::MyInterface::DiseaseI');
 361            $self->add_Annotation($object);
 362            $self->add_Annotation('disease',$object,'Bio::MyInterface::DiseaseI');
 363  Function: Adds an annotation for a specific key.
 364
 365            If the key is omitted, the object to be added must provide a value
 366            via its tagname().
 367
 368            If the archetype is provided, this and future objects added under
 369            that tag have to comply with the archetype and will be rejected
 370            otherwise.
 371
 372            This implementation will add all Bio::Annotation::SimpleValue
 373            objects to the adapted features as tag/value pairs. Caveat: this
 374            may potentially result in information loss if a derived object
 375            is supplied.
 376
 377  Returns : none
 378  Args    : annotation key ('disease', 'dblink', ...)
 379            object to store (must be Bio::AnnotationI compliant)
 380            [optional] object archetype to map future storage of object
 381                       of these types to
 382
 383 =cut
 384
 385 sub add_Annotation{
 386     my ($self,$key,$object,$archetype) = @_;
 387
 388     # if there's no key we use the tagname() as key
 389     if(ref($key) && $key->isa("Bio::AnnotationI") &&
 390        (! ($object && ref($object)))) {
 391         $archetype = $object if $object;
 392         $object = $key;
 393         $key = $object->tagname();
 394         $key = $key->name() if $key && ref($key); # OntologyTermI
 395         $self->throw("Annotation object must have a tagname if key omitted")
 396             unless $key;
 397     }
 398
 399     if( !defined $object ) {
 400         $self->throw("Must have at least key and object in add_Annotation");
 401     }
 402
 403     if( ! (ref($object) && $object->isa("Bio::AnnotationI")) ) {
 404         $self->throw("object must be a Bio::AnnotationI compliant object, otherwise we wont add it!");
 405     }
 406
 407     # ready to add -- if it's a SimpleValue, we add to the feature's tags,
 408     # otherwise we'll add to the annotation collection implementation
 409
 410     if($object->isa("Bio::Annotation::SimpleValue") &&
 411        $self->feature()->can('add_tag_value')) {
 412         return $self->feature()->add_tag_value($key, $object->value());
 413     } else {
 414         my $anncoll = $self->annotation();
 415         if(! $anncoll) {
 416             $anncoll = Bio::Annotation::Collection->new();
 417             $self->annotation($anncoll);
 418         }
 419         if($anncoll->can('add_Annotation')) {
 420             return $anncoll->add_Annotation($key,$object,$archetype);
 421         }
 422         $self->throw("Annotation implementation does not allow adding!");
 423     }
 424 }
 425
 426 =head2 remove_Annotations
 427
 428  Title   : remove_Annotations
 429  Usage   :
 430  Function: Remove the annotations for the specified key from this
 431            collection.
 432
 433            If the key happens to be a tag, then the tag is removed
 434            from the feature.
 435
 436  Example :
 437  Returns : an array Bio::AnnotationI compliant objects which were stored
 438            under the given key(s)
 439  Args    : the key(s) (tag name(s), one or more strings) for which to
 440            remove annotations (optional; if none given, flushes all
 441            annotations)
 442
 443
 444 =cut
 445
 446 sub remove_Annotations{
 447     my ($self, @keys) = @_;
 448
 449     # set to all keys if none are supplied
 450     @keys = $self->get_all_annotation_keys() unless @keys;
 451     # collect existing annotation
 452     my @anns = $self->get_Annotations(@keys);
 453     # flush
 454     foreach my $key (@keys) {
 455         # delete the tag if it is one
 456         $self->feature->remove_tag($key) if $self->feature->has_tag($key);
 457         # and delegate to the annotation implementation
 458         my $anncoll = $self->annotation();
 459         if($anncoll && $anncoll->can('remove_Annotations')) {
 460             $anncoll->remove_Annotations($key);
 461         } elsif($anncoll) {
 462             $self->warn("Annotation bundle implementation ".ref($anncoll).
 463                         " does not allow remove!");
 464         }
 465     }
 466     return @anns;
 467 }
 468
 469 =head1 Additional methods
 470
 471 =cut
 472
 473 =head2 tagvalue_object_factory
 474
 475  Title   : tagvalue_object_factory
 476  Usage   : $obj->tagval_object_factory($newval)
 477  Function: Get/set the object factory to use for creating objects that
 478            represent tag/value pairs (e.g.,
 479            Bio::Annotation::SimpleValue).
 480
 481            The object to be created is expected to follow
 482            Bio::Annotation::SimpleValue in terms of supported
 483            arguments at creation time, and the methods.
 484
 485  Example :
 486  Returns : A Bio::Factory::ObjectFactoryI compliant object
 487  Args    : new value (a Bio::Factory::ObjectFactoryI compliant object,
 488            optional)
 489
 490
 491 =cut
 492
 493 sub tagvalue_object_factory{
 494     my ($self,$value) = @_;
 495     if( defined $value) {
 496         $self->{'tagval_object_factory'} = $value;
 497     }
 498     return $self->{'tagval_object_factory'};
 499 }
 500
 501 1;