|
0
|
1 # $Id: Simple.pm,v 1.31 2002/10/22 07:38:35 lapp Exp $
|
|
|
2 #
|
|
|
3 # BioPerl module for Bio::Location::Simple
|
|
|
4 # Cared for by Heikki Lehvaslaiho <heikki@ebi.ac.uk>
|
|
|
5 #
|
|
|
6 # Copyright Heikki Lehvaslaiho
|
|
|
7 #
|
|
|
8 # You may distribute this module under the same terms as perl itself
|
|
|
9 # POD documentation - main docs before the code
|
|
|
10
|
|
|
11 =head1 NAME
|
|
|
12
|
|
|
13 Bio::Location::Simple - Implementation of a Simple Location on a Sequence
|
|
|
14
|
|
|
15 =head1 SYNOPSIS
|
|
|
16
|
|
|
17 use Bio::Location::Simple;
|
|
|
18
|
|
|
19 my $location = new Bio::Location::Simple(-start => 1, -end => 100,
|
|
|
20 -strand => 1 );
|
|
|
21
|
|
|
22 if( $location->strand == -1 ) {
|
|
|
23 printf "complement(%d..%d)\n", $location->start, $location->end;
|
|
|
24 } else {
|
|
|
25 printf "%d..%d\n", $location->start, $location->end;
|
|
|
26 }
|
|
|
27
|
|
|
28 =head1 DESCRIPTION
|
|
|
29
|
|
|
30 This is an implementation of Bio::LocationI to manage exact location
|
|
|
31 information on a Sequence: '22' or '12..15' or '16^17'.
|
|
|
32
|
|
|
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
|
|
|
35 'IN-BETWEEN'.
|
|
|
36
|
|
|
37
|
|
|
38 =head1 FEEDBACK
|
|
|
39
|
|
|
40 User feedback is an integral part of the evolution of this and other
|
|
|
41 Bioperl modules. Send your comments and suggestions preferably to one
|
|
|
42 of the Bioperl mailing lists. Your participation is much appreciated.
|
|
|
43
|
|
|
44 bioperl-l@bioperl.org - General discussion
|
|
|
45 http://bio.perl.org/MailList.html - About the mailing lists
|
|
|
46
|
|
|
47 =head2 Reporting Bugs
|
|
|
48
|
|
|
49 Report bugs to the Bioperl bug tracking system to help us keep track
|
|
|
50 the bugs and their resolution. Bug reports can be submitted via email
|
|
|
51 or the web:
|
|
|
52
|
|
|
53 bioperl-bugs@bio.perl.org
|
|
|
54 http://bugzilla.bioperl.org/
|
|
|
55
|
|
|
56 =head1 AUTHOR - Heikki Lehvaslaiho
|
|
|
57
|
|
|
58 Email heikki@ebi.ac.uk
|
|
|
59
|
|
|
60 =head1 APPENDIX
|
|
|
61
|
|
|
62 The rest of the documentation details each of the object
|
|
|
63 methods. Internal methods are usually preceded with a _
|
|
|
64
|
|
|
65 =cut
|
|
|
66
|
|
|
67 # Let the code begin...
|
|
|
68
|
|
|
69
|
|
|
70 package Bio::Location::Simple;
|
|
|
71 use vars qw(@ISA);
|
|
|
72 use strict;
|
|
|
73
|
|
|
74 use Bio::Root::Root;
|
|
|
75 use Bio::Location::Atomic;
|
|
|
76
|
|
|
77
|
|
|
78 @ISA = qw( Bio::Location::Atomic );
|
|
|
79
|
|
|
80 BEGIN {
|
|
|
81 use vars qw( %RANGEENCODE %RANGEDECODE );
|
|
|
82
|
|
|
83 %RANGEENCODE = ('\.\.' => 'EXACT',
|
|
|
84 '\^' => 'IN-BETWEEN' );
|
|
|
85
|
|
|
86 %RANGEDECODE = ('EXACT' => '..',
|
|
|
87 'IN-BETWEEN' => '^' );
|
|
|
88
|
|
|
89 }
|
|
|
90
|
|
|
91 sub new {
|
|
|
92 my ($class, @args) = @_;
|
|
|
93 my $self = $class->SUPER::new(@args);
|
|
|
94
|
|
|
95 my ($locationtype) = $self->_rearrange([qw(LOCATION_TYPE)],@args);
|
|
|
96
|
|
|
97 $locationtype && $self->location_type($locationtype);
|
|
|
98
|
|
|
99 return $self;
|
|
|
100 }
|
|
|
101
|
|
|
102 =head2 start
|
|
|
103
|
|
|
104 Title : start
|
|
|
105 Usage : $start = $loc->start();
|
|
|
106 Function: get/set the start of this range
|
|
|
107 Returns : the start of this range
|
|
|
108 Args : optionaly allows the start to be set
|
|
|
109 : using $loc->start($start)
|
|
|
110
|
|
|
111 =cut
|
|
|
112
|
|
|
113 sub start {
|
|
|
114 my ($self, $value) = @_;
|
|
|
115
|
|
|
116 $self->{'_start'} = $value if defined $value ;
|
|
|
117
|
|
|
118 $self->throw("Only adjacent residues when location type ".
|
|
|
119 "is IN-BETWEEN. Not [". $self->{'_start'}. "] and [".
|
|
|
120 $self->{'_end'}. "]" )
|
|
|
121 if defined $self->{'_start'} && defined $self->{'_end'} &&
|
|
|
122 $self->location_type eq 'IN-BETWEEN' &&
|
|
|
123 ($self->{'_end'} - 1 != $self->{'_start'});
|
|
|
124 return $self->{'_start'};
|
|
|
125 }
|
|
|
126
|
|
|
127
|
|
|
128 =head2 end
|
|
|
129
|
|
|
130 Title : end
|
|
|
131 Usage : $end = $loc->end();
|
|
|
132 Function: get/set the end of this range
|
|
|
133 Returns : the end of this range
|
|
|
134 Args : optionaly allows the end to be set
|
|
|
135 : using $loc->end($start)
|
|
|
136
|
|
|
137 =cut
|
|
|
138
|
|
|
139 sub end {
|
|
|
140 my ($self, $value) = @_;
|
|
|
141
|
|
|
142 $self->{'_end'} = $value if defined $value ;
|
|
|
143 $self->throw("Only adjacent residues when location type ".
|
|
|
144 "is IN-BETWEEN. Not [". $self->{'_start'}. "] and [".
|
|
|
145 $self->{'_end'}. "]" )
|
|
|
146 if defined $self->{'_start'} && defined $self->{'_end'} &&
|
|
|
147 $self->location_type eq 'IN-BETWEEN' &&
|
|
|
148 ($self->{'_end'} - 1 != $self->{'_start'});
|
|
|
149
|
|
|
150 return $self->{'_end'};
|
|
|
151 }
|
|
|
152
|
|
|
153 =head2 strand
|
|
|
154
|
|
|
155 Title : strand
|
|
|
156 Usage : $strand = $loc->strand();
|
|
|
157 Function: get/set the strand of this range
|
|
|
158 Returns : the strandidness (-1, 0, +1)
|
|
|
159 Args : optionaly allows the strand to be set
|
|
|
160 : using $loc->strand($strand)
|
|
|
161
|
|
|
162 =cut
|
|
|
163
|
|
|
164 =head2 length
|
|
|
165
|
|
|
166 Title : length
|
|
|
167 Usage : $len = $loc->length();
|
|
|
168 Function: get the length in the coordinate space this location spans
|
|
|
169 Example :
|
|
|
170 Returns : an integer
|
|
|
171 Args : none
|
|
|
172
|
|
|
173
|
|
|
174 =cut
|
|
|
175
|
|
|
176 sub length {
|
|
|
177 my ($self) = @_;
|
|
|
178 if ($self->location_type eq 'IN-BETWEEN' ) {
|
|
|
179 return 0;
|
|
|
180 } else {
|
|
|
181 return abs($self->end - $self->start) + 1;
|
|
|
182 }
|
|
|
183
|
|
|
184 }
|
|
|
185
|
|
|
186 =head2 min_start
|
|
|
187
|
|
|
188 Title : min_start
|
|
|
189 Usage : my $minstart = $location->min_start();
|
|
|
190 Function: Get minimum starting location of feature startpoint
|
|
|
191 Returns : integer or undef if no minimum starting point.
|
|
|
192 Args : none
|
|
|
193
|
|
|
194 =cut
|
|
|
195
|
|
|
196 =head2 max_start
|
|
|
197
|
|
|
198 Title : max_start
|
|
|
199 Usage : my $maxstart = $location->max_start();
|
|
|
200 Function: Get maximum starting location of feature startpoint.
|
|
|
201
|
|
|
202 In this implementation this is exactly the same as min_start().
|
|
|
203
|
|
|
204 Returns : integer or undef if no maximum starting point.
|
|
|
205 Args : none
|
|
|
206
|
|
|
207 =cut
|
|
|
208
|
|
|
209 =head2 start_pos_type
|
|
|
210
|
|
|
211 Title : start_pos_type
|
|
|
212 Usage : my $start_pos_type = $location->start_pos_type();
|
|
|
213 Function: Get start position type (ie <,>, ^).
|
|
|
214
|
|
|
215 Returns : type of position coded as text
|
|
|
216 ('BEFORE', 'AFTER', 'EXACT','WITHIN', 'BETWEEN', 'IN-BETWEEN')
|
|
|
217 Args : none
|
|
|
218
|
|
|
219 =cut
|
|
|
220
|
|
|
221 =head2 min_end
|
|
|
222
|
|
|
223 Title : min_end
|
|
|
224 Usage : my $minend = $location->min_end();
|
|
|
225 Function: Get minimum ending location of feature endpoint
|
|
|
226 Returns : integer or undef if no minimum ending point.
|
|
|
227 Args : none
|
|
|
228
|
|
|
229 =cut
|
|
|
230
|
|
|
231
|
|
|
232 =head2 max_end
|
|
|
233
|
|
|
234 Title : max_end
|
|
|
235 Usage : my $maxend = $location->max_end();
|
|
|
236 Function: Get maximum ending location of feature endpoint
|
|
|
237
|
|
|
238 In this implementation this is exactly the same as min_end().
|
|
|
239
|
|
|
240 Returns : integer or undef if no maximum ending point.
|
|
|
241 Args : none
|
|
|
242
|
|
|
243 =cut
|
|
|
244
|
|
|
245 =head2 end_pos_type
|
|
|
246
|
|
|
247 Title : end_pos_type
|
|
|
248 Usage : my $end_pos_type = $location->end_pos_type();
|
|
|
249 Function: Get end position type (ie <,>, ^)
|
|
|
250
|
|
|
251 Returns : type of position coded as text
|
|
|
252 ('BEFORE', 'AFTER', 'EXACT','WITHIN', 'BETWEEN', 'IN-BETWEEN')
|
|
|
253 Args : none
|
|
|
254
|
|
|
255 =cut
|
|
|
256
|
|
|
257 =head2 location_type
|
|
|
258
|
|
|
259 Title : location_type
|
|
|
260 Usage : my $location_type = $location->location_type();
|
|
|
261 Function: Get location type encoded as text
|
|
|
262 Returns : string ('EXACT' or 'IN-BETWEEN')
|
|
|
263 Args : 'EXACT' or '..' or 'IN-BETWEEN' or '^'
|
|
|
264
|
|
|
265 =cut
|
|
|
266
|
|
|
267 sub location_type {
|
|
|
268 my ($self, $value) = @_;
|
|
|
269
|
|
|
270 if( defined $value || ! defined $self->{'_location_type'} ) {
|
|
|
271 $value = 'EXACT' unless defined $value;
|
|
|
272 $value = uc $value;
|
|
|
273 if (! defined $RANGEDECODE{$value}) {
|
|
|
274 $value = '\^' if $value eq '^';
|
|
|
275 $value = '\.\.' if $value eq '..';
|
|
|
276 $value = $RANGEENCODE{$value};
|
|
|
277 }
|
|
|
278 $self->throw("Did not specify a valid location type. [$value] is no good")
|
|
|
279 unless defined $value;
|
|
|
280 $self->{'_location_type'} = $value;
|
|
|
281 }
|
|
|
282 $self->throw("Only adjacent residues when location type ".
|
|
|
283 "is IN-BETWEEN. Not [". $self->{'_start'}. "] and [".
|
|
|
284 $self->{'_end'}. "]" )
|
|
|
285 if $self->{'_location_type'} eq 'IN-BETWEEN' &&
|
|
|
286 defined $self->{'_start'} &&
|
|
|
287 defined $self->{'_end'} &&
|
|
|
288 ($self->{'_end'} - 1 != $self->{'_start'});
|
|
|
289
|
|
|
290 return $self->{'_location_type'};
|
|
|
291 }
|
|
|
292
|
|
|
293 =head2 is_remote
|
|
|
294
|
|
|
295 Title : is_remote
|
|
|
296 Usage : $self->is_remote($newval)
|
|
|
297 Function: Getset for is_remote value
|
|
|
298 Returns : value of is_remote
|
|
|
299 Args : newvalue (optional)
|
|
|
300
|
|
|
301
|
|
|
302 =cut
|
|
|
303
|
|
|
304 =head2 to_FTstring
|
|
|
305
|
|
|
306 Title : to_FTstring
|
|
|
307 Usage : my $locstr = $location->to_FTstring()
|
|
|
308 Function: returns the FeatureTable string of this location
|
|
|
309 Returns : string
|
|
|
310 Args : none
|
|
|
311
|
|
|
312 =cut
|
|
|
313
|
|
|
314 sub to_FTstring {
|
|
|
315 my($self) = @_;
|
|
|
316
|
|
|
317 my $str;
|
|
|
318 if( $self->start == $self->end ) {
|
|
|
319 return $self->start;
|
|
|
320 }
|
|
|
321 $str = $self->start . $RANGEDECODE{$self->location_type} . $self->end;
|
|
|
322 if($self->is_remote() && $self->seq_id()) {
|
|
|
323 $str = $self->seq_id() . ":" . $str;
|
|
|
324 }
|
|
|
325 if( $self->strand == -1 ) {
|
|
|
326 $str = "complement(".$str.")";
|
|
|
327 }
|
|
|
328 return $str;
|
|
|
329 }
|
|
|
330
|
|
|
331 #
|
|
|
332 # not tested
|
|
|
333 #
|
|
|
334 sub trunc {
|
|
|
335 my ($self,$start,$end,$relative_ori) = @_;
|
|
|
336
|
|
|
337 my $newstart = $self->start - $start+1;
|
|
|
338 my $newend = $self->end - $start+1;
|
|
|
339 my $newstrand = $relative_ori * $self->strand;
|
|
|
340
|
|
|
341 my $out;
|
|
|
342 if( $newstart < 1 || $newend > ($end-$start+1) ) {
|
|
|
343 $out = Bio::Location::Simple->new();
|
|
|
344 $out->start($self->start);
|
|
|
345 $out->end($self->end);
|
|
|
346 $out->strand($self->strand);
|
|
|
347 $out->seq_id($self->seqid);
|
|
|
348 $out->is_remote(1);
|
|
|
349 } else {
|
|
|
350 $out = Bio::Location::Simple->new();
|
|
|
351 $out->start($newstart);
|
|
|
352 $out->end($newend);
|
|
|
353 $out->strand($newstrand);
|
|
|
354 $out->seq_id();
|
|
|
355 }
|
|
|
356
|
|
|
357 return $out;
|
|
|
358 }
|
|
|
359
|
|
|
360 1;
|
|
|
361
|
