File Coverage

blib/lib/Algorithm/BinarySearch/Vec.pm

Criterion	Covered	Total	%
statement	79	81	97.5
branch	24	32	75.0
condition	10	12	83.3
subroutine	17	19	89.4
pod	1	1	100.0
total	131	145	90.3

package Algorithm::BinarySearch::Vec;

use Exporter;
use Carp;
use AutoLoader;
use strict;
use bytes;

our @ISA = qw(Exporter);
our $VERSION = '0.05';

our ($HAVE_XS);
eval {
  require XSLoader;
  $HAVE_XS = XSLoader::load('Algorithm::BinarySearch::Vec', $VERSION);
} or do {
  $HAVE_XS = 0;
};

# Preloaded methods go here.
#require Algorithm::BinarySearch::Vec::XS::Whatever;

# Autoload methods go after =cut, and are processed by the autosplit program.

##======================================================================
## Exports
##======================================================================

our $KEY_NOT_FOUND = 0xffffffff;

our (%EXPORT_TAGS, @EXPORT_OK, @EXPORT);
BEGIN {
  %EXPORT_TAGS =
    (
     api   => [qw( vbsearch  vbsearch_lb  vbsearch_ub),
	       qw(vabsearch vabsearch_lb vabsearch_ub),
	       qw(vvbsearch vvbsearch_lb vvbsearch_ub),
	      ],
     const => [qw($KEY_NOT_FOUND)],
     debug => [qw(vget vset vec2array)],
    );
  $EXPORT_TAGS{all}     = [map {@$_} @EXPORT_TAGS{qw(api const debug)}];
  $EXPORT_TAGS{default} = [map {@$_} @EXPORT_TAGS{qw(api const)}];
  @EXPORT_OK            = @{$EXPORT_TAGS{all}};
  @EXPORT               = @{$EXPORT_TAGS{default}};
}

##======================================================================
## Debug wrappers

##--------------------------------------------------------------
## $val = vget($vec,$i,$nbits)
sub _vget {
  return vec($_[0],$_[1],$_[2]);
}

##--------------------------------------------------------------
## undef = vset($vec,$i,$nbits,$val)
sub _vset {
  return vec($_[0],$_[1],$_[2])=$_[3];
}


##======================================================================
## API: Search: element-wise

