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; |
