File Coverage

Bio/Tools/Gel.pm
Criterion Covered Total %
statement 48 52 92.3
branch 11 22 50.0
condition 3 8 37.5
subroutine 10 10 100.0
pod 5 6 83.3
total 77 98 78.5


line stmt bran cond sub pod time code
1             #
2             # BioPerl module for Bio::Tools::Gel
3             # Copyright Allen Day
4             # You may distribute this module under the same terms as perl itself
5              
6             # POD documentation - main docs before the code
7              
8             =head1 NAME
9              
10             Bio::Tools::Gel - Calculates relative electrophoretic migration distances
11              
12             =head1 SYNOPSIS
13              
14             use Bio::PrimarySeq;
15             use Bio::Restriction::Analysis;
16             use Bio::Tools::Gel;
17              
18             # get a sequence
19             my $d = 'AAAAAAAAAGAATTCTTTTTTTTTTTTTTGAATTCGGGGGGGGGGGGGGGGGGGG';
20             my $seq1 = Bio::Seq->new(-id=>'groundhog day',-seq=>$d);
21              
22             # cut it with an enzyme
23             my $ra=Bio::Restriction::Analysis->new(-seq=>$seq1);
24             @cuts = $ra->fragments('EcoRI'), 3;
25              
26             # analyse the fragments in a gel
27             my $gel = Bio::Tools::Gel->new(-seq=>\@cuts,-dilate=>10);
28             my %bands = $gel->bands;
29             foreach my $band (sort {$b <=> $a} keys %bands){
30             print $band,"\t", sprintf("%.1f", $bands{$band}),"\n";
31             }
32              
33             #prints:
34             #20 27.0
35             #25 26.0
36             #10 30.0
37              
38             =head1 DESCRIPTION
39              
40             This takes a set of sequences or Bio::Seq objects, and calculates their
41             respective migration distances using:
42             distance = dilation * (4 - log10(length(dna));
43              
44             Source: Molecular Cloning, a Laboratory Manual. Sambrook, Fritsch, Maniatis.
45             CSHL Press, 1989.
46              
47             Bio::Tools::Gel currently calculates migration distances based solely on
48             the length of the nucleotide sequence. Secondary or tertiary structure,
49             curvature, and other biophysical attributes of a sequence are currently
50             not considered. Polypeptide migration is currently not supported.
51              
52             =head1 FEEDBACK
53              
54             =head2 Mailing Lists
55              
56             User feedback is an integral part of the evolution of this and other
57             Bioperl modules. Send your comments and suggestions preferably to
58             the Bioperl mailing list. Your participation is much appreciated.
59              
60             bioperl-l@bioperl.org - General discussion
61             http://bioperl.org/wiki/Mailing_lists - About the mailing lists
62              
63             =head2 Support
64              
65             Please direct usage questions or support issues to the mailing list:
66              
67             I
68              
69             rather than to the module maintainer directly. Many experienced and
70             reponsive experts will be able look at the problem and quickly
71             address it. Please include a thorough description of the problem
72             with code and data examples if at all possible.
73              
74             =head2 Reporting Bugs
75              
76             Report bugs to the Bioperl bug tracking system to help us keep track
77             of the bugs and their resolution. Bug reports can be submitted via the
78             web:
79              
80             https://github.com/bioperl/bioperl-live/issues
81              
82             =head1 AUTHOR - Allen Day
83              
84             Email allenday@ucla.edu
85              
86             =head1 APPENDIX
87              
88             The rest of the documentation details each of the object methods.
89             Internal methods are usually preceded with a _
90              
91             =cut
92              
93              
94             package Bio::Tools::Gel;
95 1     1   994 use strict;
  1         2  
  1         26  
96              
97 1     1   5 use Bio::PrimarySeq;
  1         1  
  1         21  
98              
99 1     1   4 use base qw(Bio::Root::Root);
  1         2  
  1         507  
100              
101             =head2 new
102              
103             Title : new
104             Usage : my $gel = Bio::Tools::Gel->new(-seq => $sequence,-dilate => 3);
105             Function: Initializes a new Gel
106             Returns : Bio::Tools::Gel
107             Args : -seq => Bio::Seq(s), scalar(s) or list of either/both
108             (default: none)
109             -dilate => Expand band migration distances (default: 1)
110              
111             =cut
112              
113             sub new {
114 1     1 1 3 my ($class, @args) = @_;
115              
116 1         12 my $self = $class->SUPER::new(@args);
117 1         10 my ($seqs, $dilate) = $self->_rearrange([qw(SEQ DILATE)], @args);
118 1 50 33     12 if( ! ref($seqs) ) {
    50          
119 0         0 $self->add_band([$seqs]);
120             } elsif( ref($seqs) =~ /array/i ||
121             $seqs->isa('Bio::PrimarySeqI') ) {
122 1         5 $self->add_band($seqs);
123             }
124 1   50     6 $self->dilate($dilate || 1);
125            
126 1         6 return $self;
127             }
128              
129              
130             =head2 add_band
131              
132             Title : add_band
133             Usage : $gel->add_band($seq);
134             Function: Calls _add_band with a (possibly created) Bio::Seq object.
135             Returns :
136             Args : Bio::Seq, scalar sequence, or list of either/both.
137              
138             =cut
139              
140             sub add_band {
141 1     1 1 2 my ($self, $args) = @_;
142              
143 1         4 foreach my $arg (@$args){
144 3         4 my $seq;
145 3 50       5 if( ! ref $arg ) {
    0          
146 3 50       9 if( $arg =~ /^\d+/ ) {
147             # $arg is a number
148 0         0 $seq = Bio::PrimarySeq->new(-seq=>'N'x$arg, -id => $arg);
149             } else {
150             # $arg is a sequence string
151 3         13 $seq = Bio::PrimarySeq->new(-seq=>$arg, -id=>length $arg);
152             }
153             } elsif( $arg->isa('Bio::PrimarySeqI') ) {
154             # $arg is a sequence object
155 0         0 $seq = $arg;
156             }
157              
158 3         10 $self->_add_band($seq);
159             }
160 1         2 return 1;
161             }
162              
163              
164             =head2 _add_band
165              
166             Title : _add_band
167             Usage : $gel->_add_band($seq);
168             Function: Adds a new band to the gel.
169             Returns :
170             Args : Bio::Seq object
171              
172             =cut
173              
174             sub _add_band {
175 3     3   4 my ($self, $arg) = @_;
176 3 50       6 if ( defined $arg) {
177 3         3 push (@{$self->{'bands'}},$arg);
  3         8  
178             }
179 3         7 return 1;
180             }
181              
182              
183             =head2 dilate
184              
185             Title : dilate
186             Usage : $gel->dilate(1);
187             Function: Sets/retrieves the dilation factor.
188             Returns : dilation factor
189             Args : Float or none
190              
191             =cut
192              
193             sub dilate {
194 4     4 1 8 my ($self, $arg) = @_;
195 4 100       11 return $self->{dilate} unless $arg;
196 1 50 33     6 $self->throw("-dilate should be numeric") if defined $arg and $arg =~ /[^e\d\.]/;
197 1         4 $self->{dilate} = $arg;
198 1         2 return $self->{dilate};
199             }
200              
201              
202             sub migrate {
203 3     3 0 4 my ($self, $arg) = @_;
204 3 50       5 $arg = $self unless $arg;
205 3 50       6 if ( $arg ) {
206 3         5 return 4 - log10($arg);
207             } else {
208 0         0 return 0;
209             }
210             }
211              
212              
213             =head2 bands
214              
215             Title : bands
216             Usage : $gel->bands;
217             Function: Calculates migration distances of sequences.
218             Returns : hash of (seq_id => distance)
219             Args :
220              
221             =cut
222              
223             sub bands {
224 1     1 1 2 my $self = shift;
225 1 50       4 $self->throw("bands() is read-only") if @_;
226              
227 1         2 my %bands = ();
228              
229 1         2 foreach my $band (@{$self->{bands}}){
  1         3  
230 3         5 my $distance = $self->dilate * migrate($band->length);
231 3         8 $bands{$band->id} = $distance;
232             }
233              
234 1         8 return %bands;
235             }
236              
237              
238             =head2 log10
239              
240             Title : log10
241             Usage : log10($n);
242             Function: returns base 10 log of $n.
243             Returns : float
244             Args : float
245              
246             =cut
247              
248             # from "Programming Perl"
249             sub log10 {
250 3     3 1 5 my $n = shift;
251 3         14 return log($n)/log(10);
252             }
253              
254             1;