view release on metacpan or  search on metacpan

Vec.xs  view on Meta::CPAN

//--------------------------------------------------------------
static ABSV_UINT absv_bsearch_lb(const uchar *v, ABSV_UINT key, ABSV_UINT ilo, ABSV_UINT ihi, ABSV_UINT nbits)
{
 ABSV_UINT imid, imin=ilo, imax=ihi;
 while (ihi-ilo > 1) {
   imid = (ihi+ilo) >> 1;
   if (absv_vget(v, imid, nbits) < key) {
     ilo = imid;
   } else {
     ihi = imid;
   }
 }
 if (               absv_vget(v,ilo,nbits)==key) return ilo;
 if (ihi <  imax && absv_vget(v,ihi,nbits)==key) return ihi;
 //if (ilo > imin || absv_vget(v,ilo,nbits) <key) return ilo; //-- doesn't respect strict imin test!
 if (ilo >= imin && absv_vget(v,ilo,nbits) <key) return ilo;
 return KEY_NOT_FOUND;
}

//--------------------------------------------------------------
static ABSV_UINT absv_bsearch_ub(const uchar *v, ABSV_UINT key, ABSV_UINT ilo, ABSV_UINT ihi, ABSV_UINT nbits)
{
 ABSV_UINT imid, imax=ihi;
 while (ihi-ilo > 1) {
   imid = (ihi+ilo) >> 1;
   if (absv_vget(v, imid, nbits) > key) {
     ihi = imid;
   } else {
     ilo = imid;
   }
 }
 if (ihi<imax && absv_vget(v,ihi,nbits)==key) return ihi;
 if (            absv_vget(v,ilo,nbits)>=key) return ilo;
 return ihi>=imax ? KEY_NOT_FOUND : ihi;
}

/*==============================================================================
 * XS Guts
 */

MODULE = Algorithm::BinarySearch::Vec    PACKAGE = Algorithm::BinarySearch::Vec::XS

PROTOTYPES: ENABLE

##===================================================================
## DEBUG
##=====================================================================

##--------------------------------------------------------------
ABSV_UINT
vget(SV *vec, ABSV_UINT i, ABSV_UINT nbits)
PREINIT:
  uchar *vp;
  STRLEN len;
CODE:
 vp = (uchar *)SvPVbyte(vec, len);
 if (len > i*nbits/8)
   RETVAL = absv_vget(vp, i, nbits);
 else
   RETVAL = 0;
OUTPUT:
  RETVAL

 ##--------------------------------------------------------------
void
vset(SV *vec, ABSV_UINT i, ABSV_UINT nbits, ABSV_UINT val)
PREINIT:
  uchar *vp;
  STRLEN len;
CODE:
 vp = (uchar *)SvPVbyte(vec,len);
 if (len <= i*nbits/8) {
#if 0
   //-- doesn't propagate to perl sv?
   vp = (uchar *)SvGROW(vec, (i+1)*nbits/8);
   SvCUR_set(vec, (i+1)*nbits/8);
#endif //-- re-allocate
   croak("vset(): index " ABSV_PRI " exceeds vector length = " ABSV_PRI " element(s)", i, i*nbits/8);
 }
 absv_vset(vp, i, nbits, val);

##=====================================================================
## CONSTANTS

##--------------------------------------------------------------
ABSV_UINT
HAVE_QUAD()
CODE:
#ifdef ABSV_HAVE_QUAD
 RETVAL = 1;
#else
 RETVAL = 0;
#endif
OUTPUT:
 RETVAL

##--------------------------------------------------------------
ABSV_UINT
KEY_NOT_FOUND()
CODE:
 RETVAL = KEY_NOT_FOUND;
OUTPUT:
 RETVAL

##=====================================================================
## BINARY SEARCH, element-wise

##--------------------------------------------------------------
ABSV_UINT
vbsearch(SV *vec, ABSV_UINT key, ABSV_UINT nbits, ...)
PREINIT:
  const uchar *v;
  STRLEN vlen;
  ABSV_UINT ilo, ihi;
CODE:
 v = SvPV(vec,vlen);
 ilo = items > 3 ? SvUV(ST(3)) : 0;
 ihi = items > 4 ? SvUV(ST(4)) : (vlen*8/nbits);
 RETVAL = absv_bsearch(v,key,ilo,ihi,nbits);
OUTPUT:
 RETVAL

##--------------------------------------------------------------
ABSV_UINT
vbsearch_lb(SV *vec, ABSV_UINT key, ABSV_UINT nbits, ...)
PREINIT:
  const uchar *v;
  STRLEN vlen;
  ABSV_UINT ilo, ihi;
CODE:
 v = SvPV(vec,vlen);
 ilo = items > 3 ? SvUV(ST(3)) : 0;
 ihi = items > 4 ? SvUV(ST(4)) : (vlen*8/nbits);
 RETVAL = absv_bsearch_lb(v,key,ilo,ihi,nbits);
OUTPUT:
 RETVAL

