|
0
|
1 # $Id: Atomic.pm,v 1.6 2002/12/01 00:05:20 jason Exp $
|
|
|
2 #
|
|
|
3 # BioPerl module for Bio::Location::Atomic
|
|
|
4 # Cared for by Jason Stajich <jason@bioperl.org>
|
|
|
5 #
|
|
|
6 # Copyright Jason Stajich
|
|
|
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::Atomic - Implementation of a Atomic Location on a Sequence
|
|
|
14
|
|
|
15 =head1 SYNOPSIS
|
|
|
16
|
|
|
17 use Bio::Location::Atomic;
|
|
|
18
|
|
|
19 my $location = new Bio::Location::Atomic(-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 simple location
|
|
|
31 information on a Sequence.
|
|
|
32
|
|
|
33 =head1 FEEDBACK
|
|
|
34
|
|
|
35 User feedback is an integral part of the evolution of this and other
|
|
|
36 Bioperl modules. Send your comments and suggestions preferably to one
|
|
|
37 of the Bioperl mailing lists. Your participation is much appreciated.
|
|
|
38
|
|
|
39 bioperl-l@bioperl.org - General discussion
|
|
|
40 http://bio.perl.org/MailList.html - About the mailing lists
|
|
|
41
|
|
|
42 =head2 Reporting Bugs
|
|
|
43
|
|
|
44 Report bugs to the Bioperl bug tracking system to help us keep track
|
|
|
45 the bugs and their resolution. Bug reports can be submitted via email
|
|
|
46 or the web:
|
|
|
47
|
|
|
48 bioperl-bugs@bio.perl.org
|
|
|
49 http://bugzilla.bioperl.org/
|
|
|
50
|
|
|
51 =head1 AUTHOR - Jason Stajich
|
|
|
52
|
|
|
53 Email jason@bioperl.org
|
|
|
54
|
|
|
55 =head1 APPENDIX
|
|
|
56
|
|
|
57 The rest of the documentation details each of the object
|
|
|
58 methods. Internal methods are usually preceded with a _
|
|
|
59
|
|
|
60 =cut
|
|
|
61
|
|
|
62 # Let the code begin...
|
|
|
63
|
|
|
64
|
|
|
65 package Bio::Location::Atomic;
|
|
|
66 use vars qw(@ISA);
|
|
|
67 use strict;
|
|
|
68
|
|
|
69 use Bio::Root::Root;
|
|
|
70 use Bio::LocationI;
|
|
|
71
|
|
|
72
|
|
|
73 @ISA = qw(Bio::Root::Root Bio::LocationI);
|
|
|
74
|
|
|
75 sub new {
|
|
|
76 my ($class, @args) = @_;
|
|
|
77 my $self = {};
|
|
|
78
|
|
|
79 bless $self,$class;
|
|
|
80
|
|
|
81 my ($v,$start,$end,$strand,$seqid) = $self->_rearrange([qw(VERBOSE
|
|
|
82 START
|
|
|
83 END
|
|
|
84 STRAND
|
|
|
85 SEQ_ID)],@args);
|
|
|
86 defined $v && $self->verbose($v);
|
|
|
87 defined $strand && $self->strand($strand);
|
|
|
88
|
|
|
89 defined $start && $self->start($start);
|
|
|
90 defined $end && $self->end($end);
|
|
|
91 if( defined $self->start && defined $self->end &&
|
|
|
92 $self->start > $self->end && $self->strand != -1 ) {
|
|
|
93 $self->warn("When building a location, start ($start) is expected to be less than end ($end), ".
|
|
|
94 "however it was not. Switching start and end and setting strand to -1");
|
|
|
95
|
|
|
96 $self->strand(-1);
|
|
|
97 my $e = $self->end;
|
|
|
98 my $s = $self->start;
|
|
|
99 $self->start($e);
|
|
|
100 $self->end($s);
|
|
|
101 }
|
|
|
102 $seqid && $self->seq_id($seqid);
|
|
|
103
|
|
|
104 return $self;
|
|
|
105 }
|
|
|
106
|
|
|
107 =head2 start
|
|
|
108
|
|
|
109 Title : start
|
|
|
110 Usage : $start = $loc->start();
|
|
|
111 Function: get/set the start of this range
|
|
|
112 Returns : the start of this range
|
|
|
113 Args : optionaly allows the start to be set
|
|
|
114 : using $loc->start($start)
|
|
|
115
|
|
|
116 =cut
|
|
|
117
|
|
|
118 sub start {
|
|
|
119 my ($self, $value) = @_;
|
|
|
120 $self->min_start($value) if( defined $value );
|
|
|
121 return $self->SUPER::start();
|
|
|
122 }
|
|
|
123
|
|
|
124 =head2 end
|
|
|
125
|
|
|
126 Title : end
|
|
|
127 Usage : $end = $loc->end();
|
|
|
128 Function: get/set the end of this range
|
|
|
129 Returns : the end of this range
|
|
|
130 Args : optionaly allows the end to be set
|
|
|
131 : using $loc->end($start)
|
|
|
132
|
|
|
133 =cut
|
|
|
134
|
|
|
135 sub end {
|
|
|
136 my ($self, $value) = @_;
|
|
|
137
|
|
|
138 $self->min_end($value) if( defined $value );
|
|
|
139 return $self->SUPER::end();
|
|
|
140 }
|
|
|
141
|
|
|
142 =head2 strand
|
|
|
143
|
|
|
144 Title : strand
|
|
|
145 Usage : $strand = $loc->strand();
|
|
|
146 Function: get/set the strand of this range
|
|
|
147 Returns : the strandidness (-1, 0, +1)
|
|
|
148 Args : optionaly allows the strand to be set
|
|
|
149 : using $loc->strand($strand)
|
|
|
150
|
|
|
151 =cut
|
|
|
152
|
|
|
153 sub strand {
|
|
|
154 my ($self, $value) = @_;
|
|
|
155
|
|
|
156 if ( defined $value ) {
|
|
|
157 if ( $value eq '+' ) { $value = 1; }
|
|
|
158 elsif ( $value eq '-' ) { $value = -1; }
|
|
|
159 elsif ( $value eq '.' ) { $value = 0; }
|
|
|
160 elsif ( $value != -1 && $value != 1 && $value != 0 ) {
|
|
|
161 $self->throw("$value is not a valid strand info");
|
|
|
162 }
|
|
|
163 $self->{'_strand'} = $value
|
|
|
164 }
|
|
|
165 # let's go ahead and force to '0' if
|
|
|
166 # we are requesting the strand without it
|
|
|
167 # having been set previously
|
|
|
168 return $self->{'_strand'} || 0;
|
|
|
169 }
|
|
|
170
|
|
|
171 =head2 length
|
|
|
172
|
|
|
173 Title : length
|
|
|
174 Usage : $len = $loc->length();
|
|
|
175 Function: get the length in the coordinate space this location spans
|
|
|
176 Example :
|
|
|
177 Returns : an integer
|
|
|
178 Args : none
|
|
|
179
|
|
|
180
|
|
|
181 =cut
|
|
|
182
|
|
|
183 sub length {
|
|
|
184 my ($self) = @_;
|
|
|
185 return abs($self->end() - $self->start()) + 1;
|
|
|
186 }
|
|
|
187
|
|
|
188 =head2 min_start
|
|
|
189
|
|
|
190 Title : min_start
|
|
|
191 Usage : my $minstart = $location->min_start();
|
|
|
192 Function: Get minimum starting location of feature startpoint
|
|
|
193 Returns : integer or undef if no minimum starting point.
|
|
|
194 Args : none
|
|
|
195
|
|
|
196 =cut
|
|
|
197
|
|
|
198 sub min_start {
|
|
|
199 my ($self,$value) = @_;
|
|
|
200
|
|
|
201 if(defined($value)) {
|
|
|
202 $self->{'_start'} = $value;
|
|
|
203 }
|
|
|
204 return $self->{'_start'};
|
|
|
205 }
|
|
|
206
|
|
|
207 =head2 max_start
|
|
|
208
|
|
|
209 Title : max_start
|
|
|
210 Usage : my $maxstart = $location->max_start();
|
|
|
211 Function: Get maximum starting location of feature startpoint.
|
|
|
212
|
|
|
213 In this implementation this is exactly the same as min_start().
|
|
|
214
|
|
|
215 Returns : integer or undef if no maximum starting point.
|
|
|
216 Args : none
|
|
|
217
|
|
|
218 =cut
|
|
|
219
|
|
|
220 sub max_start {
|
|
|
221 my ($self,@args) = @_;
|
|
|
222 return $self->min_start(@args);
|
|
|
223 }
|
|
|
224
|
|
|
225 =head2 start_pos_type
|
|
|
226
|
|
|
227 Title : start_pos_type
|
|
|
228 Usage : my $start_pos_type = $location->start_pos_type();
|
|
|
229 Function: Get start position type (ie <,>, ^).
|
|
|
230
|
|
|
231 In this implementation this will always be 'EXACT'.
|
|
|
232
|
|
|
233 Returns : type of position coded as text
|
|
|
234 ('BEFORE', 'AFTER', 'EXACT','WITHIN', 'BETWEEN')
|
|
|
235 Args : none
|
|
|
236
|
|
|
237 =cut
|
|
|
238
|
|
|
239 sub start_pos_type {
|
|
|
240 my($self) = @_;
|
|
|
241 return 'EXACT';
|
|
|
242 }
|
|
|
243
|
|
|
244 =head2 min_end
|
|
|
245
|
|
|
246 Title : min_end
|
|
|
247 Usage : my $minend = $location->min_end();
|
|
|
248 Function: Get minimum ending location of feature endpoint
|
|
|
249 Returns : integer or undef if no minimum ending point.
|
|
|
250 Args : none
|
|
|
251
|
|
|
252 =cut
|
|
|
253
|
|
|
254 sub min_end {
|
|
|
255 my($self,$value) = @_;
|
|
|
256
|
|
|
257 if(defined($value)) {
|
|
|
258 $self->{'_end'} = $value;
|
|
|
259 }
|
|
|
260 return $self->{'_end'};
|
|
|
261 }
|
|
|
262
|
|
|
263 =head2 max_end
|
|
|
264
|
|
|
265 Title : max_end
|
|
|
266 Usage : my $maxend = $location->max_end();
|
|
|
267 Function: Get maximum ending location of feature endpoint
|
|
|
268
|
|
|
269 In this implementation this is exactly the same as min_end().
|
|
|
270
|
|
|
271 Returns : integer or undef if no maximum ending point.
|
|
|
272 Args : none
|
|
|
273
|
|
|
274 =cut
|
|
|
275
|
|
|
276 sub max_end {
|
|
|
277 my($self,@args) = @_;
|
|
|
278 return $self->min_end(@args);
|
|
|
279 }
|
|
|
280
|
|
|
281 =head2 end_pos_type
|
|
|
282
|
|
|
283 Title : end_pos_type
|
|
|
284 Usage : my $end_pos_type = $location->end_pos_type();
|
|
|
285 Function: Get end position type (ie <,>, ^)
|
|
|
286
|
|
|
287 In this implementation this will always be 'EXACT'.
|
|
|
288
|
|
|
289 Returns : type of position coded as text
|
|
|
290 ('BEFORE', 'AFTER', 'EXACT','WITHIN', 'BETWEEN')
|
|
|
291 Args : none
|
|
|
292
|
|
|
293 =cut
|
|
|
294
|
|
|
295 sub end_pos_type {
|
|
|
296 my($self) = @_;
|
|
|
297 return 'EXACT';
|
|
|
298 }
|
|
|
299
|
|
|
300 =head2 location_type
|
|
|
301
|
|
|
302 Title : location_type
|
|
|
303 Usage : my $location_type = $location->location_type();
|
|
|
304 Function: Get location type encoded as text
|
|
|
305 Returns : string ('EXACT', 'WITHIN', 'BETWEEN')
|
|
|
306 Args : none
|
|
|
307
|
|
|
308 =cut
|
|
|
309
|
|
|
310 sub location_type {
|
|
|
311 my ($self) = @_;
|
|
|
312 return 'EXACT';
|
|
|
313 }
|
|
|
314
|
|
|
315 =head2 is_remote
|
|
|
316
|
|
|
317 Title : is_remote
|
|
|
318 Usage : $self->is_remote($newval)
|
|
|
319 Function: Getset for is_remote value
|
|
|
320 Returns : value of is_remote
|
|
|
321 Args : newvalue (optional)
|
|
|
322
|
|
|
323
|
|
|
324 =cut
|
|
|
325
|
|
|
326 sub is_remote {
|
|
|
327 my $self = shift;
|
|
|
328 if( @_ ) {
|
|
|
329 my $value = shift;
|
|
|
330 $self->{'is_remote'} = $value;
|
|
|
331 }
|
|
|
332 return $self->{'is_remote'};
|
|
|
333
|
|
|
334 }
|
|
|
335
|
|
|
336 =head2 each_Location
|
|
|
337
|
|
|
338 Title : each_Location
|
|
|
339 Usage : @locations = $locObject->each_Location($order);
|
|
|
340 Function: Conserved function call across Location:: modules - will
|
|
|
341 return an array containing the component Location(s) in
|
|
|
342 that object, regardless if the calling object is itself a
|
|
|
343 single location or one containing sublocations.
|
|
|
344 Returns : an array of Bio::LocationI implementing objects - for
|
|
|
345 Simple locations, the return value is just itself.
|
|
|
346 Args :
|
|
|
347
|
|
|
348 =cut
|
|
|
349
|
|
|
350 sub each_Location {
|
|
|
351 my ($self) = @_;
|
|
|
352 return ($self);
|
|
|
353 }
|
|
|
354
|
|
|
355 =head2 to_FTstring
|
|
|
356
|
|
|
357 Title : to_FTstring
|
|
|
358 Usage : my $locstr = $location->to_FTstring()
|
|
|
359 Function: returns the FeatureTable string of this location
|
|
|
360 Returns : string
|
|
|
361 Args : none
|
|
|
362
|
|
|
363 =cut
|
|
|
364
|
|
|
365 sub to_FTstring {
|
|
|
366 my($self) = @_;
|
|
|
367 if( $self->start == $self->end ) {
|
|
|
368 return $self->start;
|
|
|
369 }
|
|
|
370 my $str = $self->start . ".." . $self->end;
|
|
|
371 if( $self->strand == -1 ) {
|
|
|
372 $str = sprintf("complement(%s)", $str);
|
|
|
373 }
|
|
|
374 return $str;
|
|
|
375 }
|
|
|
376
|
|
|
377
|
|
|
378 sub trunc {
|
|
|
379 my ($self,$start,$end,$relative_ori) = @_;
|
|
|
380
|
|
|
381 my $newstart = $self->start - $start+1;
|
|
|
382 my $newend = $self->end - $start+1;
|
|
|
383 my $newstrand = $relative_ori * $self->strand;
|
|
|
384
|
|
|
385 my $out;
|
|
|
386 if( $newstart < 1 || $newend > ($end-$start+1) ) {
|
|
|
387 $out = Bio::Location::Atomic->new();
|
|
|
388 $out->start($self->start);
|
|
|
389 $out->end($self->end);
|
|
|
390 $out->strand($self->strand);
|
|
|
391 $out->seq_id($self->seqid);
|
|
|
392 $out->is_remote(1);
|
|
|
393 } else {
|
|
|
394 $out = Bio::Location::Atomic->new();
|
|
|
395 $out->start($newstart);
|
|
|
396 $out->end($newend);
|
|
|
397 $out->strand($newstrand);
|
|
|
398 $out->seq_id();
|
|
|
399 }
|
|
|
400
|
|
|
401 return $out;
|
|
|
402 }
|
|
|
403
|
|
|
404 1;
|
|
|
405
|
