← Back to branch summary

~ubuntu-branches/ubuntu/vivid/bioperl/vivid

« back to all changes in this revision

Viewing changes to Bio/Tools/Gel.pm

  • Committer: Package Import Robot
  • Author(s): Charles Plessy
  • Date: 2013-09-22 13:39:48 UTC
  • mfrom: (3.1.11 sid)
  • Revision ID: package-import@ubuntu.com-20130922133948-c6z62zegjyp7ztou
Tags: 1.6.922-1
http://bugs.debian.org/722910
* New upstream release.
* Replaces and Breaks grinder (<< 0.5.3-3~) because of overlaping contents.
  Closes: #722910
* Stop Replacing and Breaking bioperl ( << 1.6.9 ): not needed anymore. 

Show diffs side-by-side

added added

removed removed

Lines of Context:
Bio/Tools/Gel.pm
35
35
    #25   26.0
36
36
    #10   30.0
37
37
 
38
 
 
39
38
=head1 DESCRIPTION
40
39
 
41
40
This takes a set of sequences or Bio::Seq objects, and calculates their
92
91
=cut
93
92
 
94
93
 
95
 
# Let the code begin...
96
 
 
97
 
 
98
94
package Bio::Tools::Gel;
99
95
use strict;
100
96
 
115
111
=cut
116
112
 
117
113
sub new {
118
 
  my($class,@args) = @_;
 
114
    my ($class, @args) = @_;
119
115
 
120
 
  my $self = $class->SUPER::new(@args);
121
 
  my ($seqs,$dilate) = $self->_rearrange([qw(SEQ DILATE)],
122
 
                                          @args);
123
 
  if( ! ref($seqs)  ) {
124
 
      $self->add_band([$seqs]);
125
 
  } elsif( ref($seqs) =~ /array/i ||
126
 
           $seqs->isa('Bio::PrimarySeqI') ) {
127
 
      $self->add_band($seqs);
128
 
  } 
129
 
  $self->dilate($dilate || 1);
 
116
    my $self = $class->SUPER::new(@args);
 
117
    my ($seqs, $dilate) = $self->_rearrange([qw(SEQ DILATE)], @args);
 
118
    if( ! ref($seqs)  ) {
 
119
        $self->add_band([$seqs]);
 
120
    } elsif( ref($seqs) =~ /array/i ||
 
121
        $seqs->isa('Bio::PrimarySeqI') ) {
 
122
        $self->add_band($seqs);
 
123
    }
 
124
    $self->dilate($dilate || 1);
130
125
  
131
 
  return $self;
 
126
    return $self;
132
127
}
133
128
 
134
129
 
143
138
=cut
144
139
 
145
140
sub add_band {
146
 
  my($self,$args) = @_;
147
 
 
148
 
  foreach my $arg (@$args){
149
 
      my $seq;
150
 
      if( ! ref($arg) ) {
151
 
          if( $arg =~ /^\d+/ ) {
152
 
              $seq= Bio::PrimarySeq->new(-seq=>"N"x$arg, -id => $arg);
153
 
          } else {
154
 
              $seq= Bio::PrimarySeq->new(-seq=>$arg,-id=>length($arg));
155
 
          }
156
 
      } elsif( $arg->isa('Bio::PrimarySeqI') ) {
157
 
          $seq = $arg;
158
 
      } 
159
 
 
160
 
    $seq->validate_seq or $seq->throw("invalid symbol in sequence".$seq->seq()."\n");
161
 
    $self->_add_band($seq);
162
 
  }
 
141
    my ($self, $args) = @_;
 
142
 
 
143
    foreach my $arg (@$args){
 
144
        my $seq;
 
145
        if( ! ref $arg ) {
 
146
            if( $arg =~ /^\d+/ ) {
 
147
                # $arg is a number
 
148
                $seq = Bio::PrimarySeq->new(-seq=>'N'x$arg, -id => $arg);
 
149
            } else {
 
150
                # $arg is a sequence string
 
151
                $seq = Bio::PrimarySeq->new(-seq=>$arg, -id=>length $arg);
 
152
            }
 
153
        } elsif( $arg->isa('Bio::PrimarySeqI') ) {
 
154
            # $arg is a sequence object
 
155
            $seq = $arg;
 
156
        }
 
157
 
 
158
        $self->_add_band($seq);
 
159
    }
 
160
    return 1;
163
161
}
164
162
 
 
163
 
165
164
=head2 _add_band
166
165
 
167
166
 Title   : _add_band
173
172
=cut
174
173
 
175
174
sub _add_band {
176
 
  my($self,$arg) = @_;  
177
 
  if( defined $arg) {
178
 
      push (@{$self->{'bands'}},$arg);
179
 
  }
 
175
    my ($self, $arg) = @_;  
 
176
    if ( defined $arg) {
 
177
        push (@{$self->{'bands'}},$arg);
 
178
    }
 
179
    return 1;
180
180
}
181
181
 
 
182
 
182
183
=head2 dilate
183
184
 
184
185
 Title   : dilate
190
191
=cut
191
192
 
192
193
sub dilate {
193
 
  my($self,$arg) = @_;
194
 
  return $self->{dilate} unless $arg;
195
 
  $self->throw("-dilate should be numeric") if defined $arg and $arg =~ /[^e\d\.]/;
196
 
  $self->{dilate} = $arg;
197
 
  return $self->{dilate};
 
194
    my ($self, $arg) = @_;
 
195
    return $self->{dilate} unless $arg;
 
196
    $self->throw("-dilate should be numeric") if defined $arg and $arg =~ /[^e\d\.]/;
 
197
    $self->{dilate} = $arg;
 
198
    return $self->{dilate};
198
199
}
199
200
 
 
201
 
200
202
sub migrate {
201
 
  my ($self,$arg) = @_;
202
 
  $arg = $self unless $arg;
203
 
  if ( $arg ) {
204
 
      return 4 - log10($arg);
205
 
  } else { return 0; }
 
203
    my ($self, $arg) = @_;
 
204
    $arg = $self unless $arg;
 
205
    if ( $arg ) {
 
206
        return 4 - log10($arg);
 
207
    } else {
 
208
        return 0;
 
209
    }
206
210
}
207
211
 
 
212
 
208
213
=head2 bands
209
214
 
210
215
 Title   : bands
216
221
=cut
217
222
 
218
223
sub bands {
219
 
  my $self = shift;
220
 
  $self->throw("bands() is read-only") if @_;
221
 
 
222
 
  my %bands = ();
223
 
  
224
 
  foreach my $band (@{$self->{bands}}){
225
 
      my $distance = $self->dilate * migrate($band->length);
226
 
      $bands{$band->id} = $distance;
227
 
  }
228
 
 
229
 
  return %bands;
 
224
    my $self = shift;
 
225
    $self->throw("bands() is read-only") if @_;
 
226
 
 
227
    my %bands = ();
 
228
 
 
229
    foreach my $band (@{$self->{bands}}){
 
230
        my $distance = $self->dilate * migrate($band->length);
 
231
        $bands{$band->id} = $distance;
 
232
    }
 
233
 
 
234
    return %bands;
230
235
}
231
236
 
 
237
 
232
238
=head2 log10
233
239
 
234
240
 Title   : log10
239
245
 
240
246
=cut
241
247
 
242
 
#from programming perl
 
248
# from "Programming Perl"
243
249
sub log10 {
244
250
    my $n = shift;
245
251
    return log($n)/log(10);