##--------------------------------------------------------------
ABSV_UINT
vbsearch_ub(SV *vec, ABSV_UINT key, ABSV_UINT nbits, ...)
PREINIT:
  const uchar *v;
  STRLEN vlen;
  ABSV_UINT ilo, ihi;
CODE:
 v = SvPV(vec,vlen);
 ilo = items > 3 ? SvUV(ST(3)) : 0;
 ihi = items > 4 ? SvUV(ST(4)) : (vlen*8/nbits);
 RETVAL = absv_bsearch_ub(v,key,ilo,ihi,nbits);
OUTPUT:
 RETVAL


##=====================================================================
## BINARY SEARCH, array-wise

##--------------------------------------------------------------
AV*
vabsearch(SV *vec, AV *keys, ABSV_UINT nbits, ...)
PREINIT:
  const uchar *v;
  STRLEN vlen;
  ABSV_UINT ilo, ihi;
  I32 i,n;
CODE:
 v = SvPV(vec,vlen);
 ilo = items > 3 ? SvUV(ST(3)) : 0;
 ihi = items > 4 ? SvUV(ST(4)) : (vlen*8/nbits);
 n = av_len(keys);
 RETVAL = newAV();
 av_extend(RETVAL, n);
 for (i=0; i<=n; ++i) {
   SV   **key  = av_fetch(keys, i, 0);
   ABSV_UINT   found = absv_bsearch(v,SvUV(*key),ilo,ihi,nbits);
   av_store(RETVAL, i, newSVuv(found));
 }
OUTPUT:
 RETVAL

##--------------------------------------------------------------
AV*
vabsearch_lb(SV *vec, AV *keys, ABSV_UINT nbits, ...)
PREINIT:
  const uchar *v;
  STRLEN vlen;
  ABSV_UINT ilo, ihi;
  I32 i,n;
CODE:
 v = SvPV(vec,vlen);
 ilo = items > 3 ? SvUV(ST(3)) : 0;
 ihi = items > 4 ? SvUV(ST(4)) : (vlen*8/nbits);
 n = av_len(keys);
 RETVAL = newAV();
 av_extend(RETVAL, n);
 for (i=0; i<=n; ++i) {
   SV   **key  = av_fetch(keys, i, 0);
   ABSV_UINT   found = absv_bsearch_lb(v,SvUV(*key),ilo,ihi,nbits);
   av_store(RETVAL, i, newSVuv(found));
 }
OUTPUT:
 RETVAL

##--------------------------------------------------------------
AV*
vabsearch_ub(SV *vec, AV *keys, ABSV_UINT nbits, ...)
PREINIT:
  const uchar *v;
  STRLEN vlen;
  ABSV_UINT ilo, ihi;
  I32 i,n;
CODE:
 v = SvPV(vec,vlen);
 ilo = items > 3 ? SvUV(ST(3)) : 0;
 ihi = items > 4 ? SvUV(ST(4)) : (vlen*8/nbits);
 n = av_len(keys);
 RETVAL = newAV();
 av_extend(RETVAL, n);
 for (i=0; i<=n; ++i) {
   SV   **key  = av_fetch(keys, i, 0);
   ABSV_UINT   found = absv_bsearch_ub(v,SvUV(*key),ilo,ihi,nbits);
   av_store(RETVAL, i, newSVuv(found));
 }
OUTPUT:
 RETVAL

##=====================================================================
## BINARY SEARCH, vec-wise

##--------------------------------------------------------------
SV*
vvbsearch(SV *vec, SV *vkeys, ABSV_UINT nbits, ...)
PREINIT:
  const uchar *v, *k;
  uchar *rv;
  STRLEN vlen, klen;
  ABSV_UINT i,n, ilo, ihi;
CODE:
 v = SvPV(vec,vlen);
 k = SvPV(vkeys,klen);
 ilo = items > 3 ? SvUV(ST(3)) : 0;
 ihi = items > 4 ? SvUV(ST(4)) : (vlen*8/nbits);
 n   = klen*8/nbits;
 RETVAL = newSVpv("",0);
 SvGROW(RETVAL, n*4);	       //-- always use 32-bit keys
 SvCUR_set(RETVAL, n*4);
 rv = SvPV_nolen(RETVAL);
 for (i=0; i<n; ++i) {
   ABSV_UINT key   = absv_vget(k,i,nbits);
   ABSV_UINT found = absv_bsearch(v,key,ilo,ihi,nbits);
   absv_vset(rv,i,32,found);
 }
OUTPUT:
 RETVAL

##--------------------------------------------------------------
SV*
vvbsearch_lb(SV *vec, SV *vkeys, ABSV_UINT nbits, ...)
PREINIT:
  const uchar *v, *k;
  uchar *rv;
  STRLEN vlen, klen;
  ABSV_UINT i,n, ilo, ihi;
