Filename | /Users/ap13/perl5/lib/perl5/Bio/Location/Atomic.pm |
Statements | Executed 8 statements in 1.62ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 278µs | 726µs | BEGIN@79 | Bio::Location::Atomic::
1 | 1 | 1 | 16µs | 28µs | BEGIN@77 | Bio::Location::Atomic::
1 | 1 | 1 | 11µs | 3.78ms | BEGIN@81 | Bio::Location::Atomic::
0 | 0 | 0 | 0s | 0s | coordinate_policy | Bio::Location::Atomic::
0 | 0 | 0 | 0s | 0s | each_Location | Bio::Location::Atomic::
0 | 0 | 0 | 0s | 0s | end | Bio::Location::Atomic::
0 | 0 | 0 | 0s | 0s | end_pos_type | Bio::Location::Atomic::
0 | 0 | 0 | 0s | 0s | flip_strand | Bio::Location::Atomic::
0 | 0 | 0 | 0s | 0s | is_remote | Bio::Location::Atomic::
0 | 0 | 0 | 0s | 0s | length | Bio::Location::Atomic::
0 | 0 | 0 | 0s | 0s | location_type | Bio::Location::Atomic::
0 | 0 | 0 | 0s | 0s | max_end | Bio::Location::Atomic::
0 | 0 | 0 | 0s | 0s | max_start | Bio::Location::Atomic::
0 | 0 | 0 | 0s | 0s | min_end | Bio::Location::Atomic::
0 | 0 | 0 | 0s | 0s | min_start | Bio::Location::Atomic::
0 | 0 | 0 | 0s | 0s | new | Bio::Location::Atomic::
0 | 0 | 0 | 0s | 0s | seq_id | Bio::Location::Atomic::
0 | 0 | 0 | 0s | 0s | start | Bio::Location::Atomic::
0 | 0 | 0 | 0s | 0s | start_pos_type | Bio::Location::Atomic::
0 | 0 | 0 | 0s | 0s | strand | Bio::Location::Atomic::
0 | 0 | 0 | 0s | 0s | to_FTstring | Bio::Location::Atomic::
0 | 0 | 0 | 0s | 0s | trunc | Bio::Location::Atomic::
0 | 0 | 0 | 0s | 0s | valid_Location | Bio::Location::Atomic::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | # | ||||
2 | # BioPerl module for Bio::Location::Atomic | ||||
3 | # Please direct questions and support issues to <bioperl-l@bioperl.org> | ||||
4 | # | ||||
5 | # Cared for by Jason Stajich <jason@bioperl.org> | ||||
6 | # | ||||
7 | # Copyright Jason Stajich | ||||
8 | # | ||||
9 | # You may distribute this module under the same terms as perl itself | ||||
10 | # POD documentation - main docs before the code | ||||
11 | |||||
12 | =head1 NAME | ||||
13 | |||||
14 | Bio::Location::Atomic - Implementation of a Atomic Location on a Sequence | ||||
15 | |||||
16 | =head1 SYNOPSIS | ||||
17 | |||||
18 | use Bio::Location::Atomic; | ||||
19 | |||||
20 | my $location = Bio::Location::Atomic->new(-start => 1, -end => 100, | ||||
21 | -strand => 1 ); | ||||
22 | |||||
23 | if( $location->strand == -1 ) { | ||||
24 | printf "complement(%d..%d)\n", $location->start, $location->end; | ||||
25 | } else { | ||||
26 | printf "%d..%d\n", $location->start, $location->end; | ||||
27 | } | ||||
28 | |||||
29 | =head1 DESCRIPTION | ||||
30 | |||||
31 | This is an implementation of Bio::LocationI to manage simple location | ||||
32 | information on a Sequence. | ||||
33 | |||||
34 | =head1 FEEDBACK | ||||
35 | |||||
36 | User feedback is an integral part of the evolution of this and other | ||||
37 | Bioperl modules. Send your comments and suggestions preferably to one | ||||
38 | of the Bioperl mailing lists. Your participation is much appreciated. | ||||
39 | |||||
40 | bioperl-l@bioperl.org - General discussion | ||||
41 | http://bioperl.org/wiki/Mailing_lists - About the mailing lists | ||||
42 | |||||
43 | =head2 Support | ||||
44 | |||||
45 | Please direct usage questions or support issues to the mailing list: | ||||
46 | |||||
47 | I<bioperl-l@bioperl.org> | ||||
48 | |||||
49 | rather than to the module maintainer directly. Many experienced and | ||||
50 | reponsive experts will be able look at the problem and quickly | ||||
51 | address it. Please include a thorough description of the problem | ||||
52 | with code and data examples if at all possible. | ||||
53 | |||||
54 | =head2 Reporting Bugs | ||||
55 | |||||
56 | Report bugs to the Bioperl bug tracking system to help us keep track | ||||
57 | the bugs and their resolution. Bug reports can be submitted via the | ||||
58 | web: | ||||
59 | |||||
60 | https://github.com/bioperl/bioperl-live/issues | ||||
61 | |||||
62 | =head1 AUTHOR - Jason Stajich | ||||
63 | |||||
64 | Email jason-at-bioperl-dot-org | ||||
65 | |||||
66 | =head1 APPENDIX | ||||
67 | |||||
68 | The rest of the documentation details each of the object | ||||
69 | methods. Internal methods are usually preceded with a _ | ||||
70 | |||||
71 | =cut | ||||
72 | |||||
73 | # Let the code begin... | ||||
74 | |||||
75 | |||||
76 | package Bio::Location::Atomic; | ||||
77 | 2 | 23µs | 2 | 40µs | # spent 28µs (16+11) within Bio::Location::Atomic::BEGIN@77 which was called:
# once (16µs+11µs) by base::import at line 77 # spent 28µs making 1 call to Bio::Location::Atomic::BEGIN@77
# spent 12µs making 1 call to strict::import |
78 | |||||
79 | 2 | 157µs | 1 | 726µs | # spent 726µs (278+448) within Bio::Location::Atomic::BEGIN@79 which was called:
# once (278µs+448µs) by base::import at line 79 # spent 726µs making 1 call to Bio::Location::Atomic::BEGIN@79 |
80 | |||||
81 | 2 | 1.43ms | 2 | 3.78ms | # spent 3.78ms (11µs+3.77) within Bio::Location::Atomic::BEGIN@81 which was called:
# once (11µs+3.77ms) by base::import at line 81 # spent 3.78ms making 1 call to Bio::Location::Atomic::BEGIN@81
# spent 3.77ms making 1 call to base::import, recursion: max depth 1, sum of overlapping time 3.77ms |
82 | |||||
83 | 1 | 5µs | 1 | 42µs | our $coord_policy = Bio::Location::WidestCoordPolicy->new(); # spent 42µs making 1 call to Bio::Location::WidestCoordPolicy::new |
84 | |||||
85 | sub new { | ||||
86 | my ($class, @args) = @_; | ||||
87 | $class = ref $class || $class; | ||||
88 | my $self = {}; | ||||
89 | # This is for the case when we've done something like this | ||||
90 | # get a 2 features from somewhere (like Bio::Tools::GFF) | ||||
91 | # Do | ||||
92 | # my $location = $f1->location->union($f2->location); | ||||
93 | # We get an error without the following code which | ||||
94 | # explictly loads the Bio::Location::Simple class | ||||
95 | unless( $class->can('start') ) { | ||||
96 | eval { Bio::Root::Root->_load_module($class) }; | ||||
97 | if ( $@ ) { | ||||
98 | Bio::Root::Root->throw("$class cannot be found\nException $@"); | ||||
99 | } | ||||
100 | } | ||||
101 | bless $self,$class; | ||||
102 | |||||
103 | my ($v,$start,$end,$strand,$seqid) = $self->_rearrange([qw(VERBOSE | ||||
104 | START | ||||
105 | END | ||||
106 | STRAND | ||||
107 | SEQ_ID)],@args); | ||||
108 | defined $v && $self->verbose($v); | ||||
109 | defined $strand && $self->strand($strand); | ||||
110 | |||||
111 | defined $start && $self->start($start); | ||||
112 | defined $end && $self->end($end); | ||||
113 | if( defined $self->start && defined $self->end && | ||||
114 | $self->start > $self->end && $self->strand != -1 ) { | ||||
115 | $self->warn("When building a location, start ($start) is expected to be less than end ($end), ". | ||||
116 | "however it was not. Switching start and end and setting strand to -1"); | ||||
117 | |||||
118 | $self->strand(-1); | ||||
119 | my $e = $self->end; | ||||
120 | my $s = $self->start; | ||||
121 | $self->start($e); | ||||
122 | $self->end($s); | ||||
123 | } | ||||
124 | $seqid && $self->seq_id($seqid); | ||||
125 | |||||
126 | return $self; | ||||
127 | } | ||||
128 | |||||
129 | =head2 start | ||||
130 | |||||
131 | Title : start | ||||
132 | Usage : $start = $loc->start(); | ||||
133 | Function: get/set the start of this range | ||||
134 | Returns : the start of this range | ||||
135 | Args : optionaly allows the start to be set | ||||
136 | : using $loc->start($start) | ||||
137 | |||||
138 | =cut | ||||
139 | |||||
140 | sub start { | ||||
141 | my ($self, $value) = @_; | ||||
142 | $self->min_start($value) if( defined $value ); | ||||
143 | return $self->SUPER::start(); | ||||
144 | } | ||||
145 | |||||
146 | =head2 end | ||||
147 | |||||
148 | Title : end | ||||
149 | Usage : $end = $loc->end(); | ||||
150 | Function: get/set the end of this range | ||||
151 | Returns : the end of this range | ||||
152 | Args : optionaly allows the end to be set | ||||
153 | : using $loc->end($start) | ||||
154 | |||||
155 | =cut | ||||
156 | |||||
157 | sub end { | ||||
158 | my ($self, $value) = @_; | ||||
159 | |||||
160 | $self->min_end($value) if( defined $value ); | ||||
161 | return $self->SUPER::end(); | ||||
162 | } | ||||
163 | |||||
164 | =head2 strand | ||||
165 | |||||
166 | Title : strand | ||||
167 | Usage : $strand = $loc->strand(); | ||||
168 | Function: get/set the strand of this range | ||||
169 | Returns : the strandidness (-1, 0, +1) | ||||
170 | Args : optionaly allows the strand to be set | ||||
171 | : using $loc->strand($strand) | ||||
172 | |||||
173 | =cut | ||||
174 | |||||
175 | sub strand { | ||||
176 | my $self = shift; | ||||
177 | |||||
178 | if ( @_ ) { | ||||
179 | my $value = shift; | ||||
180 | if ( defined($value) ) { | ||||
181 | if ( $value eq '+' ) { $value = 1; } | ||||
182 | elsif ( $value eq '-' ) { $value = -1; } | ||||
183 | elsif ( $value eq '.' ) { $value = 0; } | ||||
184 | elsif ( $value != -1 && $value != 1 && $value != 0 ) { | ||||
185 | $self->throw("$value is not a valid strand info"); | ||||
186 | } | ||||
187 | $self->{'_strand'} = $value; | ||||
188 | } | ||||
189 | } | ||||
190 | # do not pretend the strand has been set if in fact it wasn't | ||||
191 | return $self->{'_strand'}; | ||||
192 | #return $self->{'_strand'} || 0; | ||||
193 | } | ||||
194 | |||||
195 | =head2 flip_strand | ||||
196 | |||||
197 | Title : flip_strand | ||||
198 | Usage : $location->flip_strand(); | ||||
199 | Function: Flip-flop a strand to the opposite | ||||
200 | Returns : None | ||||
201 | Args : None | ||||
202 | |||||
203 | =cut | ||||
204 | |||||
205 | |||||
206 | sub flip_strand { | ||||
207 | my $self= shift; | ||||
208 | # Initialize strand if necessary to flip it | ||||
209 | if (not defined $self->strand) { | ||||
210 | $self->strand(1) | ||||
211 | } | ||||
212 | $self->strand($self->strand * -1); | ||||
213 | } | ||||
214 | |||||
215 | |||||
216 | =head2 seq_id | ||||
217 | |||||
218 | Title : seq_id | ||||
219 | Usage : my $seqid = $location->seq_id(); | ||||
220 | Function: Get/Set seq_id that location refers to | ||||
221 | Returns : seq_id (a string) | ||||
222 | Args : [optional] seq_id value to set | ||||
223 | |||||
224 | =cut | ||||
225 | |||||
226 | |||||
227 | sub seq_id { | ||||
228 | my ($self, $seqid) = @_; | ||||
229 | if( defined $seqid ) { | ||||
230 | $self->{'_seqid'} = $seqid; | ||||
231 | } | ||||
232 | return $self->{'_seqid'}; | ||||
233 | } | ||||
234 | |||||
235 | =head2 length | ||||
236 | |||||
237 | Title : length | ||||
238 | Usage : $len = $loc->length(); | ||||
239 | Function: get the length in the coordinate space this location spans | ||||
240 | Example : | ||||
241 | Returns : an integer | ||||
242 | Args : none | ||||
243 | |||||
244 | |||||
245 | =cut | ||||
246 | |||||
247 | sub length { | ||||
248 | my ($self) = @_; | ||||
249 | return abs($self->end() - $self->start()) + 1; | ||||
250 | } | ||||
251 | |||||
252 | =head2 min_start | ||||
253 | |||||
254 | Title : min_start | ||||
255 | Usage : my $minstart = $location->min_start(); | ||||
256 | Function: Get minimum starting location of feature startpoint | ||||
257 | Returns : integer or undef if no minimum starting point. | ||||
258 | Args : none | ||||
259 | |||||
260 | =cut | ||||
261 | |||||
262 | sub min_start { | ||||
263 | my ($self,$value) = @_; | ||||
264 | |||||
265 | if(defined($value)) { | ||||
266 | $self->{'_start'} = $value; | ||||
267 | } | ||||
268 | return $self->{'_start'}; | ||||
269 | } | ||||
270 | |||||
271 | =head2 max_start | ||||
272 | |||||
273 | Title : max_start | ||||
274 | Usage : my $maxstart = $location->max_start(); | ||||
275 | Function: Get maximum starting location of feature startpoint. | ||||
276 | |||||
277 | In this implementation this is exactly the same as min_start(). | ||||
278 | |||||
279 | Returns : integer or undef if no maximum starting point. | ||||
280 | Args : none | ||||
281 | |||||
282 | =cut | ||||
283 | |||||
284 | sub max_start { | ||||
285 | my ($self,@args) = @_; | ||||
286 | return $self->min_start(@args); | ||||
287 | } | ||||
288 | |||||
289 | =head2 start_pos_type | ||||
290 | |||||
291 | Title : start_pos_type | ||||
292 | Usage : my $start_pos_type = $location->start_pos_type(); | ||||
293 | Function: Get start position type (ie <,>, ^). | ||||
294 | |||||
295 | In this implementation this will always be 'EXACT'. | ||||
296 | |||||
297 | Returns : type of position coded as text | ||||
298 | ('BEFORE', 'AFTER', 'EXACT','WITHIN', 'BETWEEN') | ||||
299 | Args : none | ||||
300 | |||||
301 | =cut | ||||
302 | |||||
303 | sub start_pos_type { | ||||
304 | my($self) = @_; | ||||
305 | return 'EXACT'; | ||||
306 | } | ||||
307 | |||||
308 | =head2 min_end | ||||
309 | |||||
310 | Title : min_end | ||||
311 | Usage : my $minend = $location->min_end(); | ||||
312 | Function: Get minimum ending location of feature endpoint | ||||
313 | Returns : integer or undef if no minimum ending point. | ||||
314 | Args : none | ||||
315 | |||||
316 | =cut | ||||
317 | |||||
318 | sub min_end { | ||||
319 | my($self,$value) = @_; | ||||
320 | |||||
321 | if(defined($value)) { | ||||
322 | $self->{'_end'} = $value; | ||||
323 | } | ||||
324 | return $self->{'_end'}; | ||||
325 | } | ||||
326 | |||||
327 | =head2 max_end | ||||
328 | |||||
329 | Title : max_end | ||||
330 | Usage : my $maxend = $location->max_end(); | ||||
331 | Function: Get maximum ending location of feature endpoint | ||||
332 | |||||
333 | In this implementation this is exactly the same as min_end(). | ||||
334 | |||||
335 | Returns : integer or undef if no maximum ending point. | ||||
336 | Args : none | ||||
337 | |||||
338 | =cut | ||||
339 | |||||
340 | sub max_end { | ||||
341 | my($self,@args) = @_; | ||||
342 | return $self->min_end(@args); | ||||
343 | } | ||||
344 | |||||
345 | =head2 end_pos_type | ||||
346 | |||||
347 | Title : end_pos_type | ||||
348 | Usage : my $end_pos_type = $location->end_pos_type(); | ||||
349 | Function: Get end position type (ie <,>, ^) | ||||
350 | |||||
351 | In this implementation this will always be 'EXACT'. | ||||
352 | |||||
353 | Returns : type of position coded as text | ||||
354 | ('BEFORE', 'AFTER', 'EXACT','WITHIN', 'BETWEEN') | ||||
355 | Args : none | ||||
356 | |||||
357 | =cut | ||||
358 | |||||
359 | sub end_pos_type { | ||||
360 | my($self) = @_; | ||||
361 | return 'EXACT'; | ||||
362 | } | ||||
363 | |||||
364 | =head2 location_type | ||||
365 | |||||
366 | Title : location_type | ||||
367 | Usage : my $location_type = $location->location_type(); | ||||
368 | Function: Get location type encoded as text | ||||
369 | Returns : string ('EXACT', 'WITHIN', 'IN-BETWEEN') | ||||
370 | Args : none | ||||
371 | |||||
372 | =cut | ||||
373 | |||||
374 | sub location_type { | ||||
375 | my ($self) = @_; | ||||
376 | return 'EXACT'; | ||||
377 | } | ||||
378 | |||||
379 | =head2 is_remote | ||||
380 | |||||
381 | Title : is_remote | ||||
382 | Usage : $is_remote_loc = $loc->is_remote() | ||||
383 | Function: Whether or not a location is a remote location. | ||||
384 | |||||
385 | A location is said to be remote if it is on a different | ||||
386 | 'object' than the object which 'has' this | ||||
387 | location. Typically, features on a sequence will sometimes | ||||
388 | have a remote location, which means that the location of | ||||
389 | the feature is on a different sequence than the one that is | ||||
390 | attached to the feature. In such a case, $loc->seq_id will | ||||
391 | be different from $feat->seq_id (usually they will be the | ||||
392 | same). | ||||
393 | |||||
394 | While this may sound weird, it reflects the location of the | ||||
395 | kind of AL445212.9:83662..166657 which can be found in GenBank/EMBL | ||||
396 | feature tables. | ||||
397 | |||||
398 | Example : | ||||
399 | Returns : TRUE if the location is a remote location, and FALSE otherwise | ||||
400 | Args : Value to set to | ||||
401 | |||||
402 | =cut | ||||
403 | |||||
404 | sub is_remote { | ||||
405 | my $self = shift; | ||||
406 | if( @_ ) { | ||||
407 | my $value = shift; | ||||
408 | $self->{'is_remote'} = $value; | ||||
409 | } | ||||
410 | return $self->{'is_remote'}; | ||||
411 | } | ||||
412 | |||||
413 | =head2 each_Location | ||||
414 | |||||
415 | Title : each_Location | ||||
416 | Usage : @locations = $locObject->each_Location($order); | ||||
417 | Function: Conserved function call across Location:: modules - will | ||||
418 | return an array containing the component Location(s) in | ||||
419 | that object, regardless if the calling object is itself a | ||||
420 | single location or one containing sublocations. | ||||
421 | Returns : an array of Bio::LocationI implementing objects - for | ||||
422 | Simple locations, the return value is just itself. | ||||
423 | Args : | ||||
424 | |||||
425 | =cut | ||||
426 | |||||
427 | sub each_Location { | ||||
428 | my ($self) = @_; | ||||
429 | return ($self); | ||||
430 | } | ||||
431 | |||||
432 | =head2 to_FTstring | ||||
433 | |||||
434 | Title : to_FTstring | ||||
435 | Usage : my $locstr = $location->to_FTstring() | ||||
436 | Function: returns the FeatureTable string of this location | ||||
437 | Returns : string | ||||
438 | Args : none | ||||
439 | |||||
440 | =cut | ||||
441 | |||||
442 | sub to_FTstring { | ||||
443 | my($self) = @_; | ||||
444 | if( $self->start == $self->end ) { | ||||
445 | return $self->start; | ||||
446 | } | ||||
447 | my $str = $self->start . ".." . $self->end; | ||||
448 | if( $self->strand == -1 ) { | ||||
449 | $str = sprintf("complement(%s)", $str); | ||||
450 | } | ||||
451 | return $str; | ||||
452 | } | ||||
453 | |||||
454 | =head2 valid_Location | ||||
455 | |||||
456 | Title : valid_Location | ||||
457 | Usage : if ($location->valid_location) {...}; | ||||
458 | Function: boolean method to determine whether location is considered valid | ||||
459 | (has minimum requirements for Simple implementation) | ||||
460 | Returns : Boolean value: true if location is valid, false otherwise | ||||
461 | Args : none | ||||
462 | |||||
463 | =cut | ||||
464 | |||||
465 | sub valid_Location { | ||||
466 | my ($self) = @_; | ||||
467 | return 1 if $self->{'_start'} && $self->{'_end'}; | ||||
468 | return 0; | ||||
469 | } | ||||
470 | |||||
471 | =head2 coordinate_policy | ||||
472 | |||||
473 | Title : coordinate_policy | ||||
474 | Usage : $policy = $location->coordinate_policy(); | ||||
475 | $location->coordinate_policy($mypolicy); # set may not be possible | ||||
476 | Function: Get the coordinate computing policy employed by this object. | ||||
477 | |||||
478 | See L<Bio::Location::CoordinatePolicyI> for documentation | ||||
479 | about the policy object and its use. | ||||
480 | |||||
481 | The interface *does not* require implementing classes to | ||||
482 | accept setting of a different policy. The implementation | ||||
483 | provided here does, however, allow to do so. | ||||
484 | |||||
485 | Implementors of this interface are expected to initialize | ||||
486 | every new instance with a | ||||
487 | L<Bio::Location::CoordinatePolicyI> object. The | ||||
488 | implementation provided here will return a default policy | ||||
489 | object if none has been set yet. To change this default | ||||
490 | policy object call this method as a class method with an | ||||
491 | appropriate argument. Note that in this case only | ||||
492 | subsequently created Location objects will be affected. | ||||
493 | |||||
494 | Returns : A L<Bio::Location::CoordinatePolicyI> implementing object. | ||||
495 | Args : On set, a L<Bio::Location::CoordinatePolicyI> implementing object. | ||||
496 | |||||
497 | See L<Bio::Location::CoordinatePolicyI> for more information | ||||
498 | |||||
499 | |||||
500 | =cut | ||||
501 | |||||
502 | sub coordinate_policy { | ||||
503 | my ($self, $policy) = @_; | ||||
504 | |||||
505 | if(defined($policy)) { | ||||
506 | if(! $policy->isa('Bio::Location::CoordinatePolicyI')) { | ||||
507 | $self->throw("Object of class ".ref($policy)." does not implement". | ||||
508 | " Bio::Location::CoordinatePolicyI"); | ||||
509 | } | ||||
510 | if(ref($self)) { | ||||
511 | $self->{'_coordpolicy'} = $policy; | ||||
512 | } else { | ||||
513 | # called as class method | ||||
514 | $coord_policy = $policy; | ||||
515 | } | ||||
516 | } | ||||
517 | return (ref($self) && exists($self->{'_coordpolicy'}) ? | ||||
518 | $self->{'_coordpolicy'} : $coord_policy); | ||||
519 | } | ||||
520 | |||||
521 | =head2 trunc | ||||
522 | |||||
523 | Title : trunc | ||||
524 | Usage : $trunc_location = $location->trunc($start, $end, $relative_ori); | ||||
525 | Function: To truncate a location and keep annotations and features | ||||
526 | within the truncated segment intact. | ||||
527 | |||||
528 | This might do things differently where the truncation | ||||
529 | splits the location in half. | ||||
530 | CAVEAT : As yet, this is an untested and unannounced method. Use | ||||
531 | with caution! | ||||
532 | Returns : A L<Bio::Location::Atomic> object. | ||||
533 | Args : The start and end position for the trunction, and the relative | ||||
534 | orientation. | ||||
535 | |||||
536 | =cut | ||||
537 | |||||
538 | sub trunc { | ||||
539 | my ($self,$start,$end,$relative_ori) = @_; | ||||
540 | |||||
541 | my $newstart = $self->start - $start+1; | ||||
542 | my $newend = $self->end - $start+1; | ||||
543 | my $newstrand = $relative_ori * $self->strand; | ||||
544 | |||||
545 | my $out; | ||||
546 | if( $newstart < 1 || $newend > ($end-$start+1) ) { | ||||
547 | $out = Bio::Location::Atomic->new(); | ||||
548 | $out->start($self->start); | ||||
549 | $out->end($self->end); | ||||
550 | $out->strand($self->strand); | ||||
551 | $out->seq_id($self->seqid); | ||||
552 | $out->is_remote(1); | ||||
553 | } else { | ||||
554 | $out = Bio::Location::Atomic->new(); | ||||
555 | $out->start($newstart); | ||||
556 | $out->end($newend); | ||||
557 | $out->strand($newstrand); | ||||
558 | $out->seq_id(); | ||||
559 | } | ||||
560 | |||||
561 | return $out; | ||||
562 | } | ||||
563 | |||||
564 | 1 | 4µs | 1; |