| Filename | /Users/ap13/perl5/lib/perl5/Bio/Location/Simple.pm |
| Statements | Executed 7 statements in 936µs |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 1 | 1 | 1 | 15µs | 27µs | Bio::Location::Simple::BEGIN@85 |
| 1 | 1 | 1 | 9µs | 6.21ms | Bio::Location::Simple::BEGIN@87 |
| 0 | 0 | 0 | 0s | 0s | Bio::Location::Simple::end |
| 0 | 0 | 0 | 0s | 0s | Bio::Location::Simple::length |
| 0 | 0 | 0 | 0s | 0s | Bio::Location::Simple::location_type |
| 0 | 0 | 0 | 0s | 0s | Bio::Location::Simple::new |
| 0 | 0 | 0 | 0s | 0s | Bio::Location::Simple::start |
| 0 | 0 | 0 | 0s | 0s | Bio::Location::Simple::to_FTstring |
| 0 | 0 | 0 | 0s | 0s | Bio::Location::Simple::trunc |
| 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 | |||||
| 14 | Bio::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 | |||||
| 34 | This is an implementation of Bio::LocationI to manage exact location | ||||
| 35 | information on a Sequence: '22' or '12..15' or '16^17'. | ||||
| 36 | |||||
| 37 | You can test the type of the location using length() function () or | ||||
| 38 | directly location_type() which can one of two values: 'EXACT' or | ||||
| 39 | 'IN-BETWEEN'. | ||||
| 40 | |||||
| 41 | |||||
| 42 | =head1 FEEDBACK | ||||
| 43 | |||||
| 44 | User feedback is an integral part of the evolution of this and other | ||||
| 45 | Bioperl modules. Send your comments and suggestions preferably to one | ||||
| 46 | of 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 | |||||
| 53 | Please direct usage questions or support issues to the mailing list: | ||||
| 54 | |||||
| 55 | I<bioperl-l@bioperl.org> | ||||
| 56 | |||||
| 57 | rather than to the module maintainer directly. Many experienced and | ||||
| 58 | reponsive experts will be able look at the problem and quickly | ||||
| 59 | address it. Please include a thorough description of the problem | ||||
| 60 | with code and data examples if at all possible. | ||||
| 61 | |||||
| 62 | =head2 Reporting Bugs | ||||
| 63 | |||||
| 64 | Report bugs to the Bioperl bug tracking system to help us keep track | ||||
| 65 | the bugs and their resolution. Bug reports can be submitted via the | ||||
| 66 | web: | ||||
| 67 | |||||
| 68 | https://github.com/bioperl/bioperl-live/issues | ||||
| 69 | |||||
| 70 | =head1 AUTHOR - Heikki Lehvaslaiho | ||||
| 71 | |||||
| 72 | Email heikki-at-bioperl-dot-org | ||||
| 73 | |||||
| 74 | =head1 APPENDIX | ||||
| 75 | |||||
| 76 | The rest of the documentation details each of the object | ||||
| 77 | methods. Internal methods are usually preceded with a _ | ||||
| 78 | |||||
| 79 | =cut | ||||
| 80 | |||||
| 81 | # Let the code begin... | ||||
| 82 | |||||
| 83 | |||||
| 84 | package Bio::Location::Simple; | ||||
| 85 | 2 | 28µs | 2 | 39µ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 # spent 27µs making 1 call to Bio::Location::Simple::BEGIN@85
# spent 12µs making 1 call to strict::import |
| 86 | |||||
| 87 | 2 | 896µs | 2 | 12.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 # spent 6.21ms making 1 call to Bio::Location::Simple::BEGIN@87
# spent 6.21ms making 1 call to base::import |
| 88 | |||||
| 89 | 1 | 3µs | our %RANGEENCODE = ('\.\.' => 'EXACT', | ||
| 90 | '\^' => 'IN-BETWEEN' ); | ||||
| 91 | |||||
| 92 | 1 | 2µs | our %RANGEDECODE = ('EXACT' => '..', | ||
| 93 | 'IN-BETWEEN' => '^' ); | ||||
| 94 | |||||
| 95 | sub 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 | |||||
| 117 | sub 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 | |||||
| 146 | sub 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 | |||||
| 192 | sub 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 | |||||
| 283 | sub 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 | |||||
| 344 | sub 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 | |||||
| 387 | sub 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 | |||||
| 412 | 1 | 7µs | 1; | ||
| 413 |