← Back to branch summary

~ubuntu-branches/ubuntu/trusty/bioperl/trusty

« back to all changes in this revision

Viewing changes to Bio/Location/Simple.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/Location/Simple.pm
17
17
 
18
18
    use Bio::Location::Simple;
19
19
 
20
 
    my $location = Bio::Location::Simple->new(-start => 1, -end => 100,
21
 
                         -strand => 1 );
 
20
    my $location = Bio::Location::Simple->new(
 
21
        -start  => 1,
 
22
        -end    => 100,
 
23
        -strand => 1,
 
24
    );
22
25
 
23
26
    if( $location->strand == -1 ) {
24
 
    printf "complement(%d..%d)\n", $location->start, $location->end;
 
27
        printf "complement(%d..%d)\n", $location->start, $location->end;
25
28
    } else {
26
 
    printf "%d..%d\n", $location->start, $location->end;
 
29
        printf "%d..%d\n", $location->start, $location->end;
27
30
    }
28
31
 
29
32
=head1 DESCRIPTION
84
87
use base qw(Bio::Location::Atomic);
85
88
 
86
89
our %RANGEENCODE  = ('\.\.' => 'EXACT',
87
 
             '\^'   => 'IN-BETWEEN' );
 
90
                     '\^'   => 'IN-BETWEEN' );
88
91
 
89
92
our %RANGEDECODE  = ('EXACT'      => '..',
90
 
             'IN-BETWEEN' => '^' );
 
93
                     'IN-BETWEEN' => '^' );
91
94
 
