Bio/Location/Simple.pm

   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 use strict;
  86
  87 use base qw(Bio::Location::Atomic);
  88
  89 our %RANGEENCODE  = ('\.\.' => 'EXACT',
  90                      '\^'   => 'IN-BETWEEN' );
  91
  92 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    : optionally 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    : optionally 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    : optionally 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;
 413