Bio::SeqFeature::SiRNA::Pair - Perl object for small inhibitory RNA

  use Bio::SeqFeature::SiRNA::Pair;
  my $pair = Bio::SeqFeature::SiRNA::Pair->
      new( -sense       => $bio_seqfeature_sirna_oligo, # strand=1
           -antisense	=> $bio_seqfeature_sirna_oligo, # strand= -1
	   -primary	=> 'SiRNA::Pair',
	   -source_tag 	=> 'Bio::Tools::SiRNA',
	   -start	=> 8,
	   -end		=> 31,
	   -rank	=> 1,
	   -fxgc	=> 0.5,
	   -tag		=> { note => 'a note' } );

  $target_sequence->add_SeqFeature($pair);					

  bioperl-l@bioperl.org                  - General discussion
  http://bioperl.org/wiki/Mailing_lists  - About the mailing lists

  https://redmine.open-bio.org/projects/bioperl/

  Title		: new
  Usage		: my $sirna_pair = Bio::SeqFeature::SiRNA::Pair->new();
  Purpose	: Create a new SiRNA::Pair object
  Returns	: Bio::Tools::SiRNA object
  Args		: -start 	10
                  -end		31
                  -rank		1 #  'Rank' in Tuschl group's rules
                  -fxgc		0.5 # GC fraction for target sequence
		  -primary	'SiRNA::Pair', # default value
		  -source_tag	'Bio::Tools::SiRNA'
		  -tag		{ note => 'A note' }
                  -sense	a Bio::SeqFeature::SiRNA::Oligo object
                                with strand = 1
                  -antisense	a Bio::SeqFeature::SiRNA::Oligo object
                                with strand = -1
);

  Note		: SiRNA::Pair objects are typically created by a design 
                  algorithm such as Bio::Tools::SiRNA

  Title		: rank
  Usage		: my $pair_rank = $sirna_pair->rank()
  Purpose	: Get/set the 'quality rank' for this pair.
                  See Bio::Tools::SiRNA for a description of ranks.
  Returns	: scalar
  Args		: scalar (optional) indicating pair rank

  Title		: fxGC
  Usage		: my $fxGC = $sirna_pair->fxGC();
  Purpose 	: Get/set the fraction of GC for this pair - based on TARGET sequence, not oligos.
  Returns 	: scalar between 0-1
  Args		: scalar between 0-1 (optional)

  Title		: sense
  Usage		: my $sense_oligo = $sirna_pair->sense()
  Purpose	: Get/set the SiRNA::Oligo object corresponding to the sense strand
  Returns 	: Bio::SeqFeature::SiRNA::Oligo object
  Args		: Bio::SeqFeature::SiRNA::Oligo object

  Title		: antisense
  Usage		: my $antisense_oligo = $sirna_pair->antisense()
  Purpose	: Get/set the SiRNA::Oligo object corresponding to the antisense strand
  Returns 	: Bio::SeqFeature::SiRNA::Oligo object
  Args		: Bio::SeqFeature::SiRNA::Oligo object

#
# BioPerl module for Bio::SeqFeature::SiRNA::Pair
#
# Please direct questions and support issues to <bioperl-l@bioperl.org> 
#
# Cared for by Donald Jackson, donald.jackson@bms.com
#
# Copyright Donald Jackson
#
# You may distribute this module under the same terms as perl itself

# POD documentation - main docs before the code

package Bio::SeqFeature::SiRNA::Pair;

use strict;
use warnings;

use base qw(Bio::SeqFeature::Generic);

# arguments to new().  Taken from Bio::SeqFeature Generic.
# Omit frame (not relevant), GFF_STRING and GFF1_STRING 
# because I'm not sure how to handle them.  Add RANK, FXGC, SENSE, ANTISENSE
our @ARGNAMES = qw(RANK FXGC SENSE ANTISENSE START END STRAND PRIMARY SOURCE_TAG
		   SCORE TAG SEQNAME ANNOTATION LOCATION);

sub new {
    my ($proto, @args) = @_;

    my $pkg = ref($proto) || $proto;

    my $self = $pkg->SUPER::new();
    my %args;
    @args{@ARGNAMES} = $self->_rearrange(\@ARGNAMES, @args); 
    # default primary tag
    $args{'PRIMARY'} ||= 'SiRNA::Pair';

    $args{'PRIMARY'}		&& $self->primary_tag($args{'PRIMARY'});
    $args{'SOURCE_TAG'}		&& $self->source_tag($args{'SOURCE_TAG'});
    $args{'SEQNAME'}		&& $self->seqname($args{'SEQNAME'});
    $args{'ANNOTATION'}		&& $self->annotation($args{'ANNOTATION'});
    $args{'LOCATION'}		&& $self->location($args{'LOCATION'});
    $args{'SENSE'}		&& $self->sense($args{'SENSE'});
    $args{'ANTISENSE'}		&& $self->antisense($args{'ANTISENSE'});
    defined($args{'START'})	&& $self->start($args{'START'});
    defined($args{'END'})	&& $self->end($args{'END'});
    defined($args{'STRAND'})	&& $self->strand($args{'STRAND'});
    defined($args{'SCORE'})	&& $self->score($args{'SCORE'});
    defined($args{'RANK'})	&& $self->rank($args{'RANK'});
    defined($args{'FXGC'})	&& $self->fxGC($args{'FXGC'});

    if ($args{'TAG'}) {	
	foreach my $t (keys %{$args{'TAG'}}) {
	    $self->add_tag_value($t, $args{'TAG'}->{$t});
	}
    }


    return $self;
}

sub rank {
    my ($self, $rank) = @_;

    if (defined $rank) {
	# first clear out old tags
	$self->remove_tag('rank') if ( $self->has_tag('rank') );
	$self->add_tag_value('rank', $rank);
    }
    else {
	if ($self->has_tag('rank')) {
	    my @ranks = $self->each_tag_value('rank');
	    return shift @ranks;
	}
	else {
	    $self->throw("Rank not defined for this Pair\n");
	    return;
	}
    }
}

sub fxGC {
    my ($self, $fxGC) = @_;

    if (defined $fxGC) {
	# is this an integer?
	if ($fxGC =~ /[^.\d]/) {
	    $self->throw(  -class => 'Bio::Root::BadParameter',
			   -text  => "Fraction GC must be a number between 0, 1 - NOT <$fxGC>",
			   -value => $fxGC
			   );
	}
	if  ( $fxGC < 0 or $fxGC > 1 ) {
	    $self->throw( -class => 'Bio::Root::BadParameter',
			  -text  => "Fraction GC must be a number between 0, 1 - NOT <$fxGC>",
			   -value => $fxGC
);
	}
	    
	#  clear out old tags
	$self->remove_tag('fxGC') if ( $self->has_tag('fxGC') );
	$self->add_tag_value('fxGC', $fxGC)
	    or $self->throw("Unable to set fxGC");
    }
    else {
	if ($self->has_tag('fxGC')) {
	    my @fxGCs = $self->each_tag_value('fxGC');
	    return shift @fxGCs;
	}
	else {
	    $self->throw("FxGC not defined for this Pair");
	}
    }
}

sub sense {
    my ($self, $soligo) = @_;

    if ($soligo) {
	$self->_add_oligo($soligo, 1) or return;
    }
    else {
	return $self->_get_oligo(1);
    }
}

sub antisense {
    my ($self, $asoligo) = @_;

    if ($asoligo) {
	$self->_add_oligo($asoligo, -1) or return;
    }
    else {
	return $self->_get_oligo(-1);
    }
}
	
sub _add_oligo {
    my ($self, $oligo, $strand) = @_;

    unless ($oligo->isa('Bio::SeqFeature::SiRNA::Oligo')) {
	$self->throw( -class => 'Bio::Root::BadParameter',
		      -text  =>  "Oligos must be passed as Bio::SeqFeature::SiRNA::Oligo objects\n");	
    }

    $oligo->strand($strand);
    return $self->add_sub_SeqFeature($oligo, 'EXPAND');
}

sub _get_oligo {
    my ($self, $strand) = @_;
    my $feat;

    my @feats = $self->sub_SeqFeature;

    foreach $feat (@feats) {
	next unless ($feat->primary_tag eq 'SiRNA::Oligo');
	next unless ($feat->strand == $strand);
	return $feat;
    }
    return;
}

1;