Bio/Map/Position.pm

   1 # $Id$
   2 #
   3 # BioPerl module for Bio::Map::Position
   4 #
   5 # Cared for by Sendu Bala <bix@sendu.me.uk>
   6 #
   7 # Copyright Jason Stajich
   8 #
   9 # You may distribute this module under the same terms as perl itself
  10
  11 # POD documentation - main docs before the code
  12
  13 =head1 NAME
  14
  15 Bio::Map::Position - A single position of a Marker, or the range over which
  16                      that marker lies, in a Map
  17
  18 =head1 SYNOPSIS
  19
  20     use Bio::Map::Position;
  21     my $position = Bio::Map::Position->new(-map => $map,
  22                                           -element => $marker,
  23                                           -value => 100
  24                                           );
  25
  26         my $position_with_range = Bio::Map::Position->new(-map => $map,
  27                                           -element => $marker,
  28                                           -start => 100,
  29                                           -length => 10
  30                                           );
  31
  32 =head1 DESCRIPTION
  33
  34 This object is an implementation of the PositionI interface that
  35 handles the specific values of a position. This allows a map element
  36 (e.g. Marker) to have multiple positions within a map and still be
  37 treated as a single entity.
  38
  39 This handles the concept of a relative map in which the order of
  40 elements and the distance between them is known, but does not
  41 directly handle the case when distances are unknown - in that case
  42 arbitrary values must be assigned for position values.
  43
  44 No units are assumed here - units are handled by context of which Map
  45 a position is placed in or the subclass of this Position.
  46
  47 =head1 FEEDBACK
  48
  49 =head2 Mailing Lists
  50
  51 User feedback is an integral part of the evolution of this and other
  52 Bioperl modules. Send your comments and suggestions preferably to
  53 the Bioperl mailing list.  Your participation is much appreciated.
  54
  55   bioperl-l@bioperl.org                  - General discussion
  56   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
  57
  58 =head2 Reporting Bugs
  59
  60 Report bugs to the Bioperl bug tracking system to help us keep track
  61 of the bugs and their resolution. Bug reports can be submitted via the
  62 web:
  63
  64   http://bugzilla.open-bio.org/
  65
  66 =head1 AUTHOR - Jason Stajich
  67
  68 Email jason@bioperl.org
  69
  70 =head1 CONTRIBUTORS
  71
  72 Lincoln Stein, lstein@cshl.org
  73 Heikki Lehvaslaiho, heikki-at-bioperl-dot-org
  74 Chad Matsalla, bioinformatics1@dieselwurks.com
  75 Sendu Bala, bix@sendu.me.uk
  76
  77 =head1 APPENDIX
  78
  79 The rest of the documentation details each of the object methods.
  80 Internal methods are usually preceded with a _
  81
  82 =cut
  83
  84 # Let the code begin...
  85
  86 package Bio::Map::Position;
  87 use strict;
  88
  89 use Scalar::Util qw(looks_like_number);
  90 use Bio::Map::Relative;
  91
  92 use base qw(Bio::Root::Root Bio::Map::PositionI);
  93
  94 =head2 new
  95
  96  Title   : new
  97  Usage   : my $obj = Bio::Map::Position->new();
  98  Function: Builds a new Bio::Map::Position object
  99  Returns : Bio::Map::Position
 100  Args    : -map      => Bio::Map::MapI object
 101            -element  => Bio::Map::MappableI object
 102            -relative => Bio::Map::RelativeI object
 103
 104            * If this position has no range, or if a single value can describe
 105              the range *
 106            -value => scalar             : something that describes the single
 107                                           point position or range of this
 108                                           Position, most likely an int
 109
 110            * Or if this position has a range, at least two of *
 111            -start => int                : value of the start co-ordinate
 112            -end => int                  : value of the end co-ordinate
 113            -length => int               : length of the range
 114
 115 =cut
 116
 117 sub new {
 118     my ($class, @args) = @_;
 119     my $self = $class->SUPER::new(@args);
 120
 121     my ($map, $marker, $element, $value, $start, $end, $length, $relative) =
 122         $self->_rearrange([qw( MAP
 123                                MARKER
 124                    ELEMENT
 125                                VALUE
 126                                    START
 127                                    END
 128                                    LENGTH
 129                    RELATIVE
 130                                )], @args);
 131
 132     my $do_range = defined($start) || defined($end);
 133     if ($value && $do_range) {
 134         $self->warn("-value and (-start|-end|-length) are mutually exclusive, ignoring value");
 135                 $value = undef;
 136     }
 137
 138     $map            && $self->map($map);
 139     $marker         && $self->element($marker); # backwards compatibility
 140     $element        && $self->element($element);
 141     $relative       && $self->relative($relative);
 142     defined($value) && $self->value($value);
 143
 144     if ($do_range) {
 145                 defined($start) && $self->start($start);
 146                 defined($end)   && $self->end($end);
 147                 if ($length) {
 148                         if (defined($start) && ! defined($end)) {
 149                                 $self->end($start + $length - 1);
 150                         }
 151                         elsif (! defined($start)) {
 152                                 $self->start($end - $length + 1);
 153                         }
 154                 }
 155                 defined($self->end) || $self->end($start);
 156     }
 157
 158     return $self;
 159 }
 160
 161 =head2 relative
 162
 163   Title   : relative
 164   Usage   : my $relative = $position->relative();
 165             $position->relative($relative);
 166   Function: Get/set the thing this Position's coordinates (numerical(), start(),
 167             end()) are relative to, as described by a Relative object.
 168   Returns : Bio::Map::RelativeI (default is one describing "relative to the
 169             start of the Position's map")
 170   Args    : none to get, OR
 171             Bio::Map::RelativeI to set
 172
 173 =cut
 174
 175 sub relative {
 176     my ($self, $relative) = @_;
 177     if ($relative) {
 178         $self->throw("Must supply an object") unless ref($relative);
 179         $self->throw("This is [$relative], not a Bio::Map::RelativeI") unless $relative->isa('Bio::Map::RelativeI');
 180         $self->{_relative_not_implicit} = 1;
 181         $self->{_relative} = $relative;
 182     }
 183     return $self->{_relative} || $self->absolute_relative;
 184 }
 185
 186 =head2 absolute
 187
 188   Title   : absolute
 189   Usage   : my $absolute = $position->absolute();
 190             $position->absolute($absolute);
 191   Function: Get/set how this Position's co-ordinates (numerical(), start(),
 192             end()) are reported. When absolute is off, co-ordinates are
 193             relative to the thing described by relative(). Ie. the value
 194             returned by start() will be the same as the value you set start()
 195             to. When absolute is on, co-ordinates are converted to be relative
 196             to the start of the map.
 197
 198             So if relative() currently points to a Relative object describing
 199             "relative to another position which is 100 bp from the start of
 200             the map", this Position's start() had been set to 50 and absolute()
 201             returns 1, $position->start() will return 150. If absolute() returns
 202             0 in the same situation, $position->start() would return 50.
 203
 204   Returns : boolean (default 0)
 205   Args    : none to get, OR
 206             boolean to set
 207
 208 =cut
 209
 210 sub absolute {
 211     my $self = shift;
 212     if (@_) { $self->{_absolute} = shift }
 213     return $self->{_absolute} || 0;
 214 }
 215
 216 =head2 value
 217
 218  Title   : value
 219  Usage   : my $pos = $position->value;
 220  Function: Get/Set the value for this postion
 221  Returns : scalar, value
 222  Args    : [optional] new value to set
 223
 224 =cut
 225
 226 sub value {
 227         my ($self, $value) = @_;
 228         if (defined $value) {
 229                 $self->{'_value'} = $value;
 230                 $self->start($self->numeric) unless defined($self->start);
 231                 $self->end($self->numeric) unless defined($self->end);
 232         }
 233         return $self->{'_value'};
 234 }
 235
 236 =head2 numeric
 237
 238  Title   : numeric
 239  Usage   : my $num = $position->numeric;
 240  Function: Read-only method that is guaranteed to return a numeric
 241            representation of the start of this position.
 242  Returns : scalar numeric
 243  Args    : none to get the co-ordinate normally (see absolute() method), OR
 244            Bio::Map::RelativeI to get the co-ordinate converted to be
 245            relative to what this Relative describes.
 246
 247 =cut
 248
 249 sub numeric {
 250     my ($self, $value) = @_;
 251     my $num = $self->{'_value'};
 252     $self->throw("The value has not been set, can't convert to numeric") unless defined($num);
 253     $self->throw("This value [$num] is not numeric") unless looks_like_number($num);
 254
 255     if (ref($value) && $value->isa('Bio::Map::RelativeI')) {
 256         # get the value after co-ordinate conversion
 257         my $raw = $num;
 258         my ($abs_start, $rel_start) = $self->_relative_handler($value);
 259         return $abs_start + $raw - $rel_start;
 260     }
 261
 262     # get the value as per absolute
 263     if ($self->{_relative_not_implicit} && $self->absolute) {
 264         # this actually returns the start, but should be the same thing...
 265         return $self->relative->absolute_conversion($self);
 266     }
 267
 268     return $num;
 269 }
 270
 271 =head2 start
 272
 273   Title   : start
 274   Usage   : my $start = $position->start();
 275             $position->start($start);
 276   Function: Get/set the start co-ordinate of this position.
 277   Returns : the start of this position
 278   Args    : scalar numeric to set, OR
 279             none to get the co-ordinate normally (see absolute() method), OR
 280             Bio::Map::RelativeI to get the co-ordinate converted to be
 281             relative to what this Relative describes.
 282
 283 =cut
 284
 285 sub start {
 286         my ($self, $value) = @_;
 287     if (defined $value) {
 288         if (ref($value) && $value->isa('Bio::Map::RelativeI')) {
 289             # get the value after co-ordinate conversion
 290             my $raw = $self->{start};
 291             defined $raw || return;
 292             my ($abs_start, $rel_start) = $self->_relative_handler($value);
 293             return $abs_start + $raw - $rel_start;
 294         }
 295         else {
 296             # set the value
 297             $self->throw("This is [$value], not a number") unless looks_like_number($value);
 298             $self->{start} = $value;
 299             $self->value($value) unless defined($self->value);
 300         }
 301     }
 302
 303     # get the value as per absolute
 304     if ($self->{_relative_not_implicit} && $self->absolute) {
 305         return $self->relative->absolute_conversion($self);
 306     }
 307
 308     return defined($self->{start}) ? $self->{start} : return;
 309 }
 310
 311 =head2 end
 312
 313   Title   : end
 314   Usage   : my $end = $position->end();
 315             $position->end($end);
 316   Function: Get/set the end co-ordinate of this position.
 317   Returns : the end of this position
 318   Args    : scalar numeric to set, OR
 319             none to get the co-ordinate normally (see absolute() method), OR
 320             Bio::Map::RelativeI to get the co-ordinate converted to be
 321             relative to what this Relative describes.
 322
 323 =cut
 324
 325 sub end {
 326         my ($self, $value) = @_;
 327     if (defined $value) {
 328         if (ref($value) && $value->isa('Bio::Map::RelativeI')) {
 329             # get the value after co-ordinate conversion
 330             my $raw = $self->{end};
 331             defined $raw || return;
 332             my ($abs_start, $rel_start) = $self->_relative_handler($value);
 333             return $abs_start + $raw - $rel_start;
 334         }
 335         else {
 336             # set the value
 337             $self->throw("This value [$value] is not numeric!") unless looks_like_number($value);
 338             $self->{end} = $value;
 339         }
 340     }
 341
 342     # get the value as per absolute
 343     if ($self->{_relative_not_implicit} && $self->absolute) {
 344         my $raw = $self->{end} || return;
 345         my $abs_start = $self->relative->absolute_conversion($self) || return;
 346         return $abs_start + ($raw - $self->{start});
 347     }
 348
 349     return defined($self->{end}) ? $self->{end} : return;
 350 }
 351
 352 =head2 length
 353
 354   Title   : length
 355   Usage   : $length = $position->length();
 356   Function: Get/set the length of this position's range, changing the end() if
 357             necessary. Getting and even setting the length will fail if both
 358             start() and end() are not already defined.
 359   Returns : the length of this range
 360   Args    : none to get, OR scalar numeric (>0) to set.
 361
 362 =cut
 363
 364 sub length {
 365         my ($self, $length) = @_;
 366         if ($length) {
 367         $length > 0 || return;
 368                 my $existing_length = $self->length || return;
 369         return $length if $existing_length == $length;
 370         $self->end($self->{start} + $length - 1);
 371         }
 372
 373         if (defined($self->start) && defined($self->end)) {
 374                 return $self->end - $self->start + 1;
 375         }
 376     return;
 377 }
 378
 379 =head2 sortable
 380
 381  Title   : sortable
 382  Usage   : my $num = $position->sortable();
 383  Function: Read-only method that is guaranteed to return a value suitable
 384            for correctly sorting this kind of position amongst other positions
 385            of the same kind on the same map. Note that sorting different kinds
 386            of position together is unlikely to give sane results.
 387  Returns : numeric
 388  Args    : none
 389
 390 =cut
 391
 392 sub sortable {
 393     my ($self, $given_map) = @_;
 394     my $answer = $self->numeric($self->absolute_relative);
 395     return $answer;
 396 }
 397
 398 =head2 toString
 399
 400   Title   : toString
 401   Usage   : print $position->toString(), "\n";
 402   Function: stringifies this range
 403   Returns : a string representation of the range of this Position
 404   Args    : optional Bio::Map::RelativeI to have the co-ordinates reported
 405             relative to the thing described by that Relative
 406
 407 =cut
 408
 409 sub toString {
 410         my ($self, $rel) = @_;
 411         if (defined($self->start) && defined($self->end)) {
 412                 return $self->start($rel).'..'.$self->end($rel);
 413         }
 414         return '';
 415 }
 416
 417 =head2 absolute_relative
 418
 419  Title   : absolute_relative
 420  Usage   : my $rel = $position->absolute_relative();
 421  Function: Get a relative describing the start of the map. This is useful for
 422            supplying to the coordinate methods (start(), end() etc.) to get
 423            the temporary effect of having set absolute(1).
 424  Returns : Bio::Map::Relative
 425  Args    : none
 426
 427 =cut
 428
 429 sub absolute_relative {
 430     return Bio::Map::Relative->new(-map => 0, -description => 'start of map');
 431 }
 432
 433 # get our own absolute start and that of the thing we want as a frame of
 434 # reference
 435 sub _relative_handler {
 436     my ($self, $value) = @_;
 437
 438     my $own_relative = $self->relative;
 439
 440     # if the requested relative position is the same as the actual
 441     # relative, the current co-ordinate values are correct so shortcut
 442     my ($own_type, $req_type) = ($own_relative->type, $value->type);
 443     if ($own_type && $req_type && $own_type eq $req_type && $own_relative->$own_type eq $value->$req_type) {
 444         return (0, 0);
 445     }
 446
 447     my $abs_start = $own_relative->absolute_conversion($self);
 448     my $rel_start = $value->absolute_conversion($self);
 449     $self->throw("Unable to resolve co-ordinate because relative to something that ultimately isn't relative to the map start")
 450     unless defined($abs_start) && defined($rel_start);
 451
 452     return ($abs_start, $rel_start);
 453 }
 454
 455 1;