Algorithm-BinarySearch-Vec
view release on metacpan or search on metacpan
v0.08 Thu, 01 Sep 2016 12:09:31 +0200 moocow
* ensure $Config{use64bitint} before setting HAVE_QUAD
- should fix weird errors on e.g. 32-bit freebsd without perl -use64bitint compile-time option
- compare cpantesters results
~ WITH -use64bitint: http://www.cpantesters.org/cpan/report/749d41d2-6a1e-11e6-8807-814d1da4c10f
~ WITHOUT -use64bitint: http://www.cpantesters.org/cpan/report/228a2396-6a47-11e6-8807-814d1da4c10f
v0.07 Mon, 18 Apr 2016 16:42:44 +0200 moocow
* added support for nbits==64; indices are still always 32-bit
- for batch vector-wise search variants we'll need xs sub variants to ensure compatibility
* added set operations vunion(), vintersect(), vsetdiff()
- intersect & setdiff optimized for merging a small set $a with a large one $b, independent of argument order: O($Na * log $Nb)
* re-worked tests to use Test::More
v0.06 2015-04-08 moocow (no cpan release)
* fixed unrespected strict imin checking in absv_bsearch_lb()
v0.05 2012-10-31 moocow
* added Changes (fixes RT #80502)
* tweaked 'use vars' line in t/01_ini.t (perl 5.6.2 choked)
- see http://www.cpantesters.org/cpan/report/67845932-1927-11e2-8c89-c5fec1a37597
our $KEY_NOT_FOUND = $HAVE_XS ? Algorithm::BinarySearch::Vec::XS::KEY_NOT_FOUND() : 0xffffffff;
#our $KEY_NOT_FOUND = $HAVE_XS ? Algorithm::BinarySearch::Vec::XS::KEY_NOT_FOUND() : ($HAVE_QUAD ? 0xffffffffffffffff : 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),
qw(vunion vintersect vsetdiff),
],
const => [qw($HAVE_QUAD $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}};
}
vec($cv,$ci,$nbits) = $bval;
++$bi;
}
}
$cv .= substr($$avr, $ai*$nbits/8);
$cv .= substr($$bvr, $bi*$nbits/8);
return $cv;
}
##--------------------------------------------------------------
## $vintersect = vintersect($av,$bv,$nbits)
sub _vintersect {
my ($avr,$bvr,$nbits) = (\$_[0],\$_[1],$_[2]);
die(__PACKAGE__ , "::_vintersect(): cannot handle nbits < 8, but you requested $nbits") if ($nbits < 8);
##-- ensure smaller set is "a"
($$avr,$$bvr) = ($$bvr,$$avr) if (length($$bvr) < length($$avr));
my $na = length($$avr)*8/$nbits;
my $nb = length($$bvr)*8/$nbits;
my $cv = '';
my ($ai,$bi,$ci, $blo,$aval,$bval);
for ($ai=0,$blo=0,$ci=0; $ai < $na; ++$ai) {
$aval = vec($$avr,$ai,$nbits);
vec($cv,$ci++,$nbits) = $aval if ($aval == vec($$bvr,$bi,$nbits));
$blo = $bi;
}
return $cv;
}
##--------------------------------------------------------------
## $vsetdiff = vsetdiff($av,$bv,$nbits)
sub _vsetdiff {
my ($avr,$bvr,$nbits) = (\$_[0],\$_[1],$_[2]);
die(__PACKAGE__ , "::_vintersect(): cannot handle nbits < 8, but you requested $nbits") if ($nbits < 8);
my $na = length($$avr)*8/$nbits;
my $nb = length($$bvr)*8/$nbits;
my $cv = '';
my ($ai,$bi,$ci, $blo,$aval,$bval);
for ($ai=0,$blo=0,$ci=0; $ai < $na; ++$ai) {
$aval = vec($$avr,$ai,$nbits);
$bi = _vbsearch_ub($$bvr,$aval,$nbits,$blo,$nb);
last if ($bi == $KEY_NOT_FOUND);
vec($cv,$ci++,$nbits) = $aval if ($aval != vec($$bvr,$bi,$nbits));
##-------------------------------------------------------------
## Search: vector-wise
$ixvec = vvbsearch ($v,$keyvec,$nbits,$lo,$hi); ##-- match only
$ixvec = vvbsearch_lb($v,$keyvec,$nbits,$lo,$hi); ##-- lower bound
$ixvec = vvbsearch_ub($v,$keyvec,$nbits,$lo,$hi); ##-- upper bound
##-------------------------------------------------------------
## Set Operations
$cv = vunion($av,$bv,$nbits); ##-- set union
$cv = vintersect($av,$bv,$nbits); ##-- set intersection
$cv = vsetdiff($av,$bv,$nbits); ##-- set difference
##-------------------------------------------------------------
## Debugging
$val = vget($vec,$i,$nbits);
undef = vset($vec,$i,$nbits, $newval);
$vals = vec2array($vec,$nbits);
=head1 DESCRIPTION
The vector-sets returned by these API functions should also conform to these
conventions whenever the parameters do.
=over 4
=item vunion($av,$bv,$nbits)
Computes the union of two sorted vec()-style sets C<$av> and C<$bv>
and returns the result as a sorted vector-set. Complexity is I<O>(C<$a> + C<$b>)>.
=item vintersect($av,$bv,$nbits)
Computes the intersection of two sorted vec()-style sets C<$av> and C<$bv>
and returns the result as a sorted vector-set. Complexity is I<O>(C<$A> * log C<$B>),
where C<$A> is the shorter and C<$B> the longer of the argument vectors C<$a> and C<$b>.
=item vsetdiff($av,$bv,$nbits)
Computes the difference of two sorted vec()-style sets C<$av> and C<$bv>
and returns the result as a sorted vector-set. Complexity is I<O>(C<$A> * log C<$B>),
where C<$A> is the shorter and C<$B> the longer of the argument vectors C<$a> and C<$b>.
=back
for (; ai < na; ++ai, ++ci)
absv_vset(c,ci,nbits,absv_vget(a,ai,nbits));
for (; bi < nb; ++bi, ++ci)
absv_vset(c,ci,nbits,absv_vget(b,bi,nbits));
SvCUR_set(RETVAL, ci*nbits/8);
OUTPUT:
RETVAL
##--------------------------------------------------------------
SV*
vintersect(SV *avec, SV *bvec, ABSV_UINT nbits)
PREINIT:
const uchar *a, *b;
uchar *c;
STRLEN alen,blen;
ABSV_UINT na,nb,nc, ai,blo,bi,ci, aval,bval;
CODE:
if (nbits < 8)
croak("vintersect(): cannot handle nbits < 8, but you requested " ABSV_PRI, nbits);
a = SvPV(avec,alen);
b = SvPV(bvec,blen);
if (blen < alen) {
//-- ensure smaller set is "a"
const uchar *tmp = b;
STRLEN tmplen = blen;
b = a;
a = tmp;
blen = alen;
alen = tmplen;
t/05_setops.t view on Meta::CPAN
##======================================================================
## test: union +8
$c_want = [(1..9),(10,12,14)];
foreach my $func ("${PKG}::_vunion","${PKG}::XS::vunion") {
foreach my $nbits (8,16,32,64) {
check_setop($func, $nbits, $al,$bl, $c_want);
}
}
##======================================================================
## test: intersect: +8
$c_want = [qw(2 4 6 8)];
foreach my $func ("${PKG}::_vintersect","${PKG}::XS::vintersect") {
foreach my $nbits (8,16,32,64) {
check_setop($func, $nbits, $al,$bl, $c_want);
}
}
##======================================================================
## test: setdiff: +8
$c_want = [qw(1 3 5 7 9)];
foreach my $func ("${PKG}::_vsetdiff","${PKG}::XS::vsetdiff") {
foreach my $nbits (8,16,32,64) {
( run in 1.061 second using v1.01-cache-2.11-cpan-39bf76dae61 )