CODE:
 v = SvPV(vec,vlen);
 k = SvPV(vkeys,klen);
 ilo = items > 3 ? SvUV(ST(3)) : 0;
 ihi = items > 4 ? SvUV(ST(4)) : (vlen*8/nbits);
 n   = klen*8/nbits;
 RETVAL = newSVpv("",0);
 SvGROW(RETVAL, n*4);	 	//-- always use 32-bit keys
 SvCUR_set(RETVAL, n*4);
 rv = SvPV_nolen(RETVAL);
 for (i=0; i<n; ++i) {
   ABSV_UINT key   = absv_vget(k,i,nbits);
   ABSV_UINT found = absv_bsearch_lb(v,key,ilo,ihi,nbits);
   absv_vset(rv,i,32,found);
 }
OUTPUT:
 RETVAL

##--------------------------------------------------------------
SV*
vvbsearch_ub(SV *vec, SV *vkeys, ABSV_UINT nbits, ...)
PREINIT:
  const uchar *v, *k;
  uchar *rv;
  STRLEN vlen, klen;
  ABSV_UINT i,n, ilo, ihi;
CODE:
 v = SvPV(vec,vlen);
 k = SvPV(vkeys,klen);
 ilo = items > 3 ? SvUV(ST(3)) : 0;
 ihi = items > 4 ? SvUV(ST(4)) : (vlen*8/nbits);
 n   = klen*8/nbits;
 RETVAL = newSVpv("",0);
 SvGROW(RETVAL, n*4);		//-- always use 32-bit keys
 SvCUR_set(RETVAL, n*4);
 rv = SvPV_nolen(RETVAL);
 for (i=0; i<n; ++i) {
   ABSV_UINT key   = absv_vget(k,i,nbits);
   ABSV_UINT found = absv_bsearch_ub(v,key,ilo,ihi,nbits);
   absv_vset(rv,i,32,found);
 }
OUTPUT:
 RETVAL

##=====================================================================
## SET OPERATIONS

##--------------------------------------------------------------
SV*
vunion(SV *avec, SV *bvec, ABSV_UINT nbits)
PREINIT:
  const uchar *a, *b;
  uchar *c;
  STRLEN alen,blen;
  ABSV_UINT na,nb,nc, ai,bi,ci, aval,bval;
CODE:
 if (nbits < 8)
   croak("vunion(): cannot handle nbits < 8, but you requested " ABSV_PRI, nbits);
 a = SvPV(avec,alen);
 b = SvPV(bvec,blen);
 na = alen*8/nbits;
 nb = blen*8/nbits;
 nc = na + nb;
 RETVAL = newSVpv("",0);
 SvGROW(RETVAL, nc*nbits/8);
 c = SvPV_nolen(RETVAL);
 for (ai=0,bi=0,ci=0; ai < na && bi < nb; ++ci) {
   aval = absv_vget(a,ai,nbits);
   bval = absv_vget(b,bi,nbits);
   if (aval <= bval) {
     absv_vset(c,ci,nbits,aval);
     ++ai;
     if (aval == bval) ++bi;
   } else { //-- aval > bval
     absv_vset(c,ci,nbits,bval);
     ++bi;
   }
 }
 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;
 }
 na = alen*8/nbits;
 nb = blen*8/nbits;
 nc = na;
 RETVAL = newSVpv("",0);
 SvGROW(RETVAL, nc*nbits/8);
 c = SvPV_nolen(RETVAL);
 for (ai=0,blo=0,ci=0; ai < na; ++ai) {
   aval = absv_vget(a,ai,nbits);
   bi   = absv_bsearch_ub(b,aval,blo,nb,nbits);
   if (bi   == KEY_NOT_FOUND) break;
   if (aval == absv_vget(b,bi,nbits)) {
     absv_vset(c,ci++,nbits,aval);
   }
   blo = bi;
 }
 SvCUR_set(RETVAL, ci*nbits/8);
OUTPUT:
 RETVAL

##--------------------------------------------------------------
SV*
vsetdiff(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("vsetdiff(): cannot handle nbits < 8, but you requested " ABSV_PRI, nbits);
 a = SvPV(avec,alen);
 b = SvPV(bvec,blen);
 na = alen*8/nbits;
 nb = blen*8/nbits;
 nc = na;
 RETVAL = newSVpv("",0);
 SvGROW(RETVAL, nc*nbits/8);
 c = SvPV_nolen(RETVAL);
 for (ai=0,blo=0,ci=0; ai < na; ++ai) {
   aval = absv_vget(a,ai,nbits);
   bi   = absv_bsearch_ub(b,aval,blo,nb,nbits);
   if (bi   == KEY_NOT_FOUND) break;
   if (aval != absv_vget(b,bi,nbits)) {
     absv_vset(c,ci++,nbits,aval);
   }
   blo = bi;
 }
 for ( ; ai < na; ++ai)
   absv_vset(c,ci++,nbits,absv_vget(a,ai,nbits));
 SvCUR_set(RETVAL, ci*nbits/8);
OUTPUT:
 RETVAL