Mercurial > repos > mahtabm > ensembl
comparison variant_effect_predictor/Bio/Tools/Gel.pm @ 0:1f6dce3d34e0
Uploaded
author | mahtabm |
---|---|
date | Thu, 11 Apr 2013 02:01:53 -0400 |
parents | |
children |
comparison
equal
deleted
inserted
replaced
-1:000000000000 | 0:1f6dce3d34e0 |
---|---|
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; |