Bio/SeqFeature/SiRNA/Pair.pm

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