File Coverage

blib/lib/Math/IntervalSearch.pm

Criterion	Covered	Total	%
statement	74	79	93.6
branch	39	44	88.6
condition	8	12	66.6
subroutine	7	8	87.5
pod	1	4	25.0
total	129	147	87.7

package Math::IntervalSearch;

require 5.004_01;

use strict;
use vars qw(@EXPORT_OK @ISA $VERSION);
use Exporter;
use Carp;

@EXPORT_OK = qw(interval_search);
@ISA       = qw(Exporter);
$VERSION   = 1.06;
$VERSION   = eval $VERSION;

sub cluck { warn Carp::longmess @_ }

sub LessThan {
  $_[0] < $_[1];
}

sub LessThanEqualTo {
  $_[0] <= $_[1];
}

# This holds the result from the last interval search.
my $last_interval_result = undef;

sub interval_search {
  if ( @_ > 4 ) {
    cluck "interval called with too many parameters";
    return;
  }

  # Get the input arguments.
  my $x           = shift;
  my $sequenceRef = shift;

  return unless defined($x);
  return unless defined($sequenceRef);
  return unless ref($sequenceRef);

  # Check the input arguments for any code references and use them.
  my $LessThan        = \&LessThan;
  my $LessThanEqualTo = \&LessThanEqualTo;
  @_ and defined(ref($_[0])) and ref($_[0]) eq 'CODE' and
    $LessThan = shift;
  @_ and defined(ref($_[0])) and ref($_[0]) eq 'CODE' and
    $LessThanEqualTo = shift;

  # Get the number of points in the data.
  my $num = @$sequenceRef;

  # Return -1 if there's no data.
  if ( $num <= 0 ) {
    $last_interval_result = 0;
    return -1;
  }

  # Use the result from the last time through the subroutine, if it
  # exists.  Force the result into the range required by the array
  # size.
  $last_interval_result = 0 unless defined($last_interval_result);

  # Which side of the data point is x on if there's only one point?
  if ( $num == 1 ) {
    $last_interval_result = 0;
    if ( &$LessThan($x, $sequenceRef->[0]) ) {
      return -1;
    }
    else {
      return 0;
    }
  }

  # Is the point less than the smallest point in the sequence?
  if ( &$LessThan($x, $sequenceRef->[0]) ) {
    $last_interval_result = 0;
    return -1;
  }

  # Is the point greater than the largest point in the sequence?
  if ( &$LessThanEqualTo($sequenceRef->[$num-1], $x) ) {
    return $last_interval_result = $num - 1;
  }

  # Use the result from the last run as a start for this run.
  if ( $last_interval_result > $num-1 ) {
    $last_interval_result = $num - 2;
  }
  my $ilo = $last_interval_result;
  my $ihi = $ilo + 1;

  # Is the new upper ihi beyond the extent of the sequence?
  if ( $ihi >= $num ) {
    $ihi = $num - 1;
    $ilo = $ihi - 1;
  }

  # If x < sequence(ilo), then decrease ilo to capture x.
  if ( &$LessThan($x, $sequenceRef->[$ilo]) ) {
    my $istep = 1;
    for (;;) {
      $ihi = $ilo;
      $ilo = $ihi - $istep;
      if ( $ilo <= 0 ) {
	$ilo = 0;
	last;
      }
      if ( &$LessThanEqualTo($sequenceRef->[$ilo], $x) ) {
	last;
      }
      $istep *= 2;
    }
  }

  # If x >= sequence(ihi), then increase ihi to capture x.
  if ( &$LessThanEqualTo($sequenceRef->[$ihi], $x) ) {
    my $istep = 1;
    for (;;) {
      $ilo = $ihi;
      $ihi = $ilo + $istep;
      if ( $ihi >= $num-1 ) {
	$ihi = $num - 1;
	last;
      }
      if ( &$LessThan($x, $sequenceRef->[$ihi]) ) {
	last;
      }
      $istep *= 2;
    }
  }

  # Now sequence(ilo) <= x < sequence(ihi).  Narrow the interval.
  for (;;) {
    # Find the middle point of the sequence.
    my $middle = int(($ilo + $ihi)/2);

    # The division above was integer, so if ihi = ilo+1, then
    # middle=ilo, which tests if x has been trapped.
    if ( $middle == $ilo ) {
      $last_interval_result = $ilo;
      return $ilo;
    }
    if ( &$LessThan($x, $sequenceRef->[$middle]) ) {
      $ihi = $middle;
    }
    else {
      $ilo = $middle;
    }
  }
}

1;

__END__