92
95
sub new { 
93
96
    my ($class, @args) = @_;
107
110
  Function: get/set the start of this range
108
111
  Returns : the start of this range
109
112
  Args    : optionaly allows the start to be set
110
 
          : using $loc->start($start)
 
113
            using $loc->start($start)
111
114
 
112
115
=cut
113
116
 
114
117
sub start {
115
 
  my ($self, $value) = @_;
 
118
    my ($self, $value) = @_;
116
119
    $self->{'_start'} = $value if defined $value ;
117
120
  
118
121
    $self->throw("Only adjacent residues when location type ".
134
137
  Args    : optionaly allows the end to be set
135
138
          : using $loc->end($start)
136
139
  Note    : If start is set but end is undefined, this now assumes that start
137
 
            is the same as end but throws a warning (i.e. it assumes this is
138
 
            a possible error). If start is undefined, this now throws an
139
 
            exception.
 
140
            is the same as end but throws a warning (i.e. it assumes this is
 
141
            a possible error). If start is undefined, this now throws an
 
142
            exception.
140
143
 
141
144
=cut
142
145
 
143
146
sub end {
144
 
        my ($self, $value) = @_;
145
 
  
146
 
        $self->{'_end'} = $value if defined $value ;
147
 
        
148
 
        #assume end is the same as start if not defined
149
 
        if (!defined $self->{'_end'}) {
150
 
                if (!defined $self->{'_start'}) {
151
 
                        $self->warn('Can not set Bio::Location::Simple::end() equal to start; start not set');
152
 
                        return;
153
 
                }
154
 
                $self->warn('Setting end to equal start['. $self->{'_start'}. ']');
155
 
                $self->{'_end'} = $self->{'_start'};
156
 
        }
157
 
        $self->throw("Only adjacent residues when location type ".
158
 
                        "is IN-BETWEEN. Not [". $self->{'_start'}. "] and [".
159
 
                         $self->{'_end'}. "]" )
160
 
                if defined $self->{'_start'} && defined $self->{'_end'} && 
161
 
                $self->location_type eq 'IN-BETWEEN' &&
162
 
                ($self->{'_end'} - 1 != $self->{'_start'});
163
 
  
164
 
        return $self->{'_end'};
 
147
    my ($self, $value) = @_;
 
148
  
 
149
    $self->{'_end'} = $value if defined $value ;
 
150
    
 
151
    # Assume end is the same as start if not defined
 
152
    if (!defined $self->{'_end'}) {
 
153
        if (!defined $self->{'_start'}) {
 
154
            $self->warn('Can not set Bio::Location::Simple::end() equal to start; start not set');
 
155
            return;
 
156
        }
 
157
        $self->warn('Setting end to equal start['. $self->{'_start'}. ']');
 
158
        $self->{'_end'} = $self->{'_start'};
 
159
    }
 
160
    $self->throw("Only adjacent residues when location type ".
 
161
            "is IN-BETWEEN. Not [". $self->{'_start'}. "] and [".
 
162
             $self->{'_end'}. "]" )
 
163
        if defined $self->{'_start'} && defined $self->{'_end'} && 
 
164
        $self->location_type eq 'IN-BETWEEN' &&
 
165
        ($self->{'_end'} - 1 != $self->{'_start'});
 
166
  
 
167
    return $self->{'_end'};
165
168
}
166
169
 
167
170
=head2 strand
187
190
=cut
188
191
 
189
192
sub length {
190
 
   my ($self) = @_;
191
 
   if ($self->location_type eq 'IN-BETWEEN' ) {
192
 
       return 0;
193
 
   } else {
194
 
       return abs($self->end - $self->start) + 1;
195
 
   }
196
 
 
 
193
    my ($self) = @_;
 
194
    if ($self->location_type eq 'IN-BETWEEN' ) {
 
195
        return 0;
 
196
    } else {
 
197
        return abs($self->end - $self->start) + 1;
 
198
    }
197
199
}
198
200
 
 
201
 
199
202
=head2 min_start
200
203
 
201
204
  Title   : min_start
281
284
    my ($self, $value) = @_;
282
285
 
283
286
    if( defined $value || ! defined $self->{'_location_type'} ) {
284
 
    $value = 'EXACT' unless defined $value;
285
 
    $value = uc $value;
286
 
    if (! defined $RANGEDECODE{$value}) {
287
 
        $value = '\^' if $value eq '^';
288
 
        $value = '\.\.' if $value eq '..';
289
 
        $value = $RANGEENCODE{$value};
290
 
    }
291
 
    $self->throw("Did not specify a valid location type. [$value] is no good")
292
 
        unless defined $value;
293
 
    $self->{'_location_type'} = $value;
 
287
        $value = 'EXACT' unless defined $value;
 
288
        $value = uc $value;
 
289
        if (! defined $RANGEDECODE{$value}) {
 
290
            $value = '\^' if $value eq '^';
 
291
            $value = '\.\.' if $value eq '..';
 
292
            $value = $RANGEENCODE{$value};
 
293
        }
 
294
        $self->throw("Did not specify a valid location type. [$value] is no good")
 
295
            unless defined $value;
 
296
        $self->{'_location_type'} = $value;
294
297
    }
295
298
    $self->throw("Only adjacent residues when location type ".
296
 
         "is IN-BETWEEN. Not [". $self->{'_start'}. "] and [".
297
 
         $self->{'_end'}. "]" )
298
 
    if $self->{'_location_type'} eq 'IN-BETWEEN' &&
 
299
            "is IN-BETWEEN. Not [". $self->{'_start'}. "] and [".
 
300
            $self->{'_end'}. "]" )
 
301
        if $self->{'_location_type'} eq 'IN-BETWEEN' &&
299
302
        defined $self->{'_start'} &&
300
303
        defined $self->{'_end'} &&
301
304
            ($self->{'_end'} - 1 != $self->{'_start'});
343
346
 
344
347
    my $str;
345
348
    if( $self->start == $self->end ) {
346
 
    $str =  $self->start;
 
349
        $str =  $self->start;
347
350
    } else {
348
351
        $str = $self->start . $RANGEDECODE{$self->location_type} . $self->end;
349
352
    }
350
353
    if($self->is_remote() && $self->seq_id()) {
351
 
    $str = $self->seq_id() . ":" . $str;
 
354
        $str = $self->seq_id() . ":" . $str;
352
355
    }
353
356
    if( defined $self->strand &&
354
 
    $self->strand == -1 ) {
355
 
    $str = "complement(".$str.")";
 
357
        $self->strand == -1 ) {
 
358
        $str = "complement(".$str.")";
356
359
    }
357
360
    return $str;
358
361
}
359
362
 
 
363
 
360
364
=head2 valid_Location
361
365
 
362
366
 Title   : valid_Location
372
376
#
373
377
# trunc is untested, and as of now unannounced method for truncating a
374
378
# location.  This is to eventually be part of the procedure to
375
 
# truncate a sequence with annotatioin and properly remap the location
 
379
# truncate a sequence with annotation and properly remap the location
376
380
# of all the features contained within the truncated segment.
377
381
 
378
382
# presumably this might do things a little differently for the case 
381
385
# in short- you probably don't want to use  this method.
382
386
 
383
387
sub trunc {
384
 
  my ($self,$start,$end,$relative_ori) = @_;
385
 
  my $newstart  = $self->start - $start+1;
386
 
  my $newend    = $self->end   - $start+1;
387
 
  my $newstrand = $relative_ori * $self->strand;
388
 
 
389
 
  my $out;
390
 
  if( $newstart < 1 || $newend > ($end-$start+1) ) {
391
 
    $out = Bio::Location::Simple->new();
392
 
    $out->start($self->start);
393
 
    $out->end($self->end);
394
 
    $out->strand($self->strand);
395
 
    $out->seq_id($self->seqid);
396
 
    $out->is_remote(1);
397
 
  } else {
398
 
    $out = Bio::Location::Simple->new();
399
 
    $out->start($newstart);
400
 
    $out->end($newend);
401
 
    $out->strand($newstrand);
402
 
    $out->seq_id();
403
 
  }
404
 
 
405
 
  return $out;
 
388
    my ($self,$start,$end,$relative_ori) = @_;
 
389
    my $newstart  = $self->start - $start+1;
 
390
    my $newend    = $self->end   - $start+1;
 
391
    my $newstrand = $relative_ori * $self->strand;
 
392
 
 
393
    my $out;
 
394
    if( $newstart < 1 || $newend > ($end-$start+1) ) {
 
395
        $out = Bio::Location::Simple->new();
 
396
        $out->start($self->start);
 
397
        $out->end($self->end);
 
398
        $out->strand($self->strand);
 
399
        $out->seq_id($self->seqid);
 
400
        $out->is_remote(1);
 
401
    } else {
 
402
        $out = Bio::Location::Simple->new();
 
403
        $out->start($newstart);
 
404
        $out->end($newend);
 
405
        $out->strand($newstrand);
 
406
       $out->seq_id();
 
407
    }
 
408
 
 
409
    return $out;
406
410
}
407
411
 
408
412
1;