1
# $Id: Simple.pm,v 1.20 2002/03/08 20:00:00 jason Exp $
1
# $Id: Simple.pm,v 1.35 2003/12/18 13:15:20 jason Exp $
3
3
# BioPerl module for Bio::Location::Simple
4
# Cared for by Jason Stajich <jason@chg.mc.duke.edu>
4
# Cared for by Heikki Lehvaslaiho <heikki@ebi.ac.uk>
6
# Copyright Jason Stajich
6
# Copyright Heikki Lehvaslaiho
8
8
# You may distribute this module under the same terms as perl itself
9
9
# POD documentation - main docs before the code
30
This is an implementation of Bio::LocationI to manage simple location
31
information on a Sequence.
30
This is an implementation of Bio::LocationI to manage exact location
31
information on a Sequence: '22' or '12..15' or '16^17'.
33
You can test the type of the location using lenght() function () or
34
directly location_type() which can one of two values: 'EXACT' or
48
53
bioperl-bugs@bio.perl.org
49
http://bio.perl.org/bioperl-bugs/
51
=head1 AUTHOR - Jason Stajich
53
Email jason@chg.mc.duke.edu
54
http://bugzilla.bioperl.org/
56
=head1 AUTHOR - Heikki Lehvaslaiho
58
Email heikki@ebi.ac.uk
73
@ISA = qw(Bio::Root::Root Bio::LocationI);
74
use Bio::Location::Atomic;
76
@ISA = qw( Bio::Location::Atomic );
79
use vars qw( %RANGEENCODE %RANGEDECODE );
81
%RANGEENCODE = ('\.\.' => 'EXACT',
82
'\^' => 'IN-BETWEEN' );
84
%RANGEDECODE = ('EXACT' => '..',
85
'IN-BETWEEN' => '^' );
76
90
my ($class, @args) = @_;
81
my ($v,$start,$end,$strand,$seqid) = $self->_rearrange([qw(VERBOSE
86
defined $v && $self->verbose($v);
87
defined $strand && $self->strand($strand);
88
defined $start && $self->start($start);
89
defined $end && $self->end($end);
90
if( defined $self->start && defined $self->end &&
91
$self->start > $self->end ) {
92
$self->warn("When building a location start ($start) is expected to be less than end ($end), however it was not was not. Switching start and end and setting strand to -1");
100
$seqid && $self->seq_id($seqid);
91
my $self = $class->SUPER::new(@args);
93
my ($locationtype) = $self->_rearrange([qw(LOCATION_TYPE)],@args);
95
$locationtype && $self->location_type($locationtype);
117
112
my ($self, $value) = @_;
118
$self->min_start($value) if( defined $value );
119
return $self->SUPER::start();
114
$self->{'_start'} = $value if defined $value ;
116
$self->throw("Only adjacent residues when location type ".
117
"is IN-BETWEEN. Not [". $self->{'_start'}. "] and [".
118
$self->{'_end'}. "]" )
119
if defined $self->{'_start'} && defined $self->{'_end'} &&
120
$self->location_type eq 'IN-BETWEEN' &&
121
($self->{'_end'} - 1 != $self->{'_start'});
122
return $self->{'_start'};
134
138
my ($self, $value) = @_;
136
$self->min_end($value) if( defined $value );
137
return $self->SUPER::end();
140
$self->{'_end'} = $value if defined $value ;
141
$self->throw("Only adjacent residues when location type ".
142
"is IN-BETWEEN. Not [". $self->{'_start'}. "] and [".
143
$self->{'_end'}. "]" )
144
if defined $self->{'_start'} && defined $self->{'_end'} &&
145
$self->location_type eq 'IN-BETWEEN' &&
146
($self->{'_end'} - 1 != $self->{'_start'});
148
return $self->{'_end'};
152
my ($self, $value) = @_;
154
if ( defined $value ||
155
! defined $self->{'_strand'} ) {
156
# let's go ahead and force to '0' if
157
# we are requesting the strand without it
158
# having been set previously
160
$value = 0 unless defined($value);
162
if ( $value eq '+' ) { $value = 1; }
163
elsif ( $value eq '-' ) { $value = -1; }
164
elsif ( $value eq '.' ) { $value = 0; }
165
elsif ( $value != -1 && $value != 1 && $value != 0 ) {
166
$self->throw("$value is not a valid strand info");
168
$self->{'_strand'} = $value
170
return $self->{'_strand'};
187
return abs($self->end() - $self->start()) + 1;
176
if ($self->location_type eq 'IN-BETWEEN' ) {
179
return abs($self->end - $self->start) + 1;
192
186
Title : min_start
193
187
Usage : my $minstart = $location->min_start();
194
Function: Get minimum starting location of feature startpoint
188
Function: Get minimum starting location of feature startpoint
195
189
Returns : integer or undef if no minimum starting point.
201
my ($self,$value) = @_;
203
if(defined($value)) {
204
$self->{'_start'} = $value;
206
return $self->{'_start'};
211
196
Title : max_start
223
my ($self,@args) = @_;
224
return $self->min_start(@args);
227
207
=head2 start_pos_type
229
209
Title : start_pos_type
230
210
Usage : my $start_pos_type = $location->start_pos_type();
231
211
Function: Get start position type (ie <,>, ^).
233
In this implementation this will always be 'EXACT'.
235
213
Returns : type of position coded as text
236
('BEFORE', 'AFTER', 'EXACT','WITHIN', 'BETWEEN')
214
('BEFORE', 'AFTER', 'EXACT','WITHIN', 'BETWEEN', 'IN-BETWEEN')
279
my($self,@args) = @_;
280
return $self->min_end(@args);
283
243
=head2 end_pos_type
285
245
Title : end_pos_type
286
246
Usage : my $end_pos_type = $location->end_pos_type();
287
247
Function: Get end position type (ie <,>, ^)
289
In this implementation this will always be 'EXACT'.
291
249
Returns : type of position coded as text
292
('BEFORE', 'AFTER', 'EXACT','WITHIN', 'BETWEEN')
250
('BEFORE', 'AFTER', 'EXACT','WITHIN', 'BETWEEN', 'IN-BETWEEN')
302
255
=head2 location_type
304
257
Title : location_type
305
258
Usage : my $location_type = $location->location_type();
306
259
Function: Get location type encoded as text
307
Returns : string ('EXACT', 'WITHIN', 'BETWEEN')
260
Returns : string ('EXACT' or 'IN-BETWEEN')
261
Args : 'EXACT' or '..' or 'IN-BETWEEN' or '^'
312
265
sub location_type {
266
my ($self, $value) = @_;
268
if( defined $value || ! defined $self->{'_location_type'} ) {
269
$value = 'EXACT' unless defined $value;
271
if (! defined $RANGEDECODE{$value}) {
272
$value = '\^' if $value eq '^';
273
$value = '\.\.' if $value eq '..';
274
$value = $RANGEENCODE{$value};
276
$self->throw("Did not specify a valid location type. [$value] is no good")
277
unless defined $value;
278
$self->{'_location_type'} = $value;
280
$self->throw("Only adjacent residues when location type ".
281
"is IN-BETWEEN. Not [". $self->{'_start'}. "] and [".
282
$self->{'_end'}. "]" )
283
if $self->{'_location_type'} eq 'IN-BETWEEN' &&
284
defined $self->{'_start'} &&
285
defined $self->{'_end'} &&
286
($self->{'_end'} - 1 != $self->{'_start'});
288
return $self->{'_location_type'};
349
312
sub to_FTstring {
351
316
if( $self->start == $self->end ) {
354
my $str = $self->start . ".." . $self->end;
355
if( $self->strand == -1 ) {
356
$str = sprintf("complement(%s)", $str);
319
$str = $self->start . $RANGEDECODE{$self->location_type} . $self->end;
321
if($self->is_remote() && $self->seq_id()) {
322
$str = $self->seq_id() . ":" . $str;
324
if( defined $self->strand &&
325
$self->strand == -1 ) {
326
$str = "complement(".$str.")";
331
# comments, not function added by jason
333
# trunc is untested, and as of now unannounced method for truncating a
334
# location. This is to eventually be part of the procedure to
335
# truncate a sequence with annotatioin and properly remap the location
336
# of all the features contained within the truncated segment.
338
# presumably this might do things a little differently for the case
339
# where the truncation splits the location in half
341
# in short- you probably don't want to use this method.
363
344
my ($self,$start,$end,$relative_ori) = @_;
366
345
my $newstart = $self->start - $start+1;
367
346
my $newend = $self->end - $start+1;
368
347
my $newstrand = $relative_ori * $self->strand;