Stats-LikeR

 view release on metacpan or  search on metacpan

LikeR.xs  view on Meta::CPAN

	SV *df
	IV shape
	SV *spec
  PREINIT:
	SV *retval; AV *spec_av; SSize_t n, i;
  CODE:
{
	spec_av = (AV *)SvRV(spec);
	n = av_len(spec_av) + 1;
	if (shape == 3) { // ---- AoA ----
		IV *idx; Newx(idx, n > 0 ? n : 1, IV);
		for (i = 0; i < n; i++) { SV **e = av_fetch(spec_av, i, 0); idx[i] = SvIV(*e); }
		AV *src = (AV *)SvRV(df); SSize_t R = av_len(src) + 1;
		AV *out = newAV(); if (R > 0) av_extend(out, R - 1);
		for (i = 0; i < R; i++) {
			SV **rp = av_fetch(src, i, 0); AV *inner;
			if (rp && *rp && SvROK(*rp) && SvTYPE(SvRV(*rp)) == SVt_PVAV)
				inner = rowA_select(aTHX_ (AV *)SvRV(*rp), idx, n);
			else
				inner = rowA_select(aTHX_ NULL, idx, n);
			av_store(out, i, newRV_noinc((SV *)inner));
		}
		Safefree(idx);
		retval = sv_2mortal(newRV_noinc((SV *)out));
	} else {
		SV **keys; Newx(keys, n > 0 ? n : 1, SV *);
		for (i = 0; i < n; i++) { SV **e = av_fetch(spec_av, i, 0); keys[i] = *e; }
		if (shape == 1) { // ---- AoH ----
			AV *src = (AV *)SvRV(df); SSize_t R = av_len(src) + 1;
			AV *out = newAV(); if (R > 0) av_extend(out, R - 1);
			for (i = 0; i < R; i++) {
				SV **rp = av_fetch(src, i, 0); HV *inner;
				if (rp && *rp && SvROK(*rp) && SvTYPE(SvRV(*rp)) == SVt_PVHV)
					inner = row_select(aTHX_ (HV *)SvRV(*rp), keys, n);
				else
					inner = row_select(aTHX_ NULL, keys, n);
				av_store(out, i, newRV_noinc((SV *)inner));
			}
			retval = sv_2mortal(newRV_noinc((SV *)out));
		} else { // ---- HoH ----
			HV *src = (HV *)SvRV(df); HV *out = newHV();
			hv_iterinit(src); HE *he;
			while ((he = hv_iternext(src))) {
				STRLEN kl; char *kp = HePV(he, kl); I32 sk = HeUTF8(he) ? -(I32)kl : (I32)kl;
				SV *rv = HeVAL(he); HV *inner;
				if (rv && SvROK(rv) && SvTYPE(SvRV(rv)) == SVt_PVHV)
					inner = row_select(aTHX_ (HV *)SvRV(rv), keys, n);
				else
					inner = row_select(aTHX_ NULL, keys, n);
				(void)hv_store(out, kp, sk, newRV_noinc((SV *)inner), HeHASH(he));
			}
			retval = sv_2mortal(newRV_noinc((SV *)out));
		}
		Safefree(keys);
	}
	RETVAL = SvREFCNT_inc(retval);
}
  OUTPUT:
	RETVAL

# shape: 1 = AoH, 2 = HoH. dropset: hashref whose keys are the columns to remove
SV *
_cols_drop(df, shape, dropset)
	SV *df
	IV shape
	SV *dropset
  PREINIT:
	SV *retval; HV *drop_hv; SSize_t i;
  CODE:
{
	drop_hv = (HV *)SvRV(dropset);
	if (shape == 1) { // AoH
		AV *src = (AV *)SvRV(df); SSize_t R = av_len(src) + 1;
		AV *out = newAV(); if (R > 0) av_extend(out, R - 1);
		for (i = 0; i < R; i++) {
			SV **rp = av_fetch(src, i, 0); HV *inner;
			if (rp && *rp && SvROK(*rp) && SvTYPE(SvRV(*rp)) == SVt_PVHV)
				inner = row_drop(aTHX_ (HV *)SvRV(*rp), drop_hv);
			else
				inner = row_drop(aTHX_ NULL, drop_hv);
			av_store(out, i, newRV_noinc((SV *)inner));
		}
		retval = sv_2mortal(newRV_noinc((SV *)out));
	} else { // HoH
		HV *src = (HV *)SvRV(df); HV *out = newHV();
		hv_iterinit(src); HE *he;
		while ((he = hv_iternext(src))) {
			STRLEN kl; char *kp = HePV(he, kl); I32 sk = HeUTF8(he) ? -(I32)kl : (I32)kl;
			SV *rv = HeVAL(he); HV *inner;
			if (rv && SvROK(rv) && SvTYPE(SvRV(rv)) == SVt_PVHV)
				inner = row_drop(aTHX_ (HV *)SvRV(rv), drop_hv);
			else
				inner = row_drop(aTHX_ NULL, drop_hv);
			(void)hv_store(out, kp, sk, newRV_noinc((SV *)inner), HeHASH(he));
		}
		retval = sv_2mortal(newRV_noinc((SV *)out));
	}
	RETVAL = SvREFCNT_inc(retval);
}
  OUTPUT:
	RETVAL

# shape: 1 = AoH, 2 = HoH. map: hashref old-name => new-name
SV *
_cols_rename(df, shape, map)
	SV *df
	IV shape
	SV *map
  PREINIT:
	SV *retval; HV *map_hv; SSize_t i;
  CODE:
{
	map_hv = (HV *)SvRV(map);
	if (shape == 1) { // ---- AoH ----
		AV *src = (AV *)SvRV(df); SSize_t R = av_len(src) + 1;
		AV *out = newAV(); if (R > 0) av_extend(out, R - 1);
		for (i = 0; i < R; i++) {
			SV **rp = av_fetch(src, i, 0); HV *inner;
			if (rp && *rp && SvROK(*rp) && SvTYPE(SvRV(*rp)) == SVt_PVHV)
				inner = row_rename(aTHX_ (HV *)SvRV(*rp), map_hv);
			else
				inner = row_rename(aTHX_ NULL, map_hv);
			av_store(out, i, newRV_noinc((SV *)inner));
		}
		retval = sv_2mortal(newRV_noinc((SV *)out));
	} else { // ---- HoH ----
		HV *src = (HV *)SvRV(df); HV *out = newHV();
		hv_iterinit(src); HE *he;
		while ((he = hv_iternext(src))) {
			STRLEN kl; char *kp = HePV(he, kl); I32 sk = HeUTF8(he) ? -(I32)kl : (I32)kl;
			SV *rv = HeVAL(he); HV *inner;



( run in 2.369 seconds using v1.01-cache-2.11-cpan-14f38c9f855 )