File Coverage

blib/lib/CracTools/Interval/Query.pm

Criterion	Covered	Total	%
statement	86	92	93.4
branch	17	28	60.7
condition	1	3	33.3
subroutine	18	18	100.0
pod	8	8	100.0
total	130	149	87.2

package CracTools::Interval::Query;

{
  $CracTools::Interval::Query::DIST = 'CracTools';
}
# ABSTRACT: Store and query genomics intervals.
#
$CracTools::Interval::Query::VERSION = '1.251';
use strict;
use warnings;

use CracTools::Utils;
use Set::IntervalTree 0.10;
use Carp;


sub new {
  my $class = shift;

  my %args = @_;

  my $self = bless {
    interval_trees => {},
    }, $class;

  return $self;
}


sub addInterval {
  my $self = shift;
  my ($chr,$start,$end,$strand,$value) = @_;

  my $interval_tree = $self->_getIntervalTree($chr,$strand);
  # If there is no already existing IntervalTree for this ("chr","strand") pair
  if(!defined $interval_tree) {
    # We create a new one
    $interval_tree = Set::IntervalTree->new;
    # We add this new interval tree with the others
    $self->_addIntervalTree($chr,$strand,$interval_tree);
  }

  # We insert the given interval in the IntervalTree
  # pos_end +1 because Interval tree use [a,b) intervals
  #$interval_tree->insert($value,$start,$end+1);
  $interval_tree->insert({value => $value, start => $start, end => $end},$start,$end+1);
}


sub fetchByRegion {
  my ($self,$chr,$pos_start,$pos_end,$strand,$windowed) = @_;

  my $interval_tree = $self->_getIntervalTree($chr,$strand);

  if(defined $interval_tree) {
    if(defined $windowed && $windowed) {
      # pos_end +1 because Interval tree use [a,b) intervals
      return $self->_processReturnValues($interval_tree->fetch_window($pos_start,$pos_end+1));
    } else {
      # pos_end +1 because Interval tree use [a,b) intervals
      return $self->_processReturnValues($interval_tree->fetch($pos_start,$pos_end+1));
    }
  }
  return [];
}


sub fetchByLocation {
  my ($self,$chr,$position,$strand) = @_;
  return $self->fetchByRegion($chr,$position,$position,$strand);
}


sub fetchNearestDown {
  my ($self,$chr,$position,$strand) = @_;

  my $interval_tree = $self->_getIntervalTree($chr,$strand);

  if(defined $interval_tree) {
    my $nearest_down = $interval_tree->fetch_nearest_down($position);
    if(defined $nearest_down) {
      return ({start => $nearest_down->{start}, end => $nearest_down->{end}},
        $self->_processReturnValue($nearest_down->{value})
      );
    }
  }
  return [];
}


sub fetchNearestUp {
  my ($self,$chr,$position,$strand) = @_;

  my $interval_tree = $self->_getIntervalTree($chr,$strand);

  if(defined $interval_tree) {
    my $nearest_up = $interval_tree->fetch_nearest_up($position);
    if(defined $nearest_up) {
      return ({start => $nearest_up->{start}, end => $nearest_up->{end}},
        $self->_processReturnValue($nearest_up->{value})
      );
    }
  }
  return [];
}


sub fetchAllNearestDown {
  my ($self,$chr,$position,$strand) = @_;

  my ($nearest_down_interval,$nearest_down) = $self->fetchNearestDown($chr,$position,$strand);
  if(defined $nearest_down) {
    # We return all lines that belong to this
    my ($hits_interval,$hits) = $self->fetchByLocation($chr,$nearest_down_interval->{end},$strand);
    my @valid_hits;
    my @valid_hits_interval;
    for (my $i = 0; $i < @$hits; $i++) {
      # if this inteval as the same "end" boudaries as the nearest down interval
      if($hits_interval->[$i]->{end} == $nearest_down_interval->{end}) {
        push @valid_hits, $hits->[$i];
        push @valid_hits_interval, $hits_interval->[$i];
      }
    }
    return (\@valid_hits_interval,\@valid_hits);
  }
  return [];
}


sub fetchAllNearestUp {
  my ($self,$chr,$position,$strand) = @_;

  my ($nearest_up_interval,$nearest_up) = $self->fetchNearestUp($chr,$position,$strand);

  if(defined $nearest_up) {
    # We return all lines that belong to this
    my ($hits_interval,$hits) = $self->fetchByLocation($chr,$nearest_up_interval->{start},$strand);
    my @valid_hits;
    my @valid_hits_interval;
    for (my $i = 0; $i < @$hits; $i++) {
      # if this inteval as the same "end" boudaries as the nearest down interval
      if($hits_interval->[$i]->{start} == $nearest_up_interval->{start}) {
        push @valid_hits, $hits->[$i];
        push @valid_hits_interval, $hits_interval->[$i];
      }
    }
    return (\@valid_hits_interval,\@valid_hits);
  }

  return [];
}


sub _getIntervalTree {
  my ($self,$chr,$strand) = @_;
  $strand = 1 if !defined $strand;
  return $self->{interval_trees}{_getIntervalTreeKey($chr,$strand)};
}


sub _addIntervalTree {
  my ($self,$chr,$strand,$interval_tree) = @_;
  $strand = 1 if !defined $strand;
  $self->{interval_trees}{_getIntervalTreeKey($chr,$strand)} = $interval_tree;
}


sub _getIntervalTreeKey {
  my ($chr,$strand) = @_;
  $strand = 1 if !defined $strand;
  return "$chr"."@"."$strand";
}


sub _processReturnValues {
  my $self = shift;
  my $return_values = shift;
  my @processed_return_values = ();
  my @processed_return_intervals = ();
  foreach (@{$return_values}) {
    push(@processed_return_values, $self->_processReturnValue($_->{value}));
    push(@processed_return_intervals, {
        start => $_->{start},
        end => $_->{end}
      }
    );
  }
  return (\@processed_return_intervals,\@processed_return_values);
}


sub _processReturnValue {
  my $self = shift;
  my $val = shift;
  return $val;
}

1;

__END__