← Index
NYTProf Performance Profile   « block view • line view • sub view »
For bin/pan_genome_post_analysis
  Run on Fri Mar 27 11:43:32 2015
Reported on Fri Mar 27 11:45:45 2015

Filename/Users/ap13/perl5/lib/perl5/Bio/Location/Atomic.pm
StatementsExecuted 8 statements in 1.62ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
111278µs726µsBio::Location::Atomic::::BEGIN@79Bio::Location::Atomic::BEGIN@79
11116µs28µsBio::Location::Atomic::::BEGIN@77Bio::Location::Atomic::BEGIN@77
11111µs3.78msBio::Location::Atomic::::BEGIN@81Bio::Location::Atomic::BEGIN@81
0000s0sBio::Location::Atomic::::coordinate_policyBio::Location::Atomic::coordinate_policy
0000s0sBio::Location::Atomic::::each_LocationBio::Location::Atomic::each_Location
0000s0sBio::Location::Atomic::::endBio::Location::Atomic::end
0000s0sBio::Location::Atomic::::end_pos_typeBio::Location::Atomic::end_pos_type
0000s0sBio::Location::Atomic::::flip_strandBio::Location::Atomic::flip_strand
0000s0sBio::Location::Atomic::::is_remoteBio::Location::Atomic::is_remote
0000s0sBio::Location::Atomic::::lengthBio::Location::Atomic::length
0000s0sBio::Location::Atomic::::location_typeBio::Location::Atomic::location_type
0000s0sBio::Location::Atomic::::max_endBio::Location::Atomic::max_end
0000s0sBio::Location::Atomic::::max_startBio::Location::Atomic::max_start
0000s0sBio::Location::Atomic::::min_endBio::Location::Atomic::min_end
0000s0sBio::Location::Atomic::::min_startBio::Location::Atomic::min_start
0000s0sBio::Location::Atomic::::newBio::Location::Atomic::new
0000s0sBio::Location::Atomic::::seq_idBio::Location::Atomic::seq_id
0000s0sBio::Location::Atomic::::startBio::Location::Atomic::start
0000s0sBio::Location::Atomic::::start_pos_typeBio::Location::Atomic::start_pos_type
0000s0sBio::Location::Atomic::::strandBio::Location::Atomic::strand
0000s0sBio::Location::Atomic::::to_FTstringBio::Location::Atomic::to_FTstring
0000s0sBio::Location::Atomic::::truncBio::Location::Atomic::trunc
0000s0sBio::Location::Atomic::::valid_LocationBio::Location::Atomic::valid_Location
Call graph for these subroutines as a Graphviz dot language file.
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
14Bio::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
31This is an implementation of Bio::LocationI to manage simple location
32information on a Sequence.
33
34=head1 FEEDBACK
35
36User feedback is an integral part of the evolution of this and other
37Bioperl modules. Send your comments and suggestions preferably to one
38of 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
45Please direct usage questions or support issues to the mailing list:
46
47I<bioperl-l@bioperl.org>
48
49rather than to the module maintainer directly. Many experienced and
50reponsive experts will be able look at the problem and quickly
51address it. Please include a thorough description of the problem
52with code and data examples if at all possible.
53
54=head2 Reporting Bugs
55
56Report bugs to the Bioperl bug tracking system to help us keep track
57the bugs and their resolution. Bug reports can be submitted via the
58web:
59
60 https://github.com/bioperl/bioperl-live/issues
61
62=head1 AUTHOR - Jason Stajich
63
64Email jason-at-bioperl-dot-org
65
66=head1 APPENDIX
67
68The rest of the documentation details each of the object
69methods. Internal methods are usually preceded with a _
70
71=cut
72
73# Let the code begin...
74
75
76package Bio::Location::Atomic;
77223µs240µ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
use strict;
# spent 28µs making 1 call to Bio::Location::Atomic::BEGIN@77 # spent 12µs making 1 call to strict::import
78
792157µs1726µ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
use Bio::Location::WidestCoordPolicy;
# spent 726µs making 1 call to Bio::Location::Atomic::BEGIN@79
80
8121.43ms23.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
use base qw(Bio::Root::Root Bio::LocationI);
# 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
8315µs142µsour $coord_policy = Bio::Location::WidestCoordPolicy->new();
# spent 42µs making 1 call to Bio::Location::WidestCoordPolicy::new
84
85sub 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
140sub 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
157sub 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
175sub 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
206sub 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
227sub 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
247sub 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
262sub 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
284sub 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
303sub 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
318sub 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
340sub 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
359sub 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
374sub 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
404sub 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
427sub 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
442sub 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
465sub 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
497See L<Bio::Location::CoordinatePolicyI> for more information
498
499
500=cut
501
502sub 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
538sub 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
56414µs1;