changes all issue tracking in preparation for switch to github issues
[bioperl-live.git] / Bio / Tools / SiRNA / Ruleset / saigo.pm
blobcc80a114cbfd057a4233c73cbc3ecbe58fa73867
1 # BioPerl module for Bio::Tools::SiRNA::Ruleset::saigo
3 # Please direct questions and support issues to <bioperl-l@bioperl.org>
5 # Cared for by Donald Jackson, donald.jackson@bms.com
7 # Copyright Bristol-Myers Squibb
9 # You may distribute this module under the same terms as perl itself
11 # POD documentation - main docs before the code
13 =head1 NAME
15 Bio::Tools::SiRNA::Ruleset::saigo - Perl object implementing the Saigo
16 group's rules for designing small inhibitory RNAs
18 =head1 SYNOPSIS
20 Do not use this module directly. Instead, use Bio::Tools::SiRNA and
21 specify the saigo ruleset:
23 use Bio::Tools::SiRNA;
25 my $sirna_designer = Bio::Tools::SiRNA->new( -target => $bio_seq,
26 -rules => 'saigo'
28 my @pairs = $sirna_designer->design;
30 foreach $pair (@pairs) {
31 my $sense_oligo_sequence = $pair->sense->seq;
32 my $antisense_oligo_sequence = $pair->antisense->seq;
34 # print out results
35 print join ("\t", $pair->start, $pair->end, $pair->rank,
36 $sense_oligo_sequence, $antisense_oligo_sequence), "\n";
39 =head1 DESCRIPTION
41 This package implements the rules for designing siRNA reagents
42 published by Ui-Tei et al (2004). The rules are:
44 =over 5
46 =item 1.
48 The first base in the sense strand of the duplex must be a G or C
50 =item 2.
52 The first base in the antisense strand of the duplex must be an A or U
54 =item 3.
56 The first 7 nucleotides in the antisense strand of the duplex must be
57 A or U
59 =item 4.
61 There cannot be more than 9 consecutive G or C nucleotides
63 =item 5.
65 The first 12 nucleotides in the sense strand of the duplex should have
66 33-66% GC
68 =back
70 The module inherits from Bio::Tools::SiRNA. See the documentation for
71 that module for information on how to specify the target and recover
72 the SiRNA duplex information.
74 =head2 EXPORT
76 None.
78 =head1 SEE ALSO
80 L<Bio::Tools::SiRNA>,
81 L<Bio::SeqFeature::SiRNA::Pair>,
82 L<Bio::SeqFeature::SiRNA::Oligo>.
84 =head1 FEEDBACK
86 =head2 Mailing Lists
88 User feedback is an integral part of the evolution of this and other
89 Bioperl modules. Send your comments and suggestions preferably to
90 the Bioperl mailing list. Your participation is much appreciated.
92 bioperl-l@bioperl.org - General discussion
93 http://bioperl.org/wiki/Mailing_lists - About the mailing lists
95 =head2 Support
97 Please direct usage questions or support issues to the mailing list:
99 I<bioperl-l@bioperl.org>
101 rather than to the module maintainer directly. Many experienced and
102 reponsive experts will be able look at the problem and quickly
103 address it. Please include a thorough description of the problem
104 with code and data examples if at all possible.
106 =head2 Reporting Bugs
108 Report bugs to the Bioperl bug tracking system to help us keep track
109 of the bugs and their resolution. Bug reports can be submitted via
110 the web:
112 https://github.com/bioperl/bioperl-live/issues
114 =head1 AUTHOR
116 Donald Jackson (donald.jackson@bms.com)
118 =head1 APPENDIX
120 The rest of the documentation details each of the object methods.
121 Internal methods are usually preceded with a _
123 =cut
125 package Bio::Tools::SiRNA::Ruleset::saigo;
127 use strict;
128 use warnings;
130 use base qw(Bio::Tools::SiRNA);
132 =head2 new
134 Title : new
135 Usage : Do not call directly - use Bio::Tools::SiRNA->new instead.
136 Returns : Bio::Tools::SiRNA::Ruleset::saigo object
137 Args : none
139 =cut
141 sub new {
142 my ($proto, %args) = @_;
143 my $class = ref($proto) || $proto;
145 $args{'RULES'} = 'saigo';
147 return $class->SUPER::new(%args);
150 sub _get_oligos {
151 my ($self) = @_;
153 my ($targseq, $targstart) = $self->_get_targetregion;
155 foreach my $i (0 .. (length($targseq) - 23)) {
156 my $testseq = substr($targseq, $i, 23);
157 $self->add_oligos($testseq, $targstart + $i + 1) if ($self->_oligo_ok($testseq));
162 sub _get_sense {
163 my ($self, $target) = @_;
164 #trim off 1st 2 nt to get overhang
165 $target =~ s/^..//;
166 #convert T's to U's (transcribe)
167 $target =~ s/T/U/gi;
169 return $target;
172 sub _get_anti {
173 my ($self, $target) = @_;
174 my @target = split(//, $target);
175 my ($nt,@antitarget);
177 while ($nt = pop @target) {
178 push(@antitarget, $self->_comp($nt));
180 my $anti = join('', @antitarget);
181 #trim off 1st 2 nt to get overhang
182 $anti =~ s/^..//;
183 #convert T's to U's
184 $anti =~ s/T/U/gi;
186 return $anti;
189 sub _oligo_ok {
190 my ($self, $testseq) = @_;
192 $self->debug("Testing $testseq...\n");
194 my @testseq = split(//, $testseq);
195 # is 5p end of sense strand a G/C?
196 unless ($testseq[2] =~ /[GC]/i) {
197 $self->debug("No G/C at sense 5' end\n");
198 return 0;
200 # is 5p end of antisense strand an A/T?
201 unless ($testseq[20] =~ /[AT]/i) {
202 $self->debug("No A/T at antisense 5' end\n");
203 return 0;
206 # are 4 of the last 7 bases in the duplex A/T?
207 my $atcount_3p = grep { /[AT]/i } @testseq[14 .. 20];
208 unless ($atcount_3p >= 4) {
209 $self->debug("Found $atcount_3p A/T in last 7 bases of duplex\n");
210 return 0;
212 # what is gc fraction in rest of duplex? Target: 33 to 66 pct gc (4-8 of 12)
213 my $gccount_5p = grep { /[GC]/i } @testseq[2 .. 13];
214 if ($gccount_5p < 4) {
215 $self->debug("Found only $gccount_5p GCs in 5p end of duplex\n");
216 return 0;
218 if ($gccount_5p > 8) {
219 $self->debug("Found only $gccount_5p GCs in 5p end of duplex\n");
220 return 0;
223 # no more than 9 consecutive GC
224 if ($testseq =~ /[GC]{9,}?/i) {
225 $self->debug("Found more than 9 consecutive GCs\n");
226 return 0;
229 $self->debug("Oligo passed \n");
230 return 1;