Bio/Range.pm

   1 #
   2 # BioPerl module for Bio::Range
   3 #
   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 # Copywright Matthew Pocock
   9 #
  10 # You may distribute this module under the same terms as perl itself
  11 #
  12 # POD documentation - main docs before the code
  13 #
  14
  15 =head1 NAME
  16
  17 Bio::Range - Pure perl RangeI implementation
  18
  19 =head1 SYNOPSIS
  20
  21   $range = Bio::Range->new(-start=>10, -end=>30, -strand=>+1);
  22   $r2 = Bio::Range->new(-start=>15, -end=>200, -strand=>+1);
  23
  24   print join(', ', $range->union($r2)), "\n";
  25   print join(', ', $range->intersection($r2)), "\n";
  26
  27   print $range->overlaps($r2), "\n";
  28   print $range->contains($r2), "\n";
  29
  30 =head1 DESCRIPTION
  31
  32 This provides a pure perl implementation of the BioPerl range
  33 interface.
  34
  35 Ranges are modeled as having (start, end, length, strand). They use
  36 Bio-coordinates - all points E<gt>= start and E<lt>= end are within the
  37 range. End is always greater-than or equal-to start, and length is
  38 greather than or equal to 1. The behaviour of a range is undefined if
  39 ranges with negative numbers or zero are used.
  40
  41 So, in summary:
  42
  43   length = end - start + 1
  44   end >= start
  45   strand = (-1 | 0 | +1)
  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 one
  53 of the Bioperl mailing lists.  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 Support
  59
  60 Please direct usage questions or support issues to the mailing list:
  61
  62 I<bioperl-l@bioperl.org>
  63
  64 rather than to the module maintainer directly. Many experienced and
  65 reponsive experts will be able look at the problem and quickly
  66 address it. Please include a thorough description of the problem
  67 with code and data examples if at all possible.
  68
  69 =head2 Reporting Bugs
  70
  71 Report bugs to the Bioperl bug tracking system to help us keep track
  72 the bugs and their resolution.  Bug reports can be submitted via  the web:
  73
  74   https://redmine.open-bio.org/projects/bioperl/
  75
  76 =head1 AUTHOR - Heikki Lehvaslaiho
  77
  78 Email heikki-at-bioperl-dot-org
  79
  80 =head1 APPENDIX
  81
  82 The rest of the documentation details each of the object
  83 methods. Internal methods are usually preceded with a _
  84
  85 =cut
  86
  87 package Bio::Range;
  88
  89 use strict;
  90 use Carp;
  91 use integer;
  92
  93
  94 use base qw(Bio::Root::Root Bio::RangeI);
  95
  96 =head1 Constructors
  97
  98 =head2 new
  99
 100   Title   : new
 101   Usage   : $range = Bio::Range->new(-start => 100, -end=> 200, -strand = +1);
 102   Function: generates a new Bio::Range
 103   Returns : a new range
 104   Args    : -strand (defaults to 0) and any two of (-start, -end, -length),
 105             the third will be calculated
 106
 107 =cut
 108
 109 sub new {
 110   my ($caller, @args) = @_;
 111   my $self = $caller->SUPER::new(@args);
 112   my ($strand, $start, $end, $length) =
 113       $self->_rearrange([qw(STRAND
 114                             START
 115                             END
 116                             LENGTH
 117                             )],@args);
 118   $self->strand($strand || 0);
 119
 120   if(defined $start ) {
 121       $self->start($start);
 122       if(defined $end) {
 123           $self->end($end);
 124       } elsif(defined $length) {
 125           $self->end($self->start()+ $length - 1);
 126       }
 127   } elsif(defined $end && defined $length ) {
 128       $self->end($end);
 129       $self->start($self->end() - $length + 1);
 130   }
 131   return $self;
 132 }
 133
 134 =head2 unions
 135
 136  Title   : unions
 137  Usage   : @unions = Bio::Range->unions(@ranges);
 138  Function: generate a list of non-intersecting Bio::Range objects
 139            from a list of Bio::Range objects which may intersect
 140  Returns : a list of Bio::Range objects
 141  Args    : a list of Bio::Range objects
 142
 143
 144 =cut
 145
 146 sub unions {
 147   my ($class,@i) = @_;
 148
 149   my $i = 0;
 150   my %i = map { $i++ => $_ } @i;
 151
 152   my $lastsize = scalar(keys %i);
 153
 154   do {
 155
 156     foreach my $j (sort { $i{$a}->start <=> $i{$b}->start } keys %i){
 157       foreach my $k (sort { $i{$a}->start <=> $i{$b}->start } keys %i){
 158
 159         #it may have been replaced by a union under the key of
 160         #the overlapping range, we are altering the hash in-place
 161         next unless $i{$j};
 162
 163         next if $i{$k}->end   < $i{$j}->start;
 164         last if $i{$k}->start > $i{$j}->end;
 165
 166         if($i{$j}->overlaps($i{$k})){
 167           my($start,$end,$strand) = $i{$j}->union($i{$k});
 168           delete($i{$k});
 169           $i{$j} = Bio::Range->new( -start => $start , -end => $end , -strand => $strand );
 170         }
 171       }
 172     }
 173
 174     goto DONE if scalar(keys %i) == $lastsize;
 175     $lastsize = scalar(keys %i);
 176
 177     #warn $lastsize;
 178
 179   } while(1);
 180
 181   DONE:
 182
 183   return values %i;
 184 }
 185
 186
 187 =head1 Member variable access
 188
 189 These methods let you get at and set the member variables
 190
 191 =head2 start
 192
 193   Title    : start
 194   Function : return or set the start co-ordinate
 195   Example  : $s = $range->start(); $range->start(7);
 196   Returns  : the value of the start co-ordinate
 197   Args     : optionally, the new start co-ordinate
 198   Overrides: Bio::RangeI::start
 199
 200 =cut
 201
 202 sub start {
 203     my ($self,$value) = @_;
 204     if( defined $value) {
 205         $self->throw("'$value' is not an integer.\n")
 206             unless $value =~ /^[-+]?\d+$/;
 207         $self->{'start'} = $value;
 208     }
 209     return $self->{'start'};
 210 }
 211
 212 =head2 end
 213
 214   Title    : end
 215   Function : return or set the end co-ordinate
 216   Example  : $e = $range->end(); $range->end(2000);
 217   Returns  : the value of the end co-ordinate
 218   Args     : optionally, the new end co-ordinate
 219   Overrides: Bio::RangeI::end
 220
 221 =cut
 222
 223 sub end {
 224
 225     my ($self,$value) = @_;
 226     if( defined $value) {
 227         $self->throw("'$value' is not an integer.\n")
 228             unless $value =~ /^[-+]?\d+$/;
 229         $self->{'end'} = $value;
 230     }
 231     return $self->{'end'};
 232 }
 233
 234 =head2 strand
 235
 236   Title    : strand
 237   Function : return or set the strandedness
 238   Example  : $st = $range->strand(); $range->strand(-1);
 239   Returns  : the value of the strandedness (-1, 0 or 1)
 240   Args     : optionally, the new strand - (-1, 0, 1) or (-, ., +).
 241   Overrides: Bio::RangeI::strand
 242
 243 =cut
 244
 245 {
 246
 247 my %VALID_STRAND = (
 248     -1      => -1,
 249     0       => 0,
 250     1       => 1,
 251     '+'     => 1,
 252     '-'     => -1,
 253     '.'     => 0
 254 );
 255
 256 sub strand {
 257   my $self = shift;
 258   if(@_) {
 259     my $val = shift;
 260     if (exists $VALID_STRAND{$val}) {
 261         $self->{'strand'} = $VALID_STRAND{$val};
 262     } else {
 263         $self->throw("Invalid strand: $val");
 264     }
 265   }
 266   return $self->{'strand'};
 267 }
 268
 269 }
 270
 271 =head2 length
 272
 273   Title    : length
 274   Function : returns the length of this range
 275   Example  : $length = $range->length();
 276   Returns  : the length of this range, equal to end - start + 1
 277   Args     : if you attempt to set the length an exception will be thrown
 278   Overrides: Bio::RangeI::Length
 279
 280 =cut
 281
 282 sub length {
 283   my $self = shift;
 284   if(@_) {
 285     confess ref($self), "->length() is read-only";
 286   }
 287   return $self->end() - $self->start() + 1;
 288 }
 289
 290 =head2 toString
 291
 292   Title   : toString
 293   Function: stringifies this range
 294   Example : print $range->toString(), "\n";
 295   Returns : a string representation of this range
 296
 297 =cut
 298
 299 sub toString {
 300   my $self = shift;
 301   return  "(${\$self->start}, ${\$self->end}) strand=${\$self->strand}";
 302 }
 303
 304 =head1 Boolean Methods
 305
 306 These methods return true or false.
 307
 308  $range->overlaps($otherRange) && print "Ranges overlap\n";
 309
 310 =head2 overlaps
 311
 312   Title    : overlaps
 313   Usage    : if($r1->overlaps($r2)) { do stuff }
 314   Function : tests if $r2 overlaps $r1
 315   Args     : a range to test for overlap with
 316   Returns  : true if the ranges overlap, false otherwise
 317   Inherited: Bio::RangeI
 318
 319 =head2 contains
 320
 321   Title    : contains
 322   Usage    : if($r1->contains($r2) { do stuff }
 323   Function : tests whether $r1 totally contains $r2
 324   Args     : a range to test for being contained
 325   Returns  : true if the argument is totally contained within this range
 326   Inherited: Bio::RangeI
 327
 328 =head2 equals
 329
 330   Title    : equals
 331   Usage    : if($r1->equals($r2))
 332   Function : test whether $r1 has the same start, end, length as $r2
 333   Args     : a range to test for equality
 334   Returns  : true if they are describing the same range
 335   Inherited: Bio::RangeI
 336
 337 =head1 Geometrical methods
 338
 339 These methods do things to the geometry of ranges, and return
 340 triplets (start, end, strand) from which new ranges could be built.
 341
 342 =head2 intersection
 343
 344   Title    : intersection
 345   Usage    : ($start, $stop, $strand) = $r1->intersection($r2)
 346   Function : gives the range that is contained by both ranges
 347   Args     : a range to compare this one to
 348   Returns  : nothing if they do not overlap, or the range that they do overlap
 349   Inherited: Bio::RangeI::intersection
 350
 351 =cut
 352
 353 =head2 union
 354
 355   Title    : union
 356   Usage    : ($start, $stop, $strand) = $r1->union($r2);
 357            : ($start, $stop, $strand) = Bio::Range->union(@ranges);
 358   Function : finds the minimal range that contains all of the ranges
 359   Args     : a range or list of ranges
 360   Returns  : the range containing all of the ranges
 361   Inherited: Bio::RangeI::union
 362
 363 =cut
 364
 365 1;