lib/Bio/SeqFeature/SiRNA/Pair.pm

   1 #
   2 # BioPerl module for Bio::SeqFeature::SiRNA::Pair
   3 #
   4 # Please direct questions and support issues to <bioperl-l@bioperl.org>
   5 #
   6 # Cared for by Donald Jackson, donald.jackson@bms.com
   7 #
   8 # Copyright Donald Jackson
   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::SeqFeature::SiRNA::Pair - Perl object for small inhibitory RNA
  17 (SiRNA) oligo pairs
  18
  19 =head1 SYNOPSIS
  20
  21   use Bio::SeqFeature::SiRNA::Pair;
  22   my $pair = Bio::SeqFeature::SiRNA::Pair->
  23       new( -sense       => $bio_seqfeature_sirna_oligo, # strand=1
  24            -antisense   => $bio_seqfeature_sirna_oligo, # strand= -1
  25            -primary     => 'SiRNA::Pair',
  26            -source_tag  => 'Bio::Tools::SiRNA',
  27            -start       => 8,
  28            -end         => 31,
  29            -rank        => 1,
  30            -fxgc        => 0.5,
  31            -tag         => { note => 'a note' } );
  32
  33   $target_sequence->add_SeqFeature($pair);
  34
  35 =head1 DESCRIPTION
  36
  37 Object methods for (complementary) pairs of L<Bio::SeqFeature::SiRNA::Oligo>
  38 objects - inherits L<Bio::SeqFeature::Generic>. See that package for information
  39 on inherited methods.
  40
  41 Does B<not> include methods for designing SiRNAs -- see L<Bio::Tools::SiRNA>
  42
  43 =head1 SEE ALSO
  44
  45 L<Bio::SeqFeature::Oligo>, L<Bio::Tools::SiRNA>.
  46
  47 =head1 FEEDBACK
  48
  49 =head2 Mailing Lists
  50
  51 User feedback is an integral part of the evolution of this and other
  52 Bioperl modules. Send your comments and suggestions preferably to
  53 the Bioperl mailing list.  Your participation is much appreciated.
  54
  55   bioperl-l@bioperl.org                  - General discussion
  56   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
  57
  58 =head2 Support
  59
  60 Please direct usage questions or support issues to the mailing list:
  61
  62 I<bioperl-l@bioperl.org>
  63
  64 rather than to the module maintainer directly. Many experienced and
  65 reponsive experts will be able look at the problem and quickly
  66 address it. Please include a thorough description of the problem
  67 with code and data examples if at all possible.
  68
  69 =head2 Reporting Bugs
  70
  71 Report bugs to the Bioperl bug tracking system to help us keep track
  72 of the bugs and their resolution. Bug reports can be submitted via
  73 the web:
  74
  75   https://github.com/bioperl/bioperl-live/issues
  76
  77 =head1 AUTHOR
  78
  79 Donald Jackson (donald.jackson@bms.com)
  80
  81 =head1 APPENDIX
  82
  83 The rest of the documentation details each of the object methods.
  84 Internal methods are usually preceded with a _
  85
  86 =cut
  87
  88 package Bio::SeqFeature::SiRNA::Pair;
  89
  90 use strict;
  91 use warnings;
  92
  93 use base qw(Bio::SeqFeature::Generic);
  94
  95 # arguments to new().  Taken from Bio::SeqFeature Generic.
  96 # Omit frame (not relevant), GFF_STRING and GFF1_STRING
  97 # because I'm not sure how to handle them.  Add RANK, FXGC, SENSE, ANTISENSE
  98 our @ARGNAMES = qw(RANK FXGC SENSE ANTISENSE START END STRAND PRIMARY SOURCE_TAG
  99                    SCORE TAG SEQNAME ANNOTATION LOCATION);
 100
 101 =head1 METHODS
 102
 103 =head2 new
 104
 105   Title         : new
 106   Usage         : my $sirna_pair = Bio::SeqFeature::SiRNA::Pair->new();
 107   Purpose       : Create a new SiRNA::Pair object
 108   Returns       : Bio::Tools::SiRNA object
 109   Args          : -start        10
 110                   -end          31
 111                   -rank         1 #  'Rank' in Tuschl group's rules
 112                   -fxgc         0.5 # GC fraction for target sequence
 113                   -primary      'SiRNA::Pair', # default value
 114                   -source_tag   'Bio::Tools::SiRNA'
 115                   -tag          { note => 'A note' }
 116                   -sense        a Bio::SeqFeature::SiRNA::Oligo object
 117                                 with strand = 1
 118                   -antisense    a Bio::SeqFeature::SiRNA::Oligo object
 119                                 with strand = -1
 120 );
 121
 122   Note          : SiRNA::Pair objects are typically created by a design
 123                   algorithm such as Bio::Tools::SiRNA
 124
 125 =cut
 126
 127 sub new {
 128     my ($proto, @args) = @_;
 129
 130     my $pkg = ref($proto) || $proto;
 131
 132     my $self = $pkg->SUPER::new();
 133     my %args;
 134     @args{@ARGNAMES} = $self->_rearrange(\@ARGNAMES, @args);
 135     # default primary tag
 136     $args{'PRIMARY'} ||= 'SiRNA::Pair';
 137
 138     $args{'PRIMARY'}            && $self->primary_tag($args{'PRIMARY'});
 139     $args{'SOURCE_TAG'}         && $self->source_tag($args{'SOURCE_TAG'});
 140     $args{'SEQNAME'}            && $self->seqname($args{'SEQNAME'});
 141     $args{'ANNOTATION'}         && $self->annotation($args{'ANNOTATION'});
 142     $args{'LOCATION'}           && $self->location($args{'LOCATION'});
 143     $args{'SENSE'}              && $self->sense($args{'SENSE'});
 144     $args{'ANTISENSE'}          && $self->antisense($args{'ANTISENSE'});
 145     defined($args{'START'})     && $self->start($args{'START'});
 146     defined($args{'END'})       && $self->end($args{'END'});
 147     defined($args{'STRAND'})    && $self->strand($args{'STRAND'});
 148     defined($args{'SCORE'})     && $self->score($args{'SCORE'});
 149     defined($args{'RANK'})      && $self->rank($args{'RANK'});
 150     defined($args{'FXGC'})      && $self->fxGC($args{'FXGC'});
 151
 152     if ($args{'TAG'}) {
 153         foreach my $t (keys %{$args{'TAG'}}) {
 154             $self->add_tag_value($t, $args{'TAG'}->{$t});
 155         }
 156     }
 157
 158
 159     return $self;
 160 }
 161
 162 =head2 rank
 163
 164   Title         : rank
 165   Usage         : my $pair_rank = $sirna_pair->rank()
 166   Purpose       : Get/set the 'quality rank' for this pair.
 167                   See Bio::Tools::SiRNA for a description of ranks.
 168   Returns       : scalar
 169   Args          : scalar (optional) indicating pair rank
 170
 171 =cut
 172
 173 sub rank {
 174     my ($self, $rank) = @_;
 175
 176     if (defined $rank) {
 177         # first clear out old tags
 178         $self->remove_tag('rank') if ( $self->has_tag('rank') );
 179         $self->add_tag_value('rank', $rank);
 180     }
 181     else {
 182         if ($self->has_tag('rank')) {
 183             my @ranks = $self->get_tag_values('rank');
 184             return shift @ranks;
 185         }
 186         else {
 187             $self->throw("Rank not defined for this Pair\n");
 188             return;
 189         }
 190     }
 191 }
 192
 193 =head2 fxGC
 194
 195   Title         : fxGC
 196   Usage         : my $fxGC = $sirna_pair->fxGC();
 197   Purpose       : Get/set the fraction of GC for this pair - based on TARGET sequence, not oligos.
 198   Returns       : scalar between 0-1
 199   Args          : scalar between 0-1 (optional)
 200
 201 =cut
 202
 203
 204 sub fxGC {
 205     my ($self, $fxGC) = @_;
 206
 207     if (defined $fxGC) {
 208         # is this an integer?
 209         if ($fxGC =~ /[^.\d]/) {
 210             $self->throw(  -class => 'Bio::Root::BadParameter',
 211                            -text  => "Fraction GC must be a number between 0, 1 - NOT <$fxGC>",
 212                            -value => $fxGC
 213                            );
 214         }
 215         if  ( $fxGC < 0 or $fxGC > 1 ) {
 216             $self->throw( -class => 'Bio::Root::BadParameter',
 217                           -text  => "Fraction GC must be a number between 0, 1 - NOT <$fxGC>",
 218                            -value => $fxGC
 219 );
 220         }
 221
 222         #  clear out old tags
 223         $self->remove_tag('fxGC') if ( $self->has_tag('fxGC') );
 224         $self->add_tag_value('fxGC', $fxGC)
 225             or $self->throw("Unable to set fxGC");
 226     }
 227     else {
 228         if ($self->has_tag('fxGC')) {
 229             my @fxGCs = $self->get_tag_values('fxGC');
 230             return shift @fxGCs;
 231         }
 232         else {
 233             $self->throw("FxGC not defined for this Pair");
 234         }
 235     }
 236 }
 237
 238 =head2 sense
 239
 240   Title         : sense
 241   Usage         : my $sense_oligo = $sirna_pair->sense()
 242   Purpose       : Get/set the SiRNA::Oligo object corresponding to the sense strand
 243   Returns       : Bio::SeqFeature::SiRNA::Oligo object
 244   Args          : Bio::SeqFeature::SiRNA::Oligo object
 245
 246 =cut
 247
 248
 249 sub sense {
 250     my ($self, $soligo) = @_;
 251
 252     if ($soligo) {
 253         $self->_add_oligo($soligo, 1) or return;
 254     }
 255     else {
 256         return $self->_get_oligo(1);
 257     }
 258 }
 259
 260 =head2 antisense
 261
 262   Title         : antisense
 263   Usage         : my $antisense_oligo = $sirna_pair->antisense()
 264   Purpose       : Get/set the SiRNA::Oligo object corresponding to the antisense strand
 265   Returns       : Bio::SeqFeature::SiRNA::Oligo object
 266   Args          : Bio::SeqFeature::SiRNA::Oligo object
 267
 268 =cut
 269
 270 sub antisense {
 271     my ($self, $asoligo) = @_;
 272
 273     if ($asoligo) {
 274         $self->_add_oligo($asoligo, -1) or return;
 275     }
 276     else {
 277         return $self->_get_oligo(-1);
 278     }
 279 }
 280
 281 sub _add_oligo {
 282     my ($self, $oligo, $strand) = @_;
 283
 284     unless ($oligo->isa('Bio::SeqFeature::SiRNA::Oligo')) {
 285         $self->throw( -class => 'Bio::Root::BadParameter',
 286                       -text  =>  "Oligos must be passed as Bio::SeqFeature::SiRNA::Oligo objects\n");
 287     }
 288
 289     $oligo->strand($strand);
 290     return $self->add_sub_SeqFeature($oligo, 'EXPAND');
 291 }
 292
 293 sub _get_oligo {
 294     my ($self, $strand) = @_;
 295     my $feat;
 296
 297     my @feats = $self->sub_SeqFeature;
 298
 299     foreach $feat (@feats) {
 300         next unless ($feat->primary_tag eq 'SiRNA::Oligo');
 301         next unless ($feat->strand == $strand);
 302         return $feat;
 303     }
 304     return;
 305 }
 306
 307 1;