← 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:46:09 2015

Filename/Users/ap13/perl5/lib/perl5/Bio/Location/Simple.pm
StatementsExecuted 7 statements in 936µs
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
11115µs27µsBio::Location::Simple::::BEGIN@85Bio::Location::Simple::BEGIN@85
1119µs6.21msBio::Location::Simple::::BEGIN@87Bio::Location::Simple::BEGIN@87
0000s0sBio::Location::Simple::::endBio::Location::Simple::end
0000s0sBio::Location::Simple::::lengthBio::Location::Simple::length
0000s0sBio::Location::Simple::::location_typeBio::Location::Simple::location_type
0000s0sBio::Location::Simple::::newBio::Location::Simple::new
0000s0sBio::Location::Simple::::startBio::Location::Simple::start
0000s0sBio::Location::Simple::::to_FTstringBio::Location::Simple::to_FTstring
0000s0sBio::Location::Simple::::truncBio::Location::Simple::trunc
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::Simple
3# Please direct questions and support issues to <bioperl-l@bioperl.org>
4#
5# Cared for by Heikki Lehvaslaiho <heikki-at-bioperl-dot-org>
6#
7# Copyright Heikki Lehvaslaiho
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::Simple - Implementation of a Simple Location on a Sequence
15
16=head1 SYNOPSIS
17
18 use Bio::Location::Simple;
19
20 my $location = Bio::Location::Simple->new(
21 -start => 1,
22 -end => 100,
23 -strand => 1,
24 );
25
26 if( $location->strand == -1 ) {
27 printf "complement(%d..%d)\n", $location->start, $location->end;
28 } else {
29 printf "%d..%d\n", $location->start, $location->end;
30 }
31
32=head1 DESCRIPTION
33
34This is an implementation of Bio::LocationI to manage exact location
35information on a Sequence: '22' or '12..15' or '16^17'.
36
37You can test the type of the location using length() function () or
38directly location_type() which can one of two values: 'EXACT' or
39'IN-BETWEEN'.
40
41
42=head1 FEEDBACK
43
44User feedback is an integral part of the evolution of this and other
45Bioperl modules. Send your comments and suggestions preferably to one
46of the Bioperl mailing lists. Your participation is much appreciated.
47
48 bioperl-l@bioperl.org - General discussion
49 http://bioperl.org/wiki/Mailing_lists - About the mailing lists
50
51=head2 Support
52
53Please direct usage questions or support issues to the mailing list:
54
55I<bioperl-l@bioperl.org>
56
57rather than to the module maintainer directly. Many experienced and
58reponsive experts will be able look at the problem and quickly
59address it. Please include a thorough description of the problem
60with code and data examples if at all possible.
61
62=head2 Reporting Bugs
63
64Report bugs to the Bioperl bug tracking system to help us keep track
65the bugs and their resolution. Bug reports can be submitted via the
66web:
67
68 https://github.com/bioperl/bioperl-live/issues
69
70=head1 AUTHOR - Heikki Lehvaslaiho
71
72Email heikki-at-bioperl-dot-org
73
74=head1 APPENDIX
75
76The rest of the documentation details each of the object
77methods. Internal methods are usually preceded with a _
78
79=cut
80
81# Let the code begin...
82
83
84package Bio::Location::Simple;
85228µs239µs
# spent 27µs (15+12) within Bio::Location::Simple::BEGIN@85 which was called: # once (15µs+12µs) by Bio::LocatableSeq::BEGIN@105 at line 85
use strict;
# spent 27µs making 1 call to Bio::Location::Simple::BEGIN@85 # spent 12µs making 1 call to strict::import
86
872896µs212.4ms
# spent 6.21ms (9µs+6.21) within Bio::Location::Simple::BEGIN@87 which was called: # once (9µs+6.21ms) by Bio::LocatableSeq::BEGIN@105 at line 87
use base qw(Bio::Location::Atomic);
# spent 6.21ms making 1 call to Bio::Location::Simple::BEGIN@87 # spent 6.21ms making 1 call to base::import
88
8913µsour %RANGEENCODE = ('\.\.' => 'EXACT',
90 '\^' => 'IN-BETWEEN' );
91
9212µsour %RANGEDECODE = ('EXACT' => '..',
93 'IN-BETWEEN' => '^' );
94
95sub new {
96 my ($class, @args) = @_;
97 my $self = $class->SUPER::new(@args);
98
99 my ($locationtype) = $self->_rearrange([qw(LOCATION_TYPE)],@args);
100
101 $locationtype && $self->location_type($locationtype);
102
103 return $self;
104}
105
106=head2 start
107
108 Title : start
109 Usage : $start = $loc->start();
110 Function: get/set the start of this range
111 Returns : the start of this range
112 Args : optionaly allows the start to be set
113 using $loc->start($start)
114
115=cut
116
117sub start {
118 my ($self, $value) = @_;
119 $self->{'_start'} = $value if defined $value ;
120
121 $self->throw("Only adjacent residues when location type ".
122 "is IN-BETWEEN. Not [". $self->{'_start'}. "] and [".
123 $self->{'_end'}. "]" )
124 if defined $self->{'_start'} && defined $self->{'_end'} &&
125 $self->location_type eq 'IN-BETWEEN' &&
126 ($self->{'_end'} - 1 != $self->{'_start'});
127 return $self->{'_start'};
128}
129
130
131=head2 end
132
133 Title : end
134 Usage : $end = $loc->end();
135 Function: get/set the end of this range
136 Returns : the end of this range
137 Args : optionaly allows the end to be set
138 : using $loc->end($start)
139 Note : If start is set but end is undefined, this now assumes that start
140 is the same as end but throws a warning (i.e. it assumes this is
141 a possible error). If start is undefined, this now throws an
142 exception.
143
144=cut
145
146sub end {
147 my ($self, $value) = @_;
148
149 $self->{'_end'} = $value if defined $value ;
150
151 # Assume end is the same as start if not defined
152 if (!defined $self->{'_end'}) {
153 if (!defined $self->{'_start'}) {
154 $self->warn('Can not set Bio::Location::Simple::end() equal to start; start not set');
155 return;
156 }
157 $self->warn('Setting end to equal start['. $self->{'_start'}. ']');
158 $self->{'_end'} = $self->{'_start'};
159 }
160 $self->throw("Only adjacent residues when location type ".
161 "is IN-BETWEEN. Not [". $self->{'_start'}. "] and [".
162 $self->{'_end'}. "]" )
163 if defined $self->{'_start'} && defined $self->{'_end'} &&
164 $self->location_type eq 'IN-BETWEEN' &&
165 ($self->{'_end'} - 1 != $self->{'_start'});
166
167 return $self->{'_end'};
168}
169
170=head2 strand
171
172 Title : strand
173 Usage : $strand = $loc->strand();
174 Function: get/set the strand of this range
175 Returns : the strandedness (-1, 0, +1)
176 Args : optionaly allows the strand to be set
177 : using $loc->strand($strand)
178
179=cut
180
181=head2 length
182
183 Title : length
184 Usage : $len = $loc->length();
185 Function: get the length in the coordinate space this location spans
186 Example :
187 Returns : an integer
188 Args : none
189
190=cut
191
192sub length {
193 my ($self) = @_;
194 if ($self->location_type eq 'IN-BETWEEN' ) {
195 return 0;
196 } else {
197 return abs($self->end - $self->start) + 1;
198 }
199}
200
201
202=head2 min_start
203
204 Title : min_start
205 Usage : my $minstart = $location->min_start();
206 Function: Get minimum starting location of feature startpoint
207 Returns : integer or undef if no minimum starting point.
208 Args : none
209
210=cut
211
212=head2 max_start
213
214 Title : max_start
215 Usage : my $maxstart = $location->max_start();
216 Function: Get maximum starting location of feature startpoint.
217
218 In this implementation this is exactly the same as min_start().
219
220 Returns : integer or undef if no maximum starting point.
221 Args : none
222
223=cut
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 Returns : type of position coded as text
232 ('BEFORE', 'AFTER', 'EXACT','WITHIN', 'BETWEEN')
233 Args : none
234
235=cut
236
237=head2 min_end
238
239 Title : min_end
240 Usage : my $minend = $location->min_end();
241 Function: Get minimum ending location of feature endpoint
242 Returns : integer or undef if no minimum ending point.
243 Args : none
244
245=cut
246
247
248=head2 max_end
249
250 Title : max_end
251 Usage : my $maxend = $location->max_end();
252 Function: Get maximum ending location of feature endpoint
253
254 In this implementation this is exactly the same as min_end().
255
256 Returns : integer or undef if no maximum ending point.
257 Args : none
258
259=cut
260
261=head2 end_pos_type
262
263 Title : end_pos_type
264 Usage : my $end_pos_type = $location->end_pos_type();
265 Function: Get end position type (ie <,>, ^)
266
267 Returns : type of position coded as text
268 ('BEFORE', 'AFTER', 'EXACT','WITHIN', 'BETWEEN')
269 Args : none
270
271=cut
272
273=head2 location_type
274
275 Title : location_type
276 Usage : my $location_type = $location->location_type();
277 Function: Get location type encoded as text
278 Returns : string ('EXACT' or 'IN-BETWEEN')
279 Args : 'EXACT' or '..' or 'IN-BETWEEN' or '^'
280
281=cut
282
283sub location_type {
284 my ($self, $value) = @_;
285
286 if( defined $value || ! defined $self->{'_location_type'} ) {
287 $value = 'EXACT' unless defined $value;
288 $value = uc $value;
289 if (! defined $RANGEDECODE{$value}) {
290 $value = '\^' if $value eq '^';
291 $value = '\.\.' if $value eq '..';
292 $value = $RANGEENCODE{$value};
293 }
294 $self->throw("Did not specify a valid location type. [$value] is no good")
295 unless defined $value;
296 $self->{'_location_type'} = $value;
297 }
298 $self->throw("Only adjacent residues when location type ".
299 "is IN-BETWEEN. Not [". $self->{'_start'}. "] and [".
300 $self->{'_end'}. "]" )
301 if $self->{'_location_type'} eq 'IN-BETWEEN' &&
302 defined $self->{'_start'} &&
303 defined $self->{'_end'} &&
304 ($self->{'_end'} - 1 != $self->{'_start'});
305
306 return $self->{'_location_type'};
307}
308
309=head2 is_remote
310
311 Title : is_remote
312 Usage : $is_remote_loc = $loc->is_remote()
313 Function: Whether or not a location is a remote location.
314
315 A location is said to be remote if it is on a different
316 'object' than the object which 'has' this
317 location. Typically, features on a sequence will sometimes
318 have a remote location, which means that the location of
319 the feature is on a different sequence than the one that is
320 attached to the feature. In such a case, $loc->seq_id will
321 be different from $feat->seq_id (usually they will be the
322 same).
323
324 While this may sound weird, it reflects the location of the
325 kind of AL445212.9:83662..166657 which can be found in GenBank/EMBL
326 feature tables.
327
328 Example :
329 Returns : TRUE if the location is a remote location, and FALSE otherwise
330 Args : Value to set to
331
332=cut
333
334=head2 to_FTstring
335
336 Title : to_FTstring
337 Usage : my $locstr = $location->to_FTstring()
338 Function: returns the FeatureTable string of this location
339 Returns : string
340 Args : none
341
342=cut
343
344sub to_FTstring {
345 my($self) = @_;
346
347 my $str;
348 if( $self->start == $self->end ) {
349 $str = $self->start;
350 } else {
351 $str = $self->start . $RANGEDECODE{$self->location_type} . $self->end;
352 }
353 if($self->is_remote() && $self->seq_id()) {
354 $str = $self->seq_id() . ":" . $str;
355 }
356 if( defined $self->strand &&
357 $self->strand == -1 ) {
358 $str = "complement(".$str.")";
359 }
360 return $str;
361}
362
363
364=head2 valid_Location
365
366 Title : valid_Location
367 Usage : if ($location->valid_location) {...};
368 Function: boolean method to determine whether location is considered valid
369 (has minimum requirements for Simple implementation)
370 Returns : Boolean value: true if location is valid, false otherwise
371 Args : none
372
373=cut
374
375# comments, not function added by jason
376#
377# trunc is untested, and as of now unannounced method for truncating a
378# location. This is to eventually be part of the procedure to
379# truncate a sequence with annotation and properly remap the location
380# of all the features contained within the truncated segment.
381
382# presumably this might do things a little differently for the case
383# where the truncation splits the location in half
384#
385# in short- you probably don't want to use this method.
386
387sub trunc {
388 my ($self,$start,$end,$relative_ori) = @_;
389 my $newstart = $self->start - $start+1;
390 my $newend = $self->end - $start+1;
391 my $newstrand = $relative_ori * $self->strand;
392
393 my $out;
394 if( $newstart < 1 || $newend > ($end-$start+1) ) {
395 $out = Bio::Location::Simple->new();
396 $out->start($self->start);
397 $out->end($self->end);
398 $out->strand($self->strand);
399 $out->seq_id($self->seqid);
400 $out->is_remote(1);
401 } else {
402 $out = Bio::Location::Simple->new();
403 $out->start($newstart);
404 $out->end($newend);
405 $out->strand($newstrand);
406 $out->seq_id();
407 }
408
409 return $out;
410}
411
41217µs1;
413