File Coverage

blib/lib/Bio/Gonzales/Range/Util.pm

Criterion	Covered	Total	%
statement	43	43	100.0
branch	15	16	93.7
condition	9	11	81.8
subroutine	7	7	100.0
pod	0	2	0.0
total	74	79	93.6

package Bio::Gonzales::Range::Util;

use warnings;
use strict;
use Carp;

use 5.010;

use base 'Exporter';
our ( @EXPORT, @EXPORT_OK, %EXPORT_TAGS );
our $VERSION = '0.083'; # VERSION

@EXPORT      = qw();
%EXPORT_TAGS = ();
@EXPORT_OK   = qw(overlaps cluster_overlapping_ranges);

sub overlaps {
  my ( $r, $q, $c ) = @_;
  my $offset = defined $c->{offset} ? $c->{offset} : 0;
  $offset = 1 if ( $c->{book_ended} );

  # not ( ref start greater than query end or ref end less than query start )
  return not( $r->[0] - $offset > $q->[1] or $r->[1] < $q->[0] - $offset );
}

sub cluster_overlapping_ranges {
  my ( $ranges, $c ) = @_;

  #[ start, stop, @whatever]

  carp "empty ranges" and return unless ( $ranges && @$ranges > 0 );

  my @sorted_ranges = sort { $a->[0] <=> $b->[0] or $a->[1] <=> $b->[1] } @$ranges;
  my @range_clusters;

  my $i = 0;

  while (1) {
    if ( $i >= @sorted_ranges - 1 ) {
      push @range_clusters, [ $sorted_ranges[$i] ]
        if ( $i == @sorted_ranges - 1 );
      last;
    }

    my $range = $sorted_ranges[$i];

    my @current_cluster = ($range);

    my $next_range = $sorted_ranges[ $i + 1 ];
    my $max_end    = $range->[1];
    while ( $next_range->[0] <= $max_end
      || overlaps( $range, $next_range, $c ) )
    {
      push @current_cluster, $next_range;

      $i++;
      $max_end = $next_range->[1] if ( $next_range->[1] > $max_end );
      $range = $next_range;

      if ( $i + 1 >= @sorted_ranges ) {
        last;
      }

      $next_range = $sorted_ranges[ $i + 1 ];
    }
    $i++;
    push @range_clusters, \@current_cluster;
  }
  return \@range_clusters;
}



1;