File Coverage

Bio/Variation/AAReverseMutate.pm
Criterion Covered Total %
statement 73 77 94.8
branch 26 36 72.2
condition 4 6 66.6
subroutine 11 11 100.0
pod 6 6 100.0
total 120 136 88.2


line stmt bran cond sub pod time code
1             #
2             # BioPerl module for Bio::Variation::AAReverseMutate
3             #
4             # Please direct questions and support issues to
5             #
6             # Cared for by Heikki Lehvaslaiho
7             #
8             # Copyright Heikki Lehvaslaiho
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::Variation::AAReverseMutate - point mutation and codon
17             information from single amino acid changes
18              
19             =head1 SYNOPSIS
20              
21             $aamut = Bio::Variation::AAReverseMutate->new
22             (-aa_ori => 'F',
23             -aa_mut => 'S',
24             -codon_ori => 'ttc', # optional
25             -codon_table => '3' # defaults to 1
26             );
27              
28             @points = $aamut->each_Variant;
29              
30             if (scalar @points > 0 ) {
31             foreach $rnachange ( @points ) {
32             # $rnachange is a Bio::Variation::RNAChange object
33             print " ", $rnachange->allele_ori->seq, ">",
34             $rnachange->allele_mut->seq, " in ",
35             $rnachange->codon_ori, ">", $rnachange->codon_mut,
36             " at position ", $rnachange->codon_pos, "\n";
37             }
38             } else {
39             print "No point mutations possible\n",
40             }
41              
42             =head1 DESCRIPTION
43              
44             Bio::Variation::AAReverseMutate objects take in reference and mutated
45             amino acid information and deduces potential point mutations at RNA
46             level leading to this change. The choice can be further limited by
47             letting the object know what is the the codon in the reference
48             sequence. The results are returned as L
49             objects.
50              
51             =head1 FEEDBACK
52              
53             =head2 Mailing Lists
54              
55             User feedback is an integral part of the evolution of this and other
56             Bioperl modules. Send your comments and suggestions preferably to the
57             Bioperl mailing lists Your participation is much appreciated.
58              
59             bioperl-l@bioperl.org - General discussion
60             http://bioperl.org/wiki/Mailing_lists - About the mailing lists
61              
62             =head2 Support
63              
64             Please direct usage questions or support issues to the mailing list:
65              
66             I
67              
68             rather than to the module maintainer directly. Many experienced and
69             reponsive experts will be able look at the problem and quickly
70             address it. Please include a thorough description of the problem
71             with code and data examples if at all possible.
72              
73             =head2 Reporting Bugs
74              
75             Report bugs to the Bioperl bug tracking system to help us keep track
76             the bugs and their resolution. Bug reports can be submitted via the
77             web:
78              
79             https://github.com/bioperl/bioperl-live/issues
80              
81             =head1 AUTHOR - Heikki Lehvaslaiho
82              
83             Email: heikki-at-bioperl-dot-org
84              
85             =head1 APPENDIX
86              
87             The rest of the documentation details each of the object
88             methods. Internal methods are usually preceded with a _
89              
90             =cut
91              
92              
93             # Let the code begin...
94              
95             package Bio::Variation::AAReverseMutate;
96              
97 1     1   491 use strict;
  1         1  
  1         24  
98              
99             # Object preamble - inheritance
100 1     1   354 use Bio::Tools::CodonTable;
  1         2  
  1         25  
101 1     1   349 use Bio::Variation::RNAChange;
  1         2  
  1         27  
102 1     1   272 use Bio::Variation::Allele;
  1         2  
  1         26  
103              
104 1     1   4 use base qw(Bio::Root::Root);
  1         1  
  1         616  