##--------------------------------------------------------------
## $index = vbsearch($v,$key,$nbits)
## $index = vbsearch($v,$key,$nbits,$ilo,$ihi)
sub _vbsearch {
  my ($vr,$key,$nbits,$ilo,$ihi) = (\$_[0],@_[1..$#_]);
  $ilo = 0 if (!defined($ilo));
  $ihi = 8*length($$vr)/$nbits if (!defined($ihi));
  my ($imid);
  while ($ilo < $ihi) {
    $imid = ($ihi+$ilo) >> 1;
    if (vec($$vr,$imid,$nbits) < $key) {
      $ilo = $imid + 1;
    } else {
      $ihi = $imid;
    }
  }
  return ($ilo==$ihi) && vec($$vr,$ilo,$nbits)==$key ? $ilo : $KEY_NOT_FOUND;
}

##--------------------------------------------------------------
## $index = vbsearch_lb($v,$key,$nbits)
## $index = vbsearch_lb($v,$key,$nbits,$ilo,$ihi)
sub _vbsearch_lb {
  my ($vr,$key,$nbits,$ilo,$ihi) = (\$_[0],@_[1..$#_]);
  $ilo = 0 if (!defined($ilo));
  $ihi = 8*length($$vr)/$nbits if (!defined($ihi));
  my ($imin,$imax,$imid) = ($ilo,$ihi);
  while ($ihi-$ilo > 1) {
    $imid = ($ihi+$ilo) >> 1;
    if (vec($$vr,$imid,$nbits) < $key) {
      $ilo = $imid;
    } else {
      $ihi = $imid;
    }
  }
  return $ilo if (                vec($$vr,$ilo,$nbits)==$key);
  return $ihi if ($ihi < $imax && vec($$vr,$ihi,$nbits)==$key);
  return $ilo if ($ilo > $imin || vec($$vr,$ilo,$nbits) <$key);
  return $KEY_NOT_FOUND;
}

##--------------------------------------------------------------
## $index = vbsearch_ub($v,$key,$nbits)
## $index = vbsearch_ub($v,$key,$nbits,$ilo,$ihi)
sub _vbsearch_ub {
  my ($vr,$key,$nbits,$ilo,$ihi) = (\$_[0],@_[1..$#_]);
  $ilo = 0 if (!defined($ilo));
  $ihi = 8*length($$vr)/$nbits if (!defined($ihi));
  my ($imin,$imax,$imid) = ($ilo,$ihi);
  while ($ihi-$ilo > 1) {
    $imid = ($ihi+$ilo) >> 1;
    if (vec($$vr,$imid,$nbits) > $key) {
      $ihi = $imid;
    } else {
      $ilo = $imid;
    }
  }
  return $ihi if ($ihi < $imax && vec($$vr,$ihi,$nbits)==$key);
  return $ilo if (                vec($$vr,$ilo,$nbits)>=$key);
  return $ihi>=$imax ? $KEY_NOT_FOUND : $ihi;
}

##======================================================================
## API: Search: array-wise

##--------------------------------------------------------------
## \@indices = vabsearch($v,\@keys,$nbits)
## \@indices = vabsearch($v,\@keys,$nbits,$ilo,$ihi)
sub _vabsearch {
  return [map {vbsearch($_[0],$_,@_[2..$#_])} @{$_[1]}];
}


##--------------------------------------------------------------
## \@indices = vabsearch_lb($v,\@keys,$nbits)
## \@indices = vabsearch_lb($v,\@keys,$nbits,$ilo,$ihi)
sub _vabsearch_lb {
  return [map {vbsearch_lb($_[0],$_,@_[2..$#_])} @{$_[1]}];
}

##--------------------------------------------------------------
## \@indices = vabsearch_ub($v,\@keys,$nbits)
## \@indices = vabsearch_ub($v,\@keys,$nbits,$ilo,$ihi)
sub _vabsearch_ub {
  return [map {vbsearch_ub($_[0],$_,@_[2..$#_])} @{$_[1]}];
}

##======================================================================
## API: Search: vec-wise

## \@a = vec2array($vec,$nbits)
sub vec2array {
  return [map {vec($_[0],$_,$_[1])} (0..(length($_[0])*8/$_[1]-1))];
}

##--------------------------------------------------------------
## $indices = vvbsearch($v,$keys,$nbits)
## $indices = vvbsearch($v,$keys,$nbits,$ilo,$ihi)
sub _vvbsearch {
  return pack('N*', @{vabsearch($_[0],vec2array(@_[1,2]),@_[2..$#_])});
}

##--------------------------------------------------------------
## $indices = vvbsearch_lb($v,$keys,$nbits)
## $indices = vvbsearch_lb($v,$keys,$nbits,$ilo,$ihi)
sub _vvbsearch_lb {
  return pack('N*', @{vabsearch_lb($_[0],vec2array(@_[1,2]),@_[2..$#_])});
}

##--------------------------------------------------------------
## $indices = vvbsearch_ub($v,$keys,$nbits)
## $indices = vvbsearch_ub($v,$keys,$nbits,$ilo,$ihi)
sub _vvbsearch_ub {
  return pack('N*', @{vabsearch_ub($_[0],vec2array(@_[1,2]),@_[2..$#_])});
}


##======================================================================
## delegate: attempt to delegate to XS module
foreach my $func (map {@$_} @EXPORT_TAGS{qw(api debug)}) {
  no warnings 'redefine';
  if ($HAVE_XS && Algorithm::BinarySearch::Vec::XS->can($func)) {
    eval "\*$func = \\&Algorithm::BinarySearch::Vec::XS::$func;";
  } elsif (__PACKAGE__->can("_$func")) {
    eval "\*$func = \\&_$func;";
  }
}


1; ##-- be happy

__END__