Stats-LikeR
view release on metacpan or search on metacpan
void
_interp_column_xs(vals_ref, x_ref, method, order_sv, dir, limit_sv, area_sv)
SV *vals_ref
SV *x_ref
const char *method
SV *order_sv
const char *dir
SV *limit_sv
SV *area_sv
PPCODE:
if (!(SvROK(vals_ref) && SvTYPE(SvRV(vals_ref)) == SVt_PVAV))
croak("_interp_column_xs: values must be an array reference");
if (!(SvROK(x_ref) && SvTYPE(SvRV(x_ref)) == SVt_PVAV))
croak("_interp_column_xs: x must be an array reference");
ENTER; SAVETMPS;
ip_fill_column(aTHX_ (AV *)SvRV(vals_ref), (AV *)SvRV(x_ref),
method, order_sv, dir, limit_sv, area_sv);
FREETMPS; LEAVE;
XSRETURN_EMPTY;
HV *restrict hoa = NULL, *restrict result = NULL;
HV **restrict rows = NULL;
AnTerm *terms = NULL;
AnFac *facs = NULL;
size_t nterms = 0, tcap = 0, nfac = 0, fcap = 0;
bool *restrict complete = NULL, *restrict aliased = NULL;
size_t *restrict ridx = NULL, *rank_map = NULL;
size_t n = 0, n_used = 0, p, rank;
NV **restrict X = NULL, *restrict y = NULL, rss, msres;
IV dfres;
PPCODE:
{
if (items < 2)
croak("anova: usage anova(\\%%data, 'response ~ terms' [, 'model2', ...])");
data = ST(0);
if (items > 2) {
/*nested model comparison *
anova(\%data, 'y ~ a', 'y ~ a + b', ...) -> ArrayRef table.*/
size_t nform = (size_t)items - 1;
char **restrict lhss = NULL, **rhss = NULL;
anova_free_facs(aTHX_ facs, nfac);
Safefree(rows);
safefree(lhs); safefree(rhs);
XPUSHs(sv_2mortal(newRV_noinc((SV*)result)));
}
}
void rank(...)
PROTOTYPE: @
PPCODE:
int ties = RANK_AVERAGE;
int nalast = NALAST_TRUE;
/* ---- locate trailing "key => value" options -------------
Options begin at the first plain-string arg equal to a
known option name; everything before it is data.*/
int opt_start = items;
for (int i = 0; i < items; i++) {
SV *a = ST(i);
if (SvOK(a) && !SvROK(a) && SvPOK(a)) {
CV *restrict cmp_cv = NULL;
AV *restrict src_av = NULL; // AoH / AoA input
HV *restrict src_hv = NULL; // HoA / HoH input
SSize_t n = 0;
size_t *restrict idx = NULL, *tmp = NULL;
SV **restrict rowrefs = NULL; // coderef mode: row ref per index
SV **restrict colkeys = NULL; // HoA: column key SVs
AV **restrict colavs = NULL; // HoA: column AVs
size_t ncols = 0;
SV *restrict result = NULL;
PPCODE:
{
// ---- own the usage message (variadic: xsubpp won't invent one)
if (items < 2 || items > 4)
croak("Usage: csort($df, 'column.name', 'HoA')\n"
" or csort($df, sub { $b->{'No.'} <=> $a->{'No.'} }, 'hoa')\n"
" or csort($aoa, 0, 'aoa') # array-of-arrays, integer column\n"
" (optional 4th arg names the row-name column when sorting a "
"HoH; default 'row.name')");
data = ST(0);
SvREFCNT_dec((SV*)rows_av);
SvREFCNT_dec((SV*)cols_av);
SvREFCNT_dec((SV*)seen);
RETVAL = newRV_noinc((SV*)out_hv);
}
OUTPUT:
RETVAL
void filter(...)
PPCODE:
{
if (items < 2)
croak("Usage: filter($df, $code [, 'output.type' => 'aoh'|'hoa'])");
SV *restrict df = ST(0);
SV *restrict predarg = ST(1);
const char *restrict otype = NULL;
if (items == 3) {
otype = SvPV_nolen(ST(2));
} else if (items == 4) {
const char *restrict key = SvPV_nolen(ST(2));
}
RETVAL = newRV_noinc((SV*)results);
}
OUTPUT:
RETVAL
PROTOTYPES: ENABLE
void write_table(...)
PPCODE:
{
SV *restrict data_sv = NULL;
SV *restrict file_sv = NULL;
unsigned int arg_idx = 0;
// Mimic the Perl shift logic
if (arg_idx < items && SvROK(ST(arg_idx))) {
int type = SvTYPE(SvRV(ST(arg_idx)));
if (type == SVt_PVHV || type == SVt_PVAV) {
data_sv = ST(arg_idx);
arg_idx++;
OUTPUT:
RETVAL
void shapiro_test(data)
SV *data
PREINIT:
AV *restrict av;
HV *restrict ret_hash;
size_t n_raw, n = 0;
NV *restrict x, w = 0.0, p_val = 0.0, mean = 0.0, ssq = 0.0;
PPCODE:
if (!SvROK(data) || SvTYPE(SvRV(data)) != SVt_PVAV) {
croak("Expected an array reference");
}
av = (AV *)SvRV(data);
n_raw = av_len(av) + 1;
Newx(x, n_raw, NV);
// Extract variables and calculate mean (skipping undefined/NaN values)
for (size_t i = 0; i < n_raw; i++) {
SV **restrict elem = av_fetch(av, i, 0);
if (elem && SvOK(*elem)) {
OUTPUT:
RETVAL
void mode(...)
PROTOTYPE: @
PREINIT:
HV *restrict counts;
HV *restrict originals;
size_t max_count = 0, arg_count = 0;
HE *restrict he;
PPCODE:
//counts: string(value) -> occurrence count
//originals: string(value) -> SV* first-seen original
counts = (HV *)sv_2mortal((SV *)newHV());
originals = (HV *)sv_2mortal((SV *)newHV());
for (size_t i = 0; i < items; i++) {
SV *restrict arg = ST(i);
if (SvROK(arg) && SvTYPE(SvRV(arg)) == SVt_PVAV) {
AV *restrict av = (AV *)SvRV(arg);
OUTPUT:
RETVAL
void uniq(...)
PROTOTYPE: @
PREINIT:
HV*restrict seen;
AV*restrict out;
size_t n, k;
int gimme;
PPCODE:
n = 0;
gimme = GIMME_V;
seen = (HV*)sv_2mortal((SV*)newHV());
out = (AV*)sv_2mortal((SV*)newAV());
for (size_t i = 0; i < items; i++) {
SV* restrict arg = ST(i);
if (SvROK(arg) && SvTYPE(SvRV(arg)) == SVt_PVAV) {
AV* restrict av = (AV*)SvRV(arg);
size_t len = av_len(av) + 1;
for (size_t j = 0; j < len; j++) {
hv_store(results, "statistic", 9, newSVnv(t_stat), 0);
hv_store(results, "df", 2, newSVnv(df), 0);
hv_store(results, "p_value", 7, newSVnv(p_val), 0);
hv_store(results, "conf_int", 8, newRV_noinc((SV*)conf_int), 0);
RETVAL = newRV_noinc((SV*)results);
}
OUTPUT:
RETVAL
void prop_test(...)
PPCODE:
{
/*Test of equality of proportions / a single proportion against a target.
Faithful port of R's stats::prop.test (Pearson chi-square on the 2xk
table of successes/failures, Yates correction for k<=2, Wilson score CI
for one proportion and a Wald CI for a difference of two).*/
if (items < 2)
croak("Usage: prop_test(\\@successes, \\@trials, p => ..., "
"alternative => 'two.sided', conf.level => 0.95, correct => 1)\n"
" or prop_test($x, $n, ...) for a single sample");
const char *restrict alt = "two.sided";
if (have_ci) {
AV *restrict ci = newAV(); av_push(ci, newSVnv(ci_lo)); av_push(ci, newSVnv(ci_hi));
hv_stores(ret, "conf.int", newRV_noinc((SV*)ci));
}
Safefree(x); Safefree(nn); Safefree(pnull); Safefree(est);
ST(0) = sv_2mortal(newRV_noinc((SV *)ret));
XSRETURN(1);
}
void mcnemar_test(...)
PPCODE:
{
/*McNemar's test for paired categorical data. Faithful port of R's
stats::mcnemar.test (chi-square on the off-diagonal disagreement,
with Yates continuity correction for a 2x2 table). An `exact => 1`
option gives the two-sided exact binomial test for a 2x2 table.*/
if (items < 1)
croak("Usage: mcnemar_test([[a,b],[c,d]], correct => 1, exact => 0)\n"
" or mcnemar_test(\\@x, \\@y, ...) # paired observations");
int correct = 1, exact = 0, opt_start;
size_t r = 0;
hv_stores(ret, "method", newSVpv(use_cc ?
"McNemar's Chi-squared test with continuity correction" :
"McNemar's Chi-squared test", 0));
}
Safefree(tab);
ST(0) = sv_2mortal(newRV_noinc((SV *)ret));
XSRETURN(1);
}
void dunn_test(...)
PPCODE:
{
/*Dunn's (1964) post-hoc test following a Kruskal-Wallis test: pairwise
rank-mean comparisons using the shared ranking and tie correction, with
a family-wise / FDR adjustment. Two-sided p-values (as in FSA::dunnTest).
Validated against the canonical formula implemented in base R.*/
if (items < 2 || !SvROK(ST(0)) || !SvROK(ST(1))
|| SvTYPE(SvRV(ST(0))) != SVt_PVAV || SvTYPE(SvRV(ST(1))) != SVt_PVAV)
croak("Usage: dunn_test(\\@values, \\@groups, method => 'holm')");
const char *restrict method = "holm";
for (int i = 2; i + 1 < items; i += 2) {
for (size_t i = 0; i < N; i++) Safefree(glab[i]);
for (size_t j = 0; j < k; j++) Safefree(lev[j]);
Safefree(x); Safefree(glab); Safefree(lev); Safefree(r);
Safefree(rsum); Safefree(ns); Safefree(z); Safefree(praw); Safefree(padj);
Safefree(gi_); Safefree(gj_);
ST(0) = sv_2mortal(newRV_noinc((SV*)out));
XSRETURN(1);
}
void friedman_test(...)
PPCODE:
{
/*Friedman rank-sum test for an unreplicated complete block design.
Input is a matrix (array of array refs) with one block/subject per row
and one treatment/condition per column. Faithful port of R's
stats::friedman.test, including the tie correction.*/
if (items < 1 || !SvROK(ST(0)) || SvTYPE(SvRV(ST(0))) != SVt_PVAV)
croak("Usage: friedman_test([[..row1..],[..row2..], ...]) # rows = blocks, cols = treatments");
AV *restrict m = (AV*)SvRV(ST(0));
size_t nrow_raw = (size_t)(av_len(m) + 1);
if (nrow_raw < 2) croak("friedman_test: need at least two blocks (rows)");
hv_stores(ret, "statistic", newSVnv(stat));
hv_stores(ret, "parameter", newSViv(df));
hv_stores(ret, "p_value", newSVnv(p_value));
hv_stores(ret, "n", newSViv((int)n));
hv_stores(ret, "method", newSVpv("Friedman rank sum test", 0));
ST(0) = sv_2mortal(newRV_noinc((SV *)ret));
XSRETURN(1);
}
void epi_2x2(...)
PPCODE:
{
NV a, b, c, d, conf_level = 0.95;
int correct = 0, opt_start;
if (items < 1)
croak("Usage: epi_2x2(a, b, c, d, conf_level => 0.95, correct => 0)\n"
" or epi_2x2([[a,b],[c,d]], ...) # rows=exposure, cols=outcome");
if (SvROK(ST(0))) {
epi_read_2x2(aTHX_ ST(0), "epi_2x2", &a, &b, &c, &d);
opt_start = 1;
} else {
hv_stores(ret, name, newRV_noinc((SV *)ci)); } while (0)
EPI_CI("odds_ratio_ci", or_lo, or_hi);
EPI_CI("risk_ratio_ci", rr_lo, rr_hi);
EPI_CI("risk_diff_ci", rd_lo, rd_hi);
#undef EPI_CI
ST(0) = sv_2mortal(newRV_noinc((SV *)ret));
XSRETURN(1);
}
void cmh_test(...)
PPCODE:
{
if (items < 1 || !SvROK(ST(0)) || SvTYPE(SvRV(ST(0))) != SVt_PVAV)
croak("Usage: cmh_test([ [a,b,c,d], [a,b,c,d], ... ], "
"conf_level => 0.95, correct => 1)");
AV *restrict strata = (AV *)SvRV(ST(0));
SSize_t K = av_len(strata) + 1;
if (K < 1) croak("cmh_test: need at least one 2x2 stratum");
NV conf_level = 0.95; int correct = 1;
for (int i = 1; i + 1 < items; i += 2) {
const char *k = SvPV_nolen(ST(i)); SV *v = ST(i + 1);
roc_split(aTHX_ sav, lav, positive, lower_pos, &pos, &m, &neg, &n, "auroc");
NV a, se; roc_delong(aTHX_ pos, m, neg, n, &a, &se);
Safefree(pos); Safefree(neg);
RETVAL = a;
}
}
OUTPUT:
RETVAL
void roc(...)
PPCODE:
{
if (items < 2 || !SvROK(ST(0)) || SvTYPE(SvRV(ST(0))) != SVt_PVAV
|| !SvROK(ST(1)) || SvTYPE(SvRV(ST(1))) != SVt_PVAV)
croak("Usage: roc(\\@scores, \\@labels, positive => 1, "
"conf_level => 0.95, direction => '>')");
const char *restrict positive = "1"; NV conf_level = 0.95; int lower_pos = 0;
for (int i = 2; i + 1 < items; i += 2) {
const char *restrict k = SvPV_nolen(ST(i)); SV *restrict v = ST(i + 1);
if (strEQ(k, "positive")) positive = SvPV_nolen(v);
else if (strEQ(k, "conf_level") || strEQ(k, "conf.level")) conf_level = SvNV(v);
hv_stores(ret, "n", newSViv((IV)N));
hv_stores(ret, "direction", newSVpv(lower_pos ? "<" : ">", 1));
hv_stores(ret, "youden", newRV_noinc((SV *)youden));
hv_stores(ret, "curve", newRV_noinc((SV *)curve));
hv_stores(ret, "method", newSVpv("ROC curve with DeLong AUC", 0));
ST(0) = sv_2mortal(newRV_noinc((SV *)ret));
XSRETURN(1);
}
void bedroc(...)
PPCODE:
{
/*Boltzmann-Enhanced Discrimination of ROC (Truchon & Bayly 2007, eq. 36).
Rewards early recognition: actives ranked near the top count far more
than actives buried deep in the list. alpha sets how sharply the weight
decays with rank; ties get the average (mid)rank.*/
if (items == 1 && !SvROK(ST(0))) { //bedroc('h'|'H'|'?') => help
const char *restrict h = SvPV_nolen(ST(0));
if (strEQ(h, "h") || strEQ(h, "H") || strEQ(h, "?")) {
GV *ogv = gv_fetchpvs("STDOUT", 0, SVt_PVIO);
PerlIO *pio = (ogv && GvIO(ogv) && IoOFP(GvIO(ogv)))
newSVnv((expected > 0.0) ? ((NV)hits / (NV)n_top) / ra : NAN));
hv_stores(ret, "enrichment", newRV_noinc((SV *)enr));
}
Safefree(pts);
ST(0) = sv_2mortal(newRV_noinc((SV *)ret));
XSRETURN(1);
}
void survfit(...)
PPCODE:
{
if (items < 2 || !SvROK(ST(0)) || SvTYPE(SvRV(ST(0))) != SVt_PVAV
|| !SvROK(ST(1)) || SvTYPE(SvRV(ST(1))) != SVt_PVAV)
croak("Usage: survfit(\\@time, \\@status, group => \\@grp, conf_level => 0.95)");
AV *restrict gav = NULL; NV conf_level = 0.95;
for (int i = 2; i + 1 < items; i += 2) {
const char *restrict k = SvPV_nolen(ST(i)); SV *v = ST(i + 1);
if (strEQ(k, "group")) {
if (!SvROK(v) || SvTYPE(SvRV(v)) != SVt_PVAV) croak("survfit: group must be an array ref");
gav = (AV *)SvRV(v);
HV *ret = newHV();
hv_stores(ret, "strata", newRV_noinc((SV *)strata));
hv_stores(ret, "groups", newRV_inc((SV *)labels));
hv_stores(ret, "conf_level", newSVnv(conf_level));
hv_stores(ret, "method", newSVpv("Kaplan-Meier survival estimate", 0));
ST(0) = sv_2mortal(newRV_noinc((SV *)ret));
XSRETURN(1);
}
void logrank_test(...)
PPCODE:
{
if (items < 3 || !SvROK(ST(0)) || SvTYPE(SvRV(ST(0))) != SVt_PVAV
|| !SvROK(ST(1)) || SvTYPE(SvRV(ST(1))) != SVt_PVAV
|| !SvROK(ST(2)) || SvTYPE(SvRV(ST(2))) != SVt_PVAV)
croak("Usage: logrank_test(\\@time, \\@status, \\@group)");
AV *restrict labels = (AV *)sv_2mortal((SV *)newAV());
size_t N; SurvObs *o = srv_read(aTHX_ (AV *)SvRV(ST(0)), (AV *)SvRV(ST(1)),
(AV *)SvRV(ST(2)), &N, labels, "logrank_test");
SSize_t G = av_len(labels) + 1;
if (G < 2) { Safefree(o); croak("logrank_test: need at least two groups"); }
hv_stores(ret, "groups", newRV_inc((SV *)labels));
hv_stores(ret, "method", newSVpv("Log-rank (Mantel-Cox) test", 0));
Safefree(o); Safefree(O); Safefree(E); Safefree(V); Safefree(nrisk);
Safefree(Vr); Safefree(OE); Safefree(xsol);
ST(0) = sv_2mortal(newRV_noinc((SV *)ret));
XSRETURN(1);
}
void coxph(...)
PPCODE:
{
if (items < 3 || !SvROK(ST(0)) || SvTYPE(SvRV(ST(0))) != SVt_PVAV
|| !SvROK(ST(1)) || SvTYPE(SvRV(ST(1))) != SVt_PVAV
|| !SvROK(ST(2)) || SvTYPE(SvRV(ST(2))) != SVt_PVAV)
croak("Usage: coxph(\\@time, \\@status, \\@covariate | [\\@x1, \\@x2, ...], "
"conf_level => 0.95, ties => 'efron', names => [...])");
AV *restrict tav = (AV *)SvRV(ST(0)), *sav = (AV *)SvRV(ST(1)), *Xav = (AV *)SvRV(ST(2));
SSize_t n = av_len(tav) + 1;
if (n < 2) croak("coxph: need at least two observations");
if (av_len(sav) + 1 != n) croak("coxph: time and status must be the same length");
Safefree(X); Safefree(tm); Safefree(st); Safefree(ord);
Safefree(beta); Safefree(U); Safefree(Imat); Safefree(Iinv); Safefree(ratio);
Safefree(S1); Safefree(S2); Safefree(SD1); Safefree(SD2); Safefree(sumX_D);
Safefree(eta); Safefree(w);
ST(0) = sv_2mortal(newRV_noinc((SV *)ret));
XSRETURN(1);
}
void p_adjust(...)
PROTOTYPE: $;@
PPCODE:
if (items < 1)
croak("Usage: p_adjust($p_values, $method, columns => ...)");
SV *restrict p_sv = ST(0);
const char *restrict method = "holm";
SV *restrict cols_sv = NULL;
IV first_pair = 1;
/*The method may still arrive positionally, the way it always has;
anything after it (or after the frame) is key => value.*/
if (items > 1 && ((items - 1) % 2) == 1) {
if (!SvOK(ST(1)) || SvROK(ST(1)))
for (size_t i = 1; i < up; i++) if (nums[i] > lower) lower = nums[i];
median_val = (lower + nums[up]) / 2.0;
}
if (nums != stackbuf) Safefree(nums);
RETVAL = median_val;
OUTPUT:
RETVAL
void intersection(...)
PROTOTYPE: @
PPCODE:
if (items == 0)
croak("intersection needs >= 1 array ref");
SP = set_multiplicity(aTHX_ SP, &ST(0), (size_t)items, 1, 0,
"intersection", GIMME_V);
SV* cor(SV* x_sv, SV* y_sv = &PL_sv_undef, const char* method = "pearson")
INIT:
// --- validate method
if (strcmp(method, "pearson") != 0 &&
strcmp(method, "spearman") != 0 &&
for (size_t j = 0; j < ncols_y; j++) Safefree(col_y[j]);
Safefree(col_y);
}
RETVAL = newRV_noinc((SV*)result_av);
}
OUTPUT:
RETVAL
void scale(...)
PROTOTYPE: @
PPCODE:
{
bool do_center_mean = TRUE, do_scale_sd = TRUE;
NV center_val = 0.0, scale_val = 1.0;
size_t data_items = items;
// 1. Parse Options Hash (if it exists as the last argument)
if (items > 0) {
SV*restrict last_arg = ST(items - 1);
if (SvROK(last_arg) && SvTYPE(SvRV(last_arg)) == SVt_PVHV) {
data_items = items - 1; // Exclude hash from data processing
HV*restrict opt_hv = (HV*)SvRV(last_arg);
RETVAL = newRV_noinc((SV*)res_hv);
}
OUTPUT:
RETVAL
void seq(from, to, by = 1.0)
NV from
NV to
NV by
PPCODE:
{
if (by == 0.0) {//Handle the zero 'by' case
if (from == to) {
EXTEND(SP, 1);
mPUSHn(from);
XSRETURN(1);
} else {
croak("invalid 'by' argument: cannot be zero when from != to");
}
}
// x is a single numeric scalar
NV x_val = SvNV(x_sv);
NV res = c_dnorm(x_val, mean, sd, give_log);
RETVAL = newSVnv(res);
}
}
OUTPUT:
RETVAL
void merge(...)
PPCODE:
{
if (items < 2)
croak("Usage: merge($left, $right, how => 'inner'|'left'|'right'|"
"'outer'|'cross', on => 'col' | ['c1','c2'] "
"[, 'left.on' => .., 'right.on' => ..] "
"[, suffixes => ['.x','.y']] [, 'output.type' => 'aoh'|'hoa'])");
if ((items - 2) & 1)
croak("merge: options after the two frames must be name => value pairs");
SV *restrict left = ST(0);
SV *data
SV *colname_sv
PREINIT:
bool is_aoh = 0, is_hoh = 0;
const char *restrict colname = NULL;
STRLEN collen = 0;
AV *restrict src_av = NULL;
HV *restrict src_hv = NULL;
SSize_t n = 0;
AV *restrict out_av = NULL;
PPCODE:
{
if (!SvOK(colname_sv))
croak("vals: column name must be defined");
colname = SvPV(colname_sv, collen); //kept for the error message
if (!SvROK(data))
croak("vals: first argument must be an array-ref (AoH) or hash-ref (HoA, HoH)");
//---- classify $data: AoH (arrayref) vs HoA/HoH (hashref) --------
if (SvTYPE(SvRV(data)) == SVt_PVAV) {
is_aoh = 1;
src_av = (AV *)SvRV(data);
AV *data_av;
AV *probs_av;
AV *edge_av;
AV *code_av = NULL;
SV **el;
IV n, m, i, j, ne, w;
NV *srt = NULL;
NV *edges = NULL;
NV p, h, frac, v;
IV lo, bin, lo2, hi2, mid, k;
PPCODE:
if (!SvROK(data_ref) || SvTYPE(SvRV(data_ref)) != SVt_PVAV)
croak("_qcut_core: data must be an ARRAY reference");
if (!SvROK(probs_ref) || SvTYPE(SvRV(probs_ref)) != SVt_PVAV)
croak("_qcut_core: probs must be an ARRAY reference");
data_av = (AV *) SvRV(data_ref);
probs_av = (AV *) SvRV(probs_ref);
n = av_len(data_av) + 1;
m = av_len(probs_av) + 1;
if (n < 1)
PUSHs(sv_2mortal(newRV_noinc((SV *) edge_av)));
void get_union(...)
PROTOTYPE: @
PREINIT:
HV*restrict seen;
AV*restrict order;
size_t nrefs, n, oi, olen;
int gimme;
PPCODE:
gimme = GIMME_V;
nrefs = items;
if (nrefs == 0)
croak("union needs >= 1 array ref");
seen = (HV*)sv_2mortal((SV*)newHV());
order = (AV*)sv_2mortal((SV*)newAV()); //buffer: pushing to the stack while still reading ST() would clobber the args
n = 0;
for (size_t i = 0; i < nrefs; i++) {
SV*restrict arg = ST(i);
AV*restrict av;
olen = (size_t)(av_len(order) + 1);
for (oi = 0; oi < olen; oi++) {
SV**restrict e = av_fetch(order, oi, 0);
if (e && *e)
XPUSHs(sv_2mortal(newSVsv(*e)));
}
}
void Lonly(...)
PROTOTYPE: @
PPCODE:
if (items == 0)
croak("Lonly needs >= 1 array ref");
SP = set_multiplicity(aTHX_ SP, &ST(0), (size_t)items, 0, 0,
"Lonly", GIMME_V);
void Ronly(...)
PROTOTYPE: @
PPCODE:
if (items == 0)
croak("Ronly needs >= 1 array ref");
/*mirror of Lonly: values only in the LAST array (from_last = 1), so
the two-array Ronly(a,b) still equals Lonly(b,a).*/
SP = set_multiplicity(aTHX_ SP, &ST(0), (size_t)items, 0, 1,
"Ronly", GIMME_V);
void is_equivalent(...)
PROTOTYPE: @
PPCODE:
if (items < 2)
croak("is_equivalent needs >= 2 array refs (got %" UVuf ")", (UV)items);
XPUSHs(sv_2mortal(newSViv(set_equivalent(aTHX_ &ST(0), (size_t)items, "is_equivalent"))));
SV* pnorm(...)
CODE:
{
if (items < 1)
croak("Usage: pnorm(x), pnorm(x, mean => 0, sd => 1, lower => 1, log => 0)");
SV *restrict x_sv = ST(0);
( run in 0.578 second using v1.01-cache-2.11-cpan-4e7a2411597 )