105              
106             sub new {
107 1     1 1 123 my($class,@args) = @_;
108 1         11 my $self = $class->SUPER::new(@args);
109              
110 1         6 my ($aa_ori, $aa_mut, $codon_ori, $codon_table) =
111             $self->_rearrange([qw(AA_ORI
112             AA_MUT
113             CODON
114             CODON_TABLE
115             )],@args);
116              
117 1 50       5 $aa_ori && $self->aa_ori($aa_ori);
118 1 50       4 $aa_mut && $self->aa_mut($aa_mut);
119 1 50       3 $codon_ori && $self->codon_ori($codon_ori);
120 1 50       2 $codon_table && $self->codon_table($codon_table);
121              
122 1         3 return $self; # success - we hope!
123              
124             }
125              
126              
127             =head2 aa_ori
128              
129             Title : aa_ori
130             Usage : $obj->aa_ori();
131             Function:
132              
133             Sets and returns original aa sequence. If value is not
134             set, returns false.
135              
136             Amino acid sequences are stored in upper case characters,
137             others in lower case.
138              
139             Example :
140             Returns : string
141             Args : single character amino acid code
142              
143             =cut
144              
145             sub aa_ori {
146 6     6 1 921 my ($self,$value) = @_;
147 6 100       13 if( defined $value) {
148 1 50       5 if ( uc($value) !~ /^[ARNDCQEGHILKMFPSTWYVBZX*]$/ ) {
149 0         0 $self->throw("'$value' is not a valid one letter amino acid symbol\n");
150             } else {
151 1         3 $self->{'aa_ori'} = uc $value;
152             }
153             }
154 6         16 return $self->{'aa_ori'};
155             }
156              
157              
158             =head2 aa_mut
159              
160             Title : aa_mut
161             Usage : $obj->aa_mut();
162             Function:
163              
164             Sets and returns the mutated allele sequence. If value is not
165             set, returns false.
166              
167             Example :
168             Returns : string
169             Args : single character amino acid code
170              
171             =cut
172              
173              
174             sub aa_mut {
175 7     7 1 8 my ($self,$value) = @_;
176 7 100       10 if( defined $value) {
177 1 50       4 if ( uc($value) !~ /^[ARNDCQEGHILKMFPSTWYVBZX*]$/ ) {
178 0         0 $self->throw("'$value' is not a valid one letter amino acid symbol\n");
179             } else {
180 1         2 $self->{'aa_mut'} = uc $value;
181             }
182             }
183 7         17 return $self->{'aa_mut'};
184             }
185              
186              
187             =head2 codon_ori
188              
189             Title : codon_ori
190             Usage : $obj->codon_ori();
191             Function:
192              
193             Sets and returns codon_ori triplet. If value is not set,
194             returns false. The string has to be three characters
195             long. The chracter content is not checked.
196              
197             Example :
198             Returns : string
199             Args : string
200              
201             =cut
202              
203             sub codon_ori {
204 7     7 1 460 my ($self,$value) = @_;
205 7 100       11 if( defined $value) {
206 1 50 33     9 if (length $value != 3 or lc $value =~ /[^atgc]/) {
207 0         0 $self->warn("Codon string \"$value\" is not valid unique codon");
208             }
209 1         3 $self->{'codon_ori'} = lc $value;
210             }
211 7         19 return $self->{'codon_ori'};
212             }
213              
214             =head2 codon_table
215              
216             Title : codon_table
217             Usage : $obj->codon_table();
218             Function:
219              
220             Sets and returns the codon table id of the RNA
221             If value is not set, returns 1, 'universal' code, as the default.
222              
223             Example :
224             Returns : integer
225             Args : none if get, the new value if set
226              
227             =cut
228              
229              
230             sub codon_table {
231 6     6 1 437 my ($self,$value) = @_;
232 6 100       17 if( defined $value) {
233 2 50       11 if ( not $value =~ /^\d+$/ ) {
234 0         0 $self->throw("'$value' is not a valid codon table ID\n".
235             "Has to be a positive integer. Defaulting to 1\n");
236             } else {
237 2         5 $self->{'codon_table'} = $value;
238             }
239             }
240 6 100       11 if( ! exists $self->{'codon_table'} ) {
241 2         10 return 1;
242             } else {
243 4         10 return $self->{'codon_table'};
244             }
245             }
246              
247              
248             =head2 each_Variant
249              
250             Title : each_Variant
251             Usage : $obj->each_Variant();
252             Function:
253              
254             Returns a list of Variants.
255              
256             Example :
257             Returns : list of Variants
258             Args : none
259              
260             =cut
261              
262             sub each_Variant{
263 2     2 1 264 my ($self,@args) = @_;
264            
265 2 50       4 $self->throw("aa_ori is not defined\n") if not defined $self->aa_ori;
266 2 50       5 $self->throw("aa_mut is not defined\n") if not defined $self->aa_mut;
267              
268 2         3 my (@points, $codon_pos, $allele_ori, $allele_mut);
269 2         4 my $ct = Bio::Tools::CodonTable->new( '-id' => $self->codon_table );
270 2         5 foreach my $codon_ori ($ct->revtranslate($self->aa_ori)) {
271 4 100 100     8 next if $self->codon_ori and $self->codon_ori ne $codon_ori;
272 3         5 foreach my $codon_mut ($ct->revtranslate($self->aa_mut)) {
273 18         13 my $k = 0;
274 18         13 my $length = 0;
275 18         12 $codon_pos = $allele_ori = $allele_mut = undef;
276 18         21 while ($k<3) {
277 54         38 my $nt_ori = substr ($codon_ori, $k, 1);
278 54         37 my $nt_mut = substr ($codon_mut, $k, 1);
279 54 100       60 if ($nt_ori ne $nt_mut) {
280 36         24 $length++;
281 36         21 $codon_pos = $k+1;
282 36         21 $allele_ori = $nt_ori;
283 36         23 $allele_mut = $nt_mut;
284             }
285 54         58 $k++;
286             }
287 18 100       27 if ($length == 1) {
288 3         12 my $rna = Bio::Variation::RNAChange->new
289             ('-length' => '1',
290             '-codon_ori' => $codon_ori,
291             '-codon_mut' => $codon_mut,
292             '-codon_pos' => $codon_pos,
293             '-isMutation' => 1
294             );
295 3         10 my $all_ori = Bio::Variation::Allele->new('-seq'=>$allele_ori);
296 3         7 $rna->allele_ori($all_ori);
297 3         6 my $all_mut = Bio::Variation::Allele->new('-seq'=>$allele_mut);
298 3         11 $rna->allele_mut($all_mut);
299 3         5 push @points, $rna;
300             }
301             }
302             }
303 2         10 return @points;
304             }
305              
306             1;