Bio/Range.pm

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