Bio/Location/Simple.pm

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