|
0
|
1 # $Id: Gel.pm,v 1.6 2002/10/22 07:45:22 lapp Exp $
|
|
|
2 # BioPerl module for Bio::Tools::Gel
|
|
|
3 # Copyright Allen Day <allenday@ucla.edu>
|
|
|
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 #An example of a virtual restriction digest and subsequent gel run
|
|
|
15 use Bio::Seq;
|
|
|
16 use Bio::Tools::RestrictionEnzyme;
|
|
|
17 use Bio::Tools::Gel;
|
|
|
18
|
|
|
19 my $d = 'AAAAAAAAAGAATTCTTTTTTTTTTTTTTGAATTCGGGGGGGGGGGGGGGGGGGG';
|
|
|
20 my $seq1 = Bio::Seq->new(-id=>'groundhog day',-seq=>$d);
|
|
|
21 my $EcoRI = Bio::Tools::RestrictionEnzyme->new(-NAME=>'EcoRI');
|
|
|
22 my @cuts = $EcoRI->cut_seq($seq);
|
|
|
23
|
|
|
24 my $gel = Bio::Tools::Gel->new(-seq=>\@cuts,-dilate=>10);
|
|
|
25 my %bands = $gel->bands;
|
|
|
26 foreach my $band (keys %bands){
|
|
|
27 print $band,"\t",$bands{$band},"\n";
|
|
|
28 }
|
|
|
29
|
|
|
30 #prints:
|
|
|
31 #25 26.0205999132796
|
|
|
32 #10 30
|
|
|
33 #20 26.9897000433602
|
|
|
34
|
|
|
35
|
|
|
36 =head1 DESCRIPTION
|
|
|
37
|
|
|
38 This takes a set of sequences or Bio::Seq objects, and calculates their
|
|
|
39 respective migration distances using:
|
|
|
40 distance = dilation * (4 - log10(length(dna));
|
|
|
41
|
|
|
42 Source: Molecular Cloning, a Laboratory Manual. Sambrook, Fritsch, Maniatis.
|
|
|
43 CSHL Press, 1989.
|
|
|
44
|
|
|
45 Bio::Tools::Gel currently calculates migration distances based solely on
|
|
|
46 the length of the nucleotide sequence. Secondary or tertiary structure,
|
|
|
47 curvature, and other biophysical attributes of a sequence are currently
|
|
|
48 not considered. Polypeptide migration is currently not supported.
|
|
|
49
|
|
|
50 =head1 FEEDBACK
|
|
|
51
|
|
|
52 =head2 Mailing Lists
|
|
|
53
|
|
|
54 User feedback is an integral part of the evolution of this and other
|
|
|
55 Bioperl modules. Send your comments and suggestions preferably to
|
|
|
56 the Bioperl mailing list. Your participation is much appreciated.
|
|
|
57
|
|
|
58 bioperl-l@bioperl.org - General discussion
|
|
|
59 http://bioperl.org/MailList.shtml - About the mailing lists
|
|
|
60
|
|
|
61 =head2 Reporting Bugs
|
|
|
62
|
|
|
63 Report bugs to the Bioperl bug tracking system to help us keep track
|
|
|
64 of the bugs and their resolution. Bug reports can be submitted via
|
|
|
65 email or the web:
|
|
|
66
|
|
|
67 bioperl-bugs@bioperl.org
|
|
|
68 http://bugzilla.bioperl.org/
|
|
|
69
|
|
|
70 =head1 AUTHOR - Allen Day
|
|
|
71
|
|
|
72 Email allenday@ucla.edu
|
|
|
73
|
|
|
74 =head1 APPENDIX
|
|
|
75
|
|
|
76 The rest of the documentation details each of the object methods.
|
|
|
77 Internal methods are usually preceded with a _
|
|
|
78
|
|
|
79 =cut
|
|
|
80
|
|
|
81
|
|
|
82 # Let the code begin...
|
|
|
83
|
|
|
84
|
|
|
85 package Bio::Tools::Gel;
|
|
|
86 use vars qw(@ISA);
|
|
|
87 use strict;
|
|
|
88
|
|
|
89 use Bio::Root::Root;
|
|
|
90 use Bio::PrimarySeq;
|
|
|
91
|
|
|
92 @ISA = qw(Bio::Root::Root);
|
|
|
93
|
|
|
94 =head2 new
|
|
|
95
|
|
|
96 Title : new
|
|
|
97 Usage : my $gel = new Bio::Tools::Gel(-seq => $sequence,-dilate => 3);
|
|
|
98 Function: Initializes a new Gel
|
|
|
99 Returns : Bio::Tools::Gel
|
|
|
100 Args : -seq => Bio::Seq(s), scalar(s) or list of either/both
|
|
|
101 (default: none)
|
|
|
102 -dilate => Expand band migration distances (default: 1)
|
|
|
103
|
|
|
104 =cut
|
|
|
105
|
|
|
106 sub new {
|
|
|
107 my($class,@args) = @_;
|
|
|
108
|
|
|
109 my $self = $class->SUPER::new(@args);
|
|
|
110 my ($seqs,$dilate) = $self->_rearrange([qw(SEQ DILATE)],
|
|
|
111 @args);
|
|
|
112 if( ! ref($seqs) ) {
|
|
|
113 $self->add_band([$seqs]);
|
|
|
114 } elsif( ref($seqs) =~ /array/i ||
|
|
|
115 $seqs->isa('Bio::PrimarySeqI') ) {
|
|
|
116 $self->add_band($seqs);
|
|
|
117 }
|
|
|
118 $self->dilate($dilate || 1);
|
|
|
119
|
|
|
120 return $self;
|
|
|
121 }
|
|
|
122
|
|
|
123
|
|
|
124 =head2 add_band
|
|
|
125
|
|
|
126 Title : add_band
|
|
|
127 Usage : $gel->add_band($seq);
|
|
|
128 Function: Calls _add_band with a (possibly created) Bio::Seq object.
|
|
|
129 Returns :
|
|
|
130 Args : Bio::Seq, scalar sequence, or list of either/both.
|
|
|
131
|
|
|
132 =cut
|
|
|
133
|
|
|
134 sub add_band {
|
|
|
135 my($self,$args) = @_;
|
|
|
136
|
|
|
137 foreach my $arg (@$args){
|
|
|
138 my $seq;
|
|
|
139 if( ! ref($arg) ) {
|
|
|
140 if( $arg =~ /^\d+/ ) {
|
|
|
141 $seq= Bio::PrimarySeq->new(-seq=>"N"x$arg, -id => $arg);
|
|
|
142 } else {
|
|
|
143 $seq= Bio::PrimarySeq->new(-seq=>$arg,-id=>length($arg));
|
|
|
144 }
|
|
|
145 } elsif( $arg->isa('Bio::PrimarySeqI') ) {
|
|
|
146 $seq = $arg;
|
|
|
147 }
|
|
|
148
|
|
|
149 $seq->validate_seq or $seq->throw("invalid symbol in sequence".$seq->seq()."\n");
|
|
|
150 $self->_add_band($seq);
|
|
|
151 }
|
|
|
152 }
|
|
|
153
|
|
|
154 =head2 _add_band
|
|
|
155
|
|
|
156 Title : _add_band
|
|
|
157 Usage : $gel->_add_band($seq);
|
|
|
158 Function: Adds a new band to the gel.
|
|
|
159 Returns :
|
|
|
160 Args : Bio::Seq object
|
|
|
161
|
|
|
162 =cut
|
|
|
163
|
|
|
164 sub _add_band {
|
|
|
165 my($self,$arg) = @_;
|
|
|
166 if( defined $arg) {
|
|
|
167 push (@{$self->{'bands'}},$arg);
|
|
|
168 }
|
|
|
169 }
|
|
|
170
|
|
|
171 =head2 dilate
|
|
|
172
|
|
|
173 Title : dilate
|
|
|
174 Usage : $gel->dilate(1);
|
|
|
175 Function: Sets/retrieves the dilation factor.
|
|
|
176 Returns : dilation factor
|
|
|
177 Args : Float or none
|
|
|
178
|
|
|
179 =cut
|
|
|
180
|
|
|
181 sub dilate {
|
|
|
182 my($self,$arg) = @_;
|
|
|
183 return $self->{dilate} unless $arg;
|
|
|
184 $self->throw("-dilate should be numeric") if defined $arg and $arg =~ /[^e\d\.]/;
|
|
|
185 $self->{dilate} = $arg;
|
|
|
186 return $self->{dilate};
|
|
|
187 }
|
|
|
188
|
|
|
189 sub migrate {
|
|
|
190 my ($self,$arg) = @_;
|
|
|
191 $arg = $self unless $arg;
|
|
|
192 if ( $arg ) {
|
|
|
193 return 4 - log10($arg);
|
|
|
194 } else { return 0; }
|
|
|
195 }
|
|
|
196
|
|
|
197 =head2 bands
|
|
|
198
|
|
|
199 Title : bands
|
|
|
200 Usage : $gel->bands;
|
|
|
201 Function: Calculates migration distances of sequences.
|
|
|
202 Returns : hash of (seq_id => distance)
|
|
|
203 Args :
|
|
|
204
|
|
|
205 =cut
|
|
|
206
|
|
|
207 sub bands {
|
|
|
208 my $self = shift;
|
|
|
209 $self->throw("bands() is read-only") if @_;
|
|
|
210
|
|
|
211 my %bands = ();
|
|
|
212
|
|
|
213 foreach my $band (@{$self->{bands}}){
|
|
|
214 my $distance = $self->dilate * migrate($band->length);
|
|
|
215 $bands{$band->id} = $distance;
|
|
|
216 }
|
|
|
217
|
|
|
218 return %bands;
|
|
|
219 }
|
|
|
220
|
|
|
221 =head2 log10
|
|
|
222
|
|
|
223 Title : log10
|
|
|
224 Usage : log10($n);
|
|
|
225 Function: returns base 10 log of $n.
|
|
|
226 Returns : float
|
|
|
227 Args : float
|
|
|
228
|
|
|
229 =cut
|
|
|
230
|
|
|
231 #from programming perl
|
|
|
232 sub log10 {
|
|
|
233 my $n = shift;
|
|
|
234 return log($n)/log(10);
|
|
|
235 }
|
|
|
236
|
|
|
237 1;
|
