#ifndef _GNU_SOURCE
#define _GNU_SOURCE // glibc / Linux
#endif
#ifndef __EXTENSIONS__
#define __EXTENSIONS__ 1 // Solaris/illumos: expose off64_t, sigjmp_buf under -std=c99
#endif
#define PERL_NO_GET_CONTEXT
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "ppport.h"
#include <math.h>
#include <ctype.h>
#include <stdlib.h>
#include <float.h>
#include <string.h>
#include <stdint.h> // uint64_t — harmless if perl.h already pulled it in
/*`restrict` is spelled bare, which is C99 syntax.

It is carried only where it can change the code the compiler emits: a loop
that stores through one pointer while loading through another, which is the
only thing the qualifier buys. perl is built with -fno-strict-aliasing, so
inside such a loop `restrict` is the *only* disambiguation available -- even
between an NV array and a size_t one, where the type rule would otherwise have
settled it -- and dropping it costs a reload of the other array every
iteration. Where there is nothing to disambiguate the annotation is left off:
a pointer whose every access is a perl API call (which clobbers memory
anyway), a read-only pointer in a function that stores through nothing, a
scalar out-parameter written once, an in-place sort with a single array, a
pointer that Renew() re-points, and a struct member, which neither gcc nor
clang exploits.

Makefile.PL probes for a C99 flag but cannot always find one, so on some
compilers the keyword may not be recognised at all: MSVC accepts it only under
/std:c11 or later and otherwise spells the same guarantee __restrict, older gcc
spells it __restrict__, and a strict C89 compiler has no equivalent. Map it
where a spelling exists and define it away where none does. This has to sit
below every #include above, so that it cannot rewrite a parameter named
`restrict` inside a system header.*/
#if !defined(__cplusplus) && !defined(restrict)
#  if defined(_MSC_VER)
#    define restrict __restrict
#  elif !defined(__STDC_VERSION__) || __STDC_VERSION__ < 199901L
#    if defined(__GNUC__)
#      define restrict __restrict__
#    else
#      define restrict /*no spelling available; annotation only*/
#    endif
#  endif
#endif
/*Width-correct libm for NV.

C has no type-generic <math.h>: sqrt(), log(), lgamma() and the rest are
declared to take a double, so calling them with an NV on a long-double or
__float128 build converts the argument down to double, computes at double
precision and converts back. Nothing warns, nothing fails to compile, and the
result looks entirely plausible -- it is simply carrying 53 bits of mantissa on
a perl built for 64 or 113. Measured on perl-5.12.5 (long double) before this
layer existed, sd(1..5) came back as exactly the double-rounded sqrt(2.5),
9.5e-17 away from the long-double value perl's own sqrt() gives.

So every NV-valued libm call in this file goes through the nv_* macros below,
which paste on the suffix for the width NV actually is: none for double, `l`
for long double, `q` for __float128 (perl.h has already included <quadmath.h>
by this point, and the quadmath perl's $Config{perllibs} already carries
-lquadmath, so the q functions need nothing extra at link time).

The long-double row is conditional because the `l` variants are C99 but not
universally present -- some BSD libms are thin on them. Makefile.PL link-tests
the whole set and defines LIKER_HAVE_LONG_DOUBLE_MATH only when every one of
them resolves; without it this falls back to the double functions, which is
exactly what the code did before and so cannot be a regression.

Float classification -- NaN, infinite, finite -- is nv_isnan()/nv_isinf()/
nv_isfinite() below, and neither the C99 macros nor perl's Perl_isnan /
Perl_isinf / Perl_isfinite may be used in this file. See the comment on
those three.*/
#if defined(USE_QUADMATH)
#  define LIKER_NVFN(base) base ## q
#elif defined(USE_LONG_DOUBLE) && defined(LIKER_HAVE_LONG_DOUBLE_MATH)
#  define LIKER_NVFN(base) base ## l
#else
#  define LIKER_NVFN(base) base
#endif
#define nv_fabs(x)     LIKER_NVFN(fabs)(x)
#define nv_sqrt(x)     LIKER_NVFN(sqrt)(x)
#define nv_log(x)      LIKER_NVFN(log)(x)
#define nv_log1p(x)    LIKER_NVFN(log1p)(x)
#define nv_log2(x)     LIKER_NVFN(log2)(x)
#define nv_log10(x)    LIKER_NVFN(log10)(x)
#define nv_exp(x)      LIKER_NVFN(exp)(x)
#define nv_pow(x,y)    LIKER_NVFN(pow)((x),(y))
#define nv_floor(x)    LIKER_NVFN(floor)(x)
#define nv_ceil(x)     LIKER_NVFN(ceil)(x)
#define nv_round(x)    LIKER_NVFN(round)(x)
#define nv_rint(x)     LIKER_NVFN(rint)(x)
#define nv_trunc(x)    LIKER_NVFN(trunc)(x)
#define nv_fmax(x,y)   LIKER_NVFN(fmax)((x),(y))
#define nv_lgamma(x)   LIKER_NVFN(lgamma)(x)
#define nv_erfc(x)     LIKER_NVFN(erfc)(x)
#define nv_asin(x)     LIKER_NVFN(asin)(x)
#define nv_acos(x)     LIKER_NVFN(acos)(x)
#define nv_cos(x)      LIKER_NVFN(cos)(x)
#define nv_sin(x)      LIKER_NVFN(sin)(x)
#define nv_sinh(x)     LIKER_NVFN(sinh)(x)
#define nv_cosh(x)     LIKER_NVFN(cosh)(x)
#define nv_tanh(x)     LIKER_NVFN(tanh)(x)
#define nv_ldexp(x,e)  LIKER_NVFN(ldexp)((x),(e))
#define nv_frexp(x,e)  LIKER_NVFN(frexp)((x),(e))
/*0.95 -- the default conf.level everywhere in this file -- at the build's own
NV width.

`NV conf_level = 0.95;` does not do that. 0.95 is a C literal of type double,
so what lands in the NV is 0.95 rounded to 53 bits, and on a long-double build
that is 2.2e-17 away from the NV nearest 0.95. Small until it reaches a
quantile: p = 1 - (1 - conf_level)/2 inherits the whole 2.2e-17, the normal
density at the 95% point is 0.0584, so the critical value moves 3.8e-16 --
about 1700 ulp of a long double, and the measured gap between glm's interval
and one built by hand from qnorm(0.975) before this macro existed. `0.95L` has
the mirror problem on a quadmath build, and either way the default no longer
stringifies back to "0.95" when a result echoes it.

Perl's own number parser gets the same NV the perl expression 0.95 would, at
every width, which is also what makes the echoed default round-trip.
fisher_test and binom_test have done this since 0.29x; the macro is so the
other eleven call sites can say it in one token rather than eleven copies of
the rationale. Costs one mortal SV per call, not per row.*/
#define NV_CONF_95     SvNV(sv_2mortal(newSVpvs("0.95")))
/*Float classification for an NV: NaN, infinite, finite. Every obvious spelling
of these is wrong here.

C99's isnan()/isinf()/isfinite() are type-generic macros, but where a platform
does not provide them they are plain double functions: narrowing a
large-but-finite long double into one of those reports it as infinite rather
than merely rounding it. That is the trap described above, with a worse failure
mode than losing mantissa bits.

perl's Perl_isnan / Perl_isinf / Perl_isfinite were what this file used
through 0.298, and they are unusable for a different reason -- on any perl
before 5.22 the fpclass() route through perl.h has never compiled at all.
Configure defines HAS_FPCLASS on illumos/Solaris, and perl.h there writes

    #define Perl_fp_class()      fpclass(x)                 <- no parameter
    #define Perl_fp_class_inf(x) (Perl_fp_class(x)==FP_CLASS_NINF||...)

so any use of Perl_isinf is a "macro passed 1 arguments, but takes just 0"
error, and FP_CLASS_NINF/FP_CLASS_PINF are names no <ieeefp.h> defines: Solaris
spells those FP_NINF and FP_PINF. That is what broke 0.298 on OmniOS (CPAN
Testers, perl-5.20.2, gcc 9.3), and nothing here can catch it, because the
whole block is dead code on Linux and glibc, where Configure finds isinf().
perl 5.22 rewrote it; 5.10.1 and 5.12.5 still carry it verbatim, and this
module supports 5.10. Those same perls also define Perl_isinf as ((x)==NV_INF),
which misses -Inf, and Perl_isfinite as finite((NV)x), where the prototype
undoes the cast.

So classify by comparison instead. NV_MAX is the largest finite NV -- DBL_MAX,
LDBL_MAX or FLT128_MAX, straight out of <float.h> -- so a non-NaN NV is
infinite exactly when it falls outside [-NV_MAX, NV_MAX]. These call no libm
and need no header perl.h has not already included, they are exact at every NV
width so there is nothing left to narrow, and taking the value through an NV
parameter is also what discards any x87 excess precision that a bare macro
would leave in play.

What they do rely on is IEEE comparison semantics: a NaN compares false against
everything including itself. That holds by default on every compiler this
module targets, and is only lost under a -ffast-math-style flag, which no perl
is built with.*/
PERL_STATIC_INLINE bool nv_isnan(NV x)    { return (bool)(x != x); }
PERL_STATIC_INLINE bool nv_isinf(NV x)    { return (bool)(x > NV_MAX || x < -NV_MAX); }
PERL_STATIC_INLINE bool nv_isfinite(NV x) { return (bool)(x >= -NV_MAX && x <= NV_MAX); }
/*Stack_off_t is the type XSUB.h's dITEMS gives `items`, and so the type every
argument-stack index here is compared against. It arrived in perl 5.39.2, which
introduced it precisely so the stack offset could widen to SSize_t on a build
configured for it; before that the offset was always I32. perl.h defines
PERL_STACK_OFFSET_DEFINED next to the typedef, so that is what to test -- on
5.10.1 and 5.12.5 neither the macro nor the type exists. Spelling the indices
Stack_off_t rather than I32 is what keeps them correct if a future perl does
widen it.*/
#ifndef PERL_STACK_OFFSET_DEFINED
typedef I32 Stack_off_t;
#  define Stack_off_t_MAX I32_MAX
#  define PERL_STACK_OFFSET_DEFINED
#endif
/*croak() with an NV argument: croak() carries a printf format attribute, but
the compiler's format checker doesn't know the "Q" length modifier that NVgf
expands to on a quadmath build, so every NV-bearing croak() draws a bogus
-Wformat / -Wformat-extra-args pair there (harmless, but it buries the real
warnings). The format is read by Perl's own formatter, not the C library, and
that handles NVgf on every build, so route those messages through vcroak(),
which has no format attribute. -Wformat stays useful everywhere else.*/
static void croak_nv(const char *pat, ...) __attribute__noreturn__;
static void croak_nv(const char *pat, ...)
{
	dTHX;
	va_list args;
	va_start(args, pat);
	vcroak(pat, &args); // noreturn; no va_end needed
}
/*Format a single NV with my_snprintf(). my_snprintf() carries a format
attribute of its own, so an NVgf format written at the call site draws the same
bogus warning pair described above; taking the format as an ordinary argument
keeps the checker out of it. my_snprintf() is the portable spelling here --
plain snprintf() cannot print an NV on a quadmath build.*/
static int snprintf_nv(char *buf, Size_t buflen, const char *fmt, NV x)
{
	return my_snprintf(buf, buflen, fmt, x);
}
/*Compare a NUL-terminated string against a lowercase ASCII literal, ignoring
case. strcasecmp() would do this, but it is declared in <strings.h>, which is
POSIX-only -- MSVC ships neither the header nor the function, so a build there
fails at the #include before it ever reaches the call. Folding by hand also
drops the locale dependency, which is what option parsing wants: these keywords
are ASCII, and no locale should get to decide whether "TRUE" matches "true"
(tolower() under tr_TR maps `I` outside ASCII). `lit` must be lowercase.*/
static bool str_ieq_ascii(const char *s, const char *lit)
{
	for (; *s != '\0' && *lit != '\0'; s++, lit++) {
		char c = *s;
		if (c >= 'A' && c <= 'Z') c += 'a' - 'A';
		if (c != *lit) return FALSE;
	}
	return *s == *lit; // equal length: both landed on the NUL together
}
/*Keep a column scan out of line.

Each av_scan_* helper below is paired at its call site with a slower av_fetch()
loop that finishes whatever the scan would not take. Inlined, the two loops
share a stack frame: the accumulators have to stay addressable across the
av_fetch() call in the second loop, so the first loop spills them to memory
every iteration instead of keeping them in registers, and the scan loses most
of its advantage. Summing 1e6 NVs on perl-5.44.0 at -O2: 2.77 ns/element for
the av_fetch() loop these replace, 2.25 with the scan inlined into it, 1.29
with the scan compiled on its own. The one call per XSUB invocation that costs
is not measurable.

There is no portable spelling, so annotate where the compiler has one and
leave it empty where it does not -- an empty definition gives back the inlined
speed and never a wrong answer.*/
#if defined(__GNUC__) || defined(__clang__)
#  define LIKER_NOINLINE __attribute__((noinline))
#elif defined(_MSC_VER)
#  define LIKER_NOINLINE __declspec(noinline)
#else
#  define LIKER_NOINLINE
#endif
/*Numeric value of one array element, but only when reading it cannot run perl.

The reduction loops in this file used to call av_fetch() once per element. That
call is out of line and repeats a bounds check, a negative-index fixup and a
magic dispatch that a straight walk of AvARRAY() already knows the answers to,
and on a million-element column it was about half of what sum() or cor() cost.

Walking the block directly is only sound while nothing can move it, and SvNV()
can move it. On an SV carrying get magic SvNV() runs mg_get(); on a reference it
may run an overloaded 0+; on a string that is not a number it raises "isn't
numeric", which a $SIG{__WARN__} handler catches. Each of those is perl code,
and perl code may push to the very array being walked -- which reallocs
AvARRAY() and leaves the walk holding a freed block.

So the fast path is taken only for an SV that already holds a number and
carries neither magic nor a reference; SvNV() on one of those is a register
read that calls nothing. Everything else returns FALSE, and the caller re-reads
that element through av_fetch(), which is both correct and where the block
pointer gets re-derived.

The value returned is the one SvNV() would give: NOK wins over IOK, and an IV
stored as unsigned is read back unsigned. SvOK() is not tested because
SVf_IOK|SVf_NOK is a subset of SVf_OK -- an SV with either flag is defined.*/
PERL_STATIC_INLINE bool sv_plain_nv(SV *sv, NV *out)
{
	const U32 f = SvFLAGS(sv);
	if ((f & (SVs_GMG | SVf_ROK)) || !(f & (SVf_IOK | SVf_NOK))) return FALSE;
	*out = (f & SVf_NOK)    ? SvNVX(sv)
	     : (f & SVf_IVisUV) ? (NV)SvUVX(sv)
	                        : (NV)SvIVX(sv);
	return TRUE;
}
/*Running count, total and range of a numeric column, for the scans below.*/
typedef struct {
	NV sum;       // total of every value folded in so far
	NV min;       // both undefined while count == 0
	NV max;
	size_t count;
} NvAcc;
/*The four scans share a contract. Each folds the run of plain numeric scalars
starting at av[*jp] into its accumulators, stops at the first element
sv_plain_nv() will not take (a hole, a reference, anything magical or
non-numeric) and leaves *jp on that element, so the caller finishes from there
with av_fetch(). A caller that reaches *jp == len had a wholly plain column and
never enters its fallback loop.

None of them may be called on an RMAGICAL av: a tied array's elements do not
exist until FETCH has run, and AvARRAY() on one reads the wrong block
entirely. Every caller tests SvRMAGICAL() first and skips the scan.*/
static LIKER_NOINLINE void av_scan_sum(AV *av, SSize_t *jp, SSize_t len,
	NvAcc *acc)
{
	SV **el = AvARRAY(av);
	NV sum = acc->sum;
	size_t count = acc->count;
	SSize_t j = *jp;
	for (; j < len; j++) {
		NV v;
		if (!el[j] || !sv_plain_nv(el[j], &v)) break;
		sum += v;
		count++;
	}
	acc->sum = sum;
	acc->count = count;
	*jp = j;
}
/*As av_scan_sum(), tracking one end of the range instead of the total. min()
and max() are separate XSUBs, so each gets its own scan rather than a shared
one computing both: the running extreme is a loop-carried dependency (each
compare-and-move waits on the previous element's result), so tracking the end
the caller will not return costs a second chain for nothing -- 1.79 ms against
1.35 ms on 1e6 NVs, where sum() over the same column is 1.35.

The first value seeds the extreme, which is what keeps the "have I seen one
yet" test out of the loop body.*/
static LIKER_NOINLINE void av_scan_min(AV *av, SSize_t *jp, SSize_t len,
	NvAcc *acc)
{
	SV **el = AvARRAY(av);
	NV mn = acc->min;
	size_t count = acc->count;
	SSize_t j = *jp;
	if (count == 0 && j < len) {
		NV v;
		if (!el[j] || !sv_plain_nv(el[j], &v)) { *jp = j; return; }
		mn = v;
		count = 1;
		j++;
	}
	for (; j < len; j++) {
		NV v;
		if (!el[j] || !sv_plain_nv(el[j], &v)) break;
		if (v < mn) mn = v;
		count++;
	}
	acc->min = mn;
	acc->count = count;
	*jp = j;
}

static LIKER_NOINLINE void av_scan_max(AV *av, SSize_t *jp, SSize_t len,
	NvAcc *acc)
{
	SV **el = AvARRAY(av);
	NV mx = acc->max;
	size_t count = acc->count;
	SSize_t j = *jp;
	if (count == 0 && j < len) {
		NV v;
		if (!el[j] || !sv_plain_nv(el[j], &v)) { *jp = j; return; }
		mx = v;
		count = 1;
		j++;
	}
	for (; j < len; j++) {
		NV v;
		if (!el[j] || !sv_plain_nv(el[j], &v)) break;
		if (v > mx) mx = v;
		count++;
	}
	acc->max = mx;
	acc->count = count;
	*jp = j;
}
/*Second pass of the two-pass variance: fold (x - mean) into *compp and
(x - mean)^2 into *m2p. See the comment on var() for why the sum of the
deviations is carried alongside the sum of their squares.*/
static LIKER_NOINLINE void av_scan_dev(AV *av, SSize_t *jp, SSize_t len,
	NV mean, NV *m2p, NV *compp)
{
	SV **el = AvARRAY(av);
	NV m2 = *m2p, comp = *compp;
	SSize_t j = *jp;
	for (; j < len; j++) {
		NV v, d;
		if (!el[j] || !sv_plain_nv(el[j], &v)) break;
		d = v - mean;
		m2 += d * d;
		comp += d;
	}
	*m2p = m2;
	*compp = comp;
	*jp = j;
}
/*Copy the run into out[*np] rather than reducing it, for the callers that need
the column itself: quantile() sorts it, cor() and cov() make two passes over
it. out must have room for len - *jp more values.*/
static LIKER_NOINLINE void av_scan_extract(AV *av, SSize_t *jp, SSize_t len,
	NV *restrict out, size_t *np)
{
	SV **el = AvARRAY(av);
	size_t n = *np;
	SSize_t j = *jp;
	for (; j < len; j++) {
		NV v;
		if (!el[j] || !sv_plain_nv(el[j], &v)) break;
		out[n++] = v;
	}
	*np = n;
	*jp = j;
}
/*One element of an array that the fast scan above would not take: fetch it,
run any get magic, and hand back the SV -- or NULL when the slot is missing,
empty or undef.

Running the get magic is the whole point.  av_fetch() on a tied array does not
return the element at all; it returns a mortal PVLV that only acquires the
element's value when mg_get() runs on it.  Testing SvOK() before that reports
every element of every tied array as undef, which is why sum(\@tied) croaked
"undefined value at array ref index 0" up to 0.301.  An ordinary array holding
a tied scalar, an overload, or any other get-magical SV had the same problem.

sv_plain_nv() deliberately refuses every one of those SVs, so this is where
they all arrive.*/
PERL_STATIC_INLINE SV *av_slow_at(pTHX_ AV *av, SSize_t j)
{
	SV **tv = av_fetch(av, j, 0);
	if (!tv || !*tv) return NULL;
	/*Load the element before running its magic, never through `tv` after.
	mg_get() runs perl, perl can push to the array being walked, and that
	reallocates the block `tv` points into -- so a second `*tv` is a read of
	freed memory.  The SV itself does not move; only the array of pointers to
	it does, which is why a copy of the pointer stays good.

	t/hot_path.t's growing element is this exact case, and it read the old
	block's contents often enough to pass: it took a quadmath build under
	four-way parallel load to return 1085 instead of 10.  Under valgrind it is
	an "invalid read of size 8" on every perl.*/
	SV *sv = *tv;
	SvGETMAGIC(sv);
	return SvOK(sv) ? sv : NULL;
}
/*One element of an array, handed back as it is: no get magic, no SvOK test,
nothing decided about it.  The frame functions -- filter(), merge(),
drop_duplicates() -- read whole columns and whole rows this way, and each of
them wants to run the magic itself, once, at the point where it also renders
or copies the value.

The block is read directly, which is the point: av_fetch() is out of line and
repeats a bounds check, a negative-index fixup and a magic dispatch per
element.  A tied array is the exception and takes av_fetch() -- its elements
do not exist until FETCH has run, and AvARRAY() on one is not the block they
live in (on an array that has never had a real element it is a null pointer,
which is how drop_duplicates() segfaulted on a tied AoH up to 0.301).

The pointer is derived here rather than hoisted into the caller's loop,
because reading a cell can run perl -- get magic, an overloaded
stringification -- and perl can push to the very array being read, which
reallocates it.  Deriving it costs a load and a compare; hoisting it would
leave the loop holding a freed block.*/
PERL_STATIC_INLINE SV *av_at(pTHX_ AV *av, SSize_t i)
{
	if (!av || i < 0) return NULL;
	if (SvRMAGICAL(av)) {
		SV **p = av_fetch(av, i, 0);
		return (p && *p) ? *p : NULL;
	}
	return (i <= AvFILLp(av)) ? AvARRAY(av)[i] : NULL;
}
/*The element at index `j` required to be a reference to `want` (SVt_PVHV for
an AoH's row, SVt_PVAV for an AoA's).  NULL when the slot is missing, empty,
or holds anything else -- the caller decides whether that is a croak.

The get magic is what av_fetch() alone does not give: on a tied array it
returns a mortal PVLV that only acquires the element's value once mg_get() has
run on it, so an SvROK() test before that says "not a reference" for every row
of every tied frame.  filter() croaked "AoH element 0 is not a HASH
reference", merge() saw a frame of no rows, and drop_duplicates() collapsed
every row into one.

The reference is not the caller's to keep: on a tied array it is that PVLV,
mortal and still bound to the tie.  A caller that puts a row in its result
wants av_row_keep().*/
PERL_STATIC_INLINE SV *av_ref_at(pTHX_ AV *av, SSize_t j, svtype want)
{
	SV *rv = av_at(aTHX_ av, j);
	if (!rv) return NULL;
	SvGETMAGIC(rv);
	return (SvROK(rv) && SvTYPE(SvRV(rv)) == want) ? rv : NULL;
}
PERL_STATIC_INLINE SV *av_row_at(pTHX_ AV *av, SSize_t j)
{
	return av_ref_at(aTHX_ av, j, SVt_PVHV);
}
/*A row of an AoH or AoA, ready to be stored in a result frame: the caller's
own reference when it can be shared, a fresh reference to the same row when
what av_ref_at() found was a tied array's PVLV.  Either way the result points
at the row the input holds, which is what "rows are shared, not copied"
means.*/
PERL_STATIC_INLINE SV *av_row_keep(pTHX_ SV *row)
{
	PERL_UNUSED_CONTEXT;
	return SvMAGICAL(row) ? newRV_inc(SvRV(row)) : SvREFCNT_inc_simple_NN(row);
}
/*Read a whole column as NV, mapping anything that is not a number to NaN.

cor() and cov() drop pairs rather than refusing them -- R's pairwise-complete
rule -- so unlike the reductions above they have no croak to reach and want a
value for every slot.  The scan is re-entered after each element it would not
take, instead of giving up on the rest of the column: a single undef in the
middle of a numeric vector is ordinary in real data, and letting it force the
remaining million elements through av_fetch() would give most of the column
away for one NA.*/
static void av_extract_or_nan(pTHX_ AV *av, SSize_t len, NV *out)
{
	const bool plain_av = !SvRMAGICAL((SV *)av);
	SSize_t j = 0;
	size_t n = 0;		//stays equal to j: one value written per element read
	while (j < len) {
		if (plain_av) av_scan_extract(av, &j, len, out, &n);
		if (j >= len) break;
		{
			SV *tv = av_slow_at(aTHX_ av, j);
			out[n++] = (tv && looks_like_number(tv)) ? SvNV(tv) : NV_NAN;
		}
		j++;
	}
}
//SvROK = scalar value reference is OK

/*Rendering a cell the way perl would, without going through SvPV().

Anything that keys rows by their contents -- drop_duplicates(), merge()'s
hash join, value_counts() -- compares cells by their Perl stringification,
and for a column of doubles that one conversion dominates everything else the
function does.  sv_2pv_flags() renders an NV with snprintf("%.*g", NV_DIG, x)
at ~140ns a cell and, unlike the IV case where SvPOK_or_cached_IV lets the
SvPV macros hand back the string perl cached on the SV, it never reuses that
PV: every pass over the column pays the conversion again.  (It does leave the
buffer behind, which is why keying a frame used to grow the caller's own
numeric columns by ~64 bytes a cell, for good.)

nk_num_pv() renders plain integers and -- where nk_nv_pv() applies -- plain
doubles into the caller's own scratch buffer instead, about four times faster
and without touching the SV.  Cells it declines go back through SvPV().*/
#define NK_NUMBUF 40   //room for any %.15g, any integer, and a NUL

/*%.15g about four times faster than the C library's, and only where the
answer is provably the same.  |x| is scaled into [1e14, 1e15) in long double
-- >= 64 mantissa bits against the double's 53 -- and rounded there.  Three
roundings are involved (the power-of-ten table entry, and the one multiply or
divide), so the scaled value is within 3 * 2^-64 relative, under 2e-4
absolute, of the true one: a fractional part further than 2e-3 from one half
therefore rounds exactly as the true value would.  Anything nearer -- plus
zero, the non-finite values, a long double no wider than the double (the
runtime half of nk_fast_nv_ok), and any NV that is not an IEEE double (the
#if: this is exactly %.15g, not %.*g for whatever NV_DIG happens to be) --
falls back to SvPV and perl's own renderer.  About one cell in 300 lands in
the guard band.  t/drop_duplicates.t groups tens of thousands of doubles both
ways and requires the answers to match; the same check over 90 million random
bit patterns, against the C library's own %.15g, found no disagreement.*/
#if NVSIZE == 8 && NV_DIG == 15 && DBL_MANT_DIG == 53 && LDBL_MANT_DIG >= 64
#define NK_FAST_NV 1

/*10^k for k in [0, 350], as nk_p10a[k / 27] * nk_p10b[k % 27].  Splitting it
keeps the table exact-ish without 351 literals: 10^k fits a 64-bit mantissa
for as long as 5^k does (k <= 27), so nk_p10b is exact, and nk_p10a is one
correctly-rounded literal apiece.*/
static const long double nk_p10a[13] = {
	1e0L,   1e27L,  1e54L,  1e81L,  1e108L, 1e135L, 1e162L,
	1e189L, 1e216L, 1e243L, 1e270L, 1e297L, 1e324L
};
static const long double nk_p10b[27] = {
	1e0L,  1e1L,  1e2L,  1e3L,  1e4L,  1e5L,  1e6L,  1e7L,  1e8L,
	1e9L,  1e10L, 1e11L, 1e12L, 1e13L, 1e14L, 1e15L, 1e16L, 1e17L,
	1e18L, 1e19L, 1e20L, 1e21L, 1e22L, 1e23L, 1e24L, 1e25L, 1e26L
};
#define NK_P10(k) (nk_p10a[(k) / 27] * nk_p10b[(k) % 27])

static const char nk_dd[201] = // the two digits of 00 .. 99
	"00010203040506070809" "10111213141516171819" "20212223242526272829"
	"30313233343536373839" "40414243444546474849" "50515253545556575859"
	"60616263646566676869" "70717273747576777879" "80818283848586878889"
	"90919293949596979899";

//the 15 decimal digits of n (1e14 <= n < 1e15) into d[0 .. 14]
PERL_STATIC_INLINE void nk_digits15(uint64_t n, char *restrict d) {
	uint32_t hi = (uint32_t)(n / 10000000u); // leading 8
	uint32_t lo = (uint32_t)(n % 10000000u); // trailing 7
	memcpy(d + 13, nk_dd + 2 * (lo % 100), 2); lo /= 100;
	memcpy(d + 11, nk_dd + 2 * (lo % 100), 2); lo /= 100;
	memcpy(d +  9, nk_dd + 2 * (lo % 100), 2); lo /= 100;
	d[8] = (char)('0' + lo);
	memcpy(d + 6, nk_dd + 2 * (hi % 100), 2); hi /= 100;
	memcpy(d + 4, nk_dd + 2 * (hi % 100), 2); hi /= 100;
	memcpy(d + 2, nk_dd + 2 * (hi % 100), 2); hi /= 100;
	memcpy(d,     nk_dd + 2 * hi,         2);
}

/*%.15g of a finite, non-zero x into out (NK_NUMBUF bytes are enough),
returning its length, or -1 when the rounding cannot be settled here.*/
static int nk_nv_pv(double x, char *restrict out) {
	char *restrict w = out;
	if (x < 0) { *w++ = '-'; x = -x; }

	uint64_t bits;
	memcpy(&bits, &x, 8);
	int be = (int)((bits >> 52) & 0x7ff);
	if (be == 0) { int t; (void)nv_frexp(x, &t); be = t; } //subnormal
	else         be -= 1022; //x = m * 2^be, m in [.5, 1)

	//floor(log10 x), give or take one, which the scaling loop then settles
	int e = (int)((be - 1) * 0.30102999566398120) - 1;
	if (e < -324) e = -324;

	long double s;
	for (int guard = 0; ; guard++) {
		const int k = 14 - e;
		s = (k >= 0) ? (long double)x * NK_P10(k) : (long double)x / NK_P10(-k);
		if      (s >= 1e15L) e++;
		else if (s <  1e14L) e--;
		else break;
		if (guard > 3) return -1; //not converging: give up
	}

	uint64_t n = (uint64_t)s; //s < 1e15 < 2^63
	const long double frac = s - (long double)n;
	if (frac > 0.498L && frac < 0.502L) return -1; //too close to call
	if (frac >= 0.5L) n++;
	if (n >= UINT64_C(1000000000000000)) { n = UINT64_C(100000000000000); e++; }

	char d[15];
	nk_digits15(n, d);
	int nd = 15;
	while (nd > 1 && d[nd - 1] == '0') nd--; //%g drops trailing zeros

	if (e < -4 || e >= 15) { //%e form
		*w++ = d[0];
		if (nd > 1) { *w++ = '.'; memcpy(w, d + 1, (size_t)(nd - 1)); w += nd - 1; }
		*w++ = 'e';
		int ex = e;
		if (ex < 0) { *w++ = '-'; ex = -ex; } else *w++ = '+';
		if (ex >= 100) { *w++ = (char)('0' + ex / 100); ex %= 100; }
		*w++ = (char)('0' + ex / 10);                   //at least two digits
		*w++ = (char)('0' + ex % 10);
	} else if (e >= 0) {                                //%f form, |x| >= 1
		if (nd <= e + 1) {                              //integral: pad with zeros
			memcpy(w, d, (size_t)nd);                 w += nd;
			memset(w, '0', (size_t)(e + 1 - nd));     w += e + 1 - nd;
		} else {
			memcpy(w, d, (size_t)(e + 1));            w += e + 1;
			*w++ = '.';
			memcpy(w, d + e + 1, (size_t)(nd - e - 1)); w += nd - e - 1;
		}
	} else { //%f form, |x| < 1
		*w++ = '0'; *w++ = '.';
		memset(w, '0', (size_t)(-e - 1)); w += -e - 1;
		memcpy(w, d, (size_t)nd);         w += nd;
	}
	return (int)(w - out);
}
#endif // NK_FAST_NV

/*Whether this call may use nk_nv_pv(): perl must render 1.5 with a '.' (it
uses the locale's radix under `use locale`, and PL_curcop here is the caller's
own), and long double must really be wider than double -- 1 + 1e-18 is 1 at 53
mantissa bits and is not at 64, and an x87 control word left at double
precision by some other library would silently break the error bound above.
Cheap enough to ask once per call, which is the only scope over which the
answer is guaranteed to hold still.*/
static bool nk_fast_nv_ok(pTHX) {
#ifdef NK_FAST_NV
	static volatile long double one = 1.0L;
	if (one + 1e-18L == one) return FALSE;
	SV *probe = sv_2mortal(newSVnv((NV)1.5));
	STRLEN l;
	const char *p = SvPV(probe, l);
	return cBOOL(l == 3 && memcmp(p, "1.5", 3) == 0);
#else
	PERL_UNUSED_CONTEXT;
	return FALSE;
#endif
}

/*The bytes perl would stringify `sv` to, written into `buf` (NK_NUMBUF bytes)
and its length into *lenp.  NULL when `sv` is not a bare number this can
render -- a cached string, magic, an overloaded object -- and the caller has
to go through SvPV() after all.  `fast_nv` is one nk_fast_nv_ok() answer,
asked once by the caller and passed down.*/
PERL_STATIC_INLINE const char *
nk_num_pv(SV *sv, char *buf, STRLEN *lenp, bool fast_nv) {
	//nothing but an integer: no cached string, no NV, no magic, no overload
	if ((SvFLAGS(sv)
	     & (SVf_IOK|SVf_NOK|SVf_POK|SVf_ROK|SVs_GMG|SVf_THINKFIRST)) == SVf_IOK) {
		UV u; bool neg = FALSE;
		if (SvIsUV(sv)) u = SvUVX(sv);
		else {
			const IV iv = SvIVX(sv);
			if (iv < 0) { neg = TRUE; u = (UV)(-(iv + 1)) + 1; } //IV_MIN safe
			else        u = (UV)iv;
		}
		char *p = buf + NK_NUMBUF;
		do { *--p = (char)('0' + (u % 10)); u /= 10; } while (u);
		if (neg) *--p = '-';
		*lenp = (STRLEN)(buf + NK_NUMBUF - p);
		return p;
	}
#ifdef NK_FAST_NV
	//likewise nothing but a double
	if (fast_nv && (SvFLAGS(sv)
	    & (SVf_NOK|SVf_IOK|SVf_POK|SVf_ROK|SVs_GMG|SVf_THINKFIRST)) == SVf_NOK) {
		const NV nv = SvNVX(sv);
		if (nv == 0.0) { buf[0] = '0'; *lenp = 1; return buf; } //-0.0 too
		if (nv_isfinite(nv)) {
			const int n = nk_nv_pv((double)nv, buf);
			if (n > 0) { *lenp = (STRLEN)n; return buf; }
		}
	}
#else
	PERL_UNUSED_ARG(fast_nv);
#endif
	return NULL;
}

// Helper function to increment the count for a given SV. * Skips NULL or Undefined values as requested
static void increment_count(pTHX_ HV* counts_hv, SV* val, bool fast_nv) {
	if (!val || !SvOK(val)) return; // Skip null pointers or undef (non-OK) values
	STRLEN len;
	// the key is the value's stringification, rendered here when it is a bare
	// number (nk_num_pv) and by SvPV -- which caches a PV on the caller's own
	// SV -- only when it has to be
	char numbuf[NK_NUMBUF];
	const char *str = nk_num_pv(val, numbuf, &len, fast_nv);
	if (!str) str = SvPV(val, len);
	// hv_fetch with lval=1 creates the key if it doesn't exist
	SV**svp = hv_fetch(counts_hv, str, len, 1);
	if (svp) {
		if (!SvOK(*svp)) {
			sv_setuv(*svp, 1);// Initialize count to 1 as an Unsigned Value (UV)
		} else {
			sv_setuv(*svp, SvUV(*svp) + 1);// Increment existing Unsigned Value
		}
	}
}

/*sample() draws from Drand01(), i.e. from perl's own PRNG, so srand($seed)
governs it exactly the way it governs rand() -- which is what makes a sample
reproducible, and what R users expect of set.seed().  An earlier private
splitmix64 generator used to sit here, with a comment promising a separate
stream seeded lazily from /dev/urandom and falling back to time()^PID.  None of
that was ever true: nothing called it, no seeding code was ever written, and
its state started at a fixed 0, so had anything called it the "random" sample
would have been the same sequence in every process.  Removed rather than
fixed, because Drand01() is the behaviour that is wanted and the behaviour
that sample() already had.*/

// Ensure Perl's PRNG is seeded, matching the lazy-evaluation of Perl's rand()
#define AUTO_SEED_PRNG() \
	do { \
		if (!PL_srand_called) { \
			(void)seedDrand01((Rand_seed_t)Perl_seed(aTHX)); \
			PL_srand_called = TRUE; \
		} \
	} while (0)

// Helpers for Random Number Generation
#ifndef M_PI
#define M_PI 3.14159265358979323846
#endif
/*Where the standard normal's lower tail stops being a number a double can
hold, and so the point past which this file stops asking erfc() for it.

0.5 * erfc(-x/sqrt(2)) reaches DBL_MIN at x = -37.5194 and its last
subnormal just past -38.4674; R's pnorm() returns a flat 0 below that, as
does scipy. erfc() takes and returns a double whatever perl's NV is, so
nothing it says out here can be trusted -- and on i386, where a double is
returned in an x87 register, what it says is not even 0: glibc spells
erfc()'s underflow case as a product of two 1e-300 constants, formed in
extended precision and handed back in st(0) still holding 1e-600. A perl
whose NV is a double rounds that away on return; a perl built
-Duselongdouble keeps it. glm's Wald p-value for |z| = 149 duly came back
as 1e-600 from a 32-bit long-double smoker (CPAN Testers, perl
5.32.1-longdouble, i686-linux-ld) where every other build reported 0.
Stopping short of the call gives every build the same answer, which is
also R's and scipy's.*/
#define PNORM_LOWER_ZERO (-38.4674)   //R's own cutoff, nmath/pnorm.c
NV approx_pnorm(NV x);                //defined below, after the histogram code

/* C helper for the non-central T-distribution CDF: quadrature over the scaled
 chi density up to PNT_NORMAL_DF, an asymptotic form above it. Matches R's
 pt(..., ncp) without needing the non-central beta function.
Thresholds between exact_pnt()'s three regimes. Below PNT_LARGE_DF the chi
density is broad enough to integrate over its whole support; above it the
density is a narrow spike and the steps have to be packed around the mode.
1e3 suits both: the support integral still holds ~2e-13 there, and the spike
integral needs df/2 > 500 for its Stirling series to be good to 4e-14. Past
PNT_NORMAL_DF no quadrature is worth running -- see the asymptotic form in
exact_pnt(). That second cut-off is R's, from nmath/pnt.c; the first has no
counterpart there, R using one series throughout.*/
#define PNT_LARGE_DF 1.0e3
#define PNT_NORMAL_DF 4.0e5

/*Integer power by squaring, for the w = z^m substitution below: m is a small
integer, and pow() would neither be exact at z^4 nor as quick.*/
static NV pow_uint(NV base, unsigned int e) {
	NV r = 1.0;
	while (e) {
		if (e & 1u) r *= base;
		base *= base;
		e >>= 1u;
	}
	return r;
}

/*Scaled chi log-density of W = sqrt(chi2_df / df) at its mode, w = 1:

  log f(1) = log 2 + x log x - lgamma(x) - x,   x = df/2

Evaluated as written, the three large terms cancel down to a result of order
log(df): at df = 1e8 that is 8.9e8 - 8.4e8 - 5e7 = 8.7, which keeps only eight
of sixteen digits. Stirling's series for lgamma collapses the same expression
to log 2 + 0.5 log(x/2pi) - 1/(12x) + 1/(360x^3), where nothing cancels at
all. Only used for x > 500, where truncating after the x^-3 term costs
1/(1260 x^5) < 4e-14.*/
static NV chi_log_peak(NV half_df) {
	const NV x = half_df;
	return M_LN2 + 0.5 * nv_log(x / (2.0 * M_PI))
		 - 1.0 / (12.0 * x) + 1.0 / (360.0 * x * x * x);
}

/*`upper` picks which tail comes back: the lower CDF P(T <= t), or the upper
tail P(T > t) obtained by integrating Phi(ncp - t*w) instead of
Phi(t*w - ncp), the two differing by 1 - Phi(z) = Phi(-z) under an integral
whose weight sums to exactly 1. Forming the upper tail as 1 - lower loses it
to cancellation whenever the answer is small: power_t_test(n => 2.182,
delta => 0.4088, sd => 0.9733, sig_level => 0.001) has a power of 1.03e-3, and
subtracting a lower tail of 0.99897 from 1 left only four good digits of it.*/
static NV exact_pnt(NV t, NV df, NV ncp, bool upper) {
	if (df <= 0.0) return 0.0;
	const unsigned int n_steps = 30000; //even, for Simpson
	NV integral = 0.0;
	const NV half_df = df / 2.0;

/*W = sqrt(chi2_df / df) has mean ~1 and standard deviation ~1/sqrt(2 df),
so its density narrows as df grows while a fixed 30000-step grid does not.
By df ~ 1e8 the steps go clean over the peak: power_t_test(n => 4e7,
delta => 0) returned 0.138 where the answer has to be sig_level/2 = 0.025,
and the n solved for a large-cohort effect size came back 9% low. Above
PNT_LARGE_DF, spend the steps on w across +/- 12 standard deviations of the
mode -- 12 sd of a density this symmetric leaves under 1e-30 in the tails,
and the peak then gets ~1250 steps per standard deviation.

That holds to ~1e-11 up to df ~ 4e5 and then gives way, because log_M's
two large terms cancel harder as df climbs: 1e-8 by df = 8e7 and 5e-7 by
df = 1e9. Beyond there, don't integrate at all. T is asymptotically
normal, and Abramowitz & Stegun 26.7.10 carries the O(1/df) correction, so
its error falls as 1/df^2 -- 4e-12 at the cut-off and 3e-16 by df = 1e9,
i.e. it gets better exactly where the quadrature gets worse. R's pnt.c
switches to the same formula at the same df.*/
	if (df > PNT_NORMAL_DF) {
		const NV s = 1.0 / (4.0 * df);
		const NV num = upper ? (ncp - t * (1.0 - s)) : (t * (1.0 - s) - ncp);
		return approx_pnorm(num / nv_sqrt(1.0 + t * t * 2.0 * s));
	}

	if (df > PNT_LARGE_DF) {
		const NV s = 1.0 / nv_sqrt(2.0 * df);
		const NV lo = 1.0 - 12.0 * s, hi = 1.0 + 12.0 * s; //lo > 0.7 here
		const NV w_step = (hi - lo) / (NV)n_steps;
		const NV log_peak = chi_log_peak(half_df);
		for (unsigned int i = 0; i <= n_steps; i++) {
			const NV w = lo + i * w_step;
			const NV e = w - 1.0;
/*Written against the mode rather than from log_coef: (df-1)log(w)
and half_df*w^2 are each ~1e5 at the ends of this interval and
cancel to ~70, so pairing them as one difference keeps thirteen
digits where summing the raw terms keeps eight.*/
			const NV log_M = log_peak + (df - 1.0) * nv_log1p(e) - half_df * e * (e + 2.0);
			const NV weight = (i == 0 || i == n_steps) ? 1.0 : ((i % 2) ? 4.0 : 2.0);
			const NV z = upper ? (ncp - t * w) : (t * w - ncp);
			integral += weight * approx_pnorm(z) * nv_exp(log_M);
		}
		return integral * (w_step / 3.0);
	}

/*Ordinary df. The density carries w^(df-1), so unless df is a whole number
that factor has a derivative of some order that is infinite at w = 0, and
Simpson -- which assumes four bounded derivatives -- cannot have it. The
earlier u = w/(1+w) grid took the full brunt: nine good digits at df = 1.8,
five at df = 1.2, two at df = 1.2 with sig_level = 1e-4, while whole-number
df stayed at machine precision because there the factor is a polynomial.

Substituting w = z^m turns the measure into z^(m*df - 1) dz, so choosing m
with m*df - 1 >= 3 leaves the first three derivatives bounded and Simpson
gets what it needs. m = 4 covers every df >= 1; below that it has to grow,
and is capped because z^m must stay computable. The substitution also
clusters the steps towards w = 0 exactly where the old grid was thinnest,
and puts the origin's contribution at z^(m*df - 1) = 0, which is why no
separate endpoint term is needed here.

The upper limit only has to reach past the density: sqrt(120/df) puts
exp(-df w^2 / 2) below e^-60 for a mode near zero, and 1 + 12/sqrt(2 df)
covers twelve standard deviations once the mode has settled near w = 1.
Whichever is larger serves both shapes.*/
	const unsigned int m = (df >= 1.0) ? 4u
		: (unsigned int)(nv_ceil(4.0 / df) > 64.0 ? 64.0 : nv_ceil(4.0 / df));
	const NV log_coef = nv_log(2.0) + half_df * nv_log(half_df) - nv_lgamma(half_df);
	const NV w_max = nv_fmax(nv_sqrt(120.0 / df), 1.0 + 12.0 / nv_sqrt(2.0 * df));
	const NV z_step = nv_pow(w_max, 1.0 / (NV)m) / (NV)n_steps;
	/*i = 0 is skipped: z = 0 makes log(z) -inf, and the term it belongs to is
	zero anyway since m*df - 1 > 0 by construction.*/
	for (unsigned int i = 1; i <= n_steps; i++) {
		const NV zq = i * z_step;
		const NV w = pow_uint(zq, m);
		const NV log_M = log_coef + ((NV)m * df - 1.0) * nv_log(zq) - half_df * w * w;
		const NV z = upper ? (ncp - t * w) : (t * w - ncp);
		const NV weight = (i == n_steps) ? 1.0 : ((i % 2) ? 4.0 : 2.0);
		integral += weight * approx_pnorm(z) * nv_exp(log_M);
	}
	return integral * (NV)m * (z_step / 3.0);
}
/* Math Helpers for P-values and Confidence Intervals
 Ranking helper with tie adjustment (matches R's tie handling)*/
typedef struct { NV val; size_t idx; NV rank; } RankInfo;
/*One group label as perl handed it over, for the functions that report
per-group results under the caller's own names (kruskal_test).  klen carries
the UTF-8 flag in its sign, which is hv_store()'s and hv_fetch()'s own
convention, so a label with an embedded NUL or a non-ASCII character
round-trips instead of being truncated by strlen() or flattened to bytes.*/
typedef struct { char *name; I32 klen; } GroupLabel;
/*Single three-way ascending comparator for qsort. Works on raw NV arrays
and on any struct whose first member is an NV (RankInfo, TimeIdx): a
pointer to such a struct converts to a pointer to its leading NV. Replaces
the former compare_rank/compare_index/cmp_rank_item/cmp_rank_info/compare_NVs
family. Order-restoring re-sorts (the old compare_index pass) are gone:
rank_data() scatters averaged ranks straight into out[idx].

RankItem no longer arrives here: rank_data() sorts through the inlined
rankitem_sort() generated by LIKER_DEFINE_SORT() below.*/
static int cmp_nv3(const void *a, const void *b) {
	NV x = *(const NV *)a, y = *(const NV *)b;
	return (x > y) - (x < y);
}
/*One observation for the Kruskal-Wallis ranking: a value and its group.

kruskal_test() wants per-group rank sums, not the ranks themselves, so it does
not use the shared RankInfo / rank_and_count_ties() pair.  Dropping the NV rank
field takes the sorted array from 24 bytes per observation to 16 on a double
build (48 to 32 on __float128), and the tie scan can add each block's averaged
rank straight into the group sums instead of writing it back for a second pass
to read.  That, and not calling qsort(), is what took the whole test from 47.8
to 16 bytes per observation -- measured as VmHWM before and after the call, at
n = 5e6 with three groups.*/
typedef struct { NV val; size_t gid; } KWObs;

/*Ascending by value, then by group id.  The gid tiebreak is not cosmetic: it
makes the order total, so the rank sums are accumulated in a fixed order and H
is reproducible.  Without it, equal values were left in whatever relative
order the sort happened to leave them, which on the hash-of-arrays input path
came out of perl's per-process hash iteration order -- H moved by up to 1.2e-14
between runs on the same data.*/
#define KW_LESS(a, b) ((a).val < (b).val \
	|| ((a).val == (b).val && (a).gid < (b).gid))

/*Runs this short are cheaper to insertion-sort than to keep partitioning; 16
is the usual crossover and measuring 8, 16 and 32 here moved the n = 5e6 sort
by under 3%.*/
#define KW_INSERTION_MAX 16

static void kw_sift(KWObs *a, size_t root, size_t n) {
	KWObs tmp = a[root];
	for (;;) {
		size_t child = 2 * root + 1;
		if (child >= n) break;
		if (child + 1 < n && KW_LESS(a[child], a[child + 1])) child++;
		if (!KW_LESS(tmp, a[child])) break;
		a[root] = a[child];
		root = child;
	}
	a[root] = tmp;
}

static void kw_heapsort(KWObs *a, size_t n) {
	if (n < 2) return;
	for (size_t i = n / 2; i > 0; i--) kw_sift(a, i - 1, n);
	for (size_t i = n; i > 1; i--) {
		KWObs t = a[0]; a[0] = a[i - 1]; a[i - 1] = t;
		kw_sift(a, 0, i - 1);
	}
}

static void kw_insertion(KWObs *a, size_t n) {
	for (size_t i = 1; i < n; i++) {
		KWObs v = a[i];
		size_t j = i;
		while (j > 0 && KW_LESS(v, a[j - 1])) { a[j] = a[j - 1]; j--; }
		a[j] = v;
	}
}

/*In-place introsort over KWObs.

Not qsort().  glibc's qsort is a mergesort that allocates a scratch buffer the
size of the whole array -- measured on glibc 2.39 as VmHWM 116 MB -> 230 MB
across one sort of a 114 MB array -- which was half of kruskal_test()'s peak
memory, and its comparison goes through a function pointer that cannot be
inlined.  Sorting the same 5e6-element array here takes 0.375s against qsort's
1.01s and allocates nothing.

Median-of-three quicksort, recursing on the smaller partition and looping on
the larger so the stack stays O(log n) deep, with a heapsort fallback once the
recursion has gone deeper than 2*floor(log2(n)) so that a median-of-three
killer cannot drive it to O(n^2).  Leaving the median at the midpoint gives
both scans a sentinel, so neither can run off its end.

No NaN can reach here: kruskal_test() drops NaN while filling the array, which
this depends on -- a NaN compares false against everything, so it satisfies
neither scan's condition and the partition loses its sentinel.

`a` is deliberately not restrict-qualified: it is re-pointed as the loop walks
into the larger partition, and the recursive call reaches the same allocation
by a second route.*/
static void kw_sort(KWObs *a, size_t n, unsigned short int depth) {
	while (n > KW_INSERTION_MAX) {
		if (depth == 0) { kw_heapsort(a, n); return; }
		depth--;
		KWObs *lo = a, *mid = a + (n >> 1), *hi = a + n - 1;
		if (KW_LESS(*mid, *lo)) { KWObs t = *mid; *mid = *lo; *lo = t; }
		if (KW_LESS(*hi, *mid)) {
			KWObs t = *hi; *hi = *mid; *mid = t;
			if (KW_LESS(*mid, *lo)) { KWObs u = *mid; *mid = *lo; *lo = u; }
		}
		const KWObs piv = *mid;
		KWObs *i = lo, *j = hi;
		for (;;) {
			while (KW_LESS(*i, piv)) i++;
			while (KW_LESS(piv, *j)) j--;
			if (i >= j) break;
			KWObs t = *i; *i = *j; *j = t;
			i++; j--;
		}
		const size_t left = (size_t)(j - a) + 1;
		if (left < n - left) { kw_sort(a, left, depth); a += left; n -= left; }
		else                 { kw_sort(a + left, n - left, depth); n = left; }
	}
	kw_insertion(a, n);
}

/*2*floor(log2(n)), the standard introsort depth limit.*/
static unsigned short int kw_depth_limit(size_t n) {
	unsigned short int lg = 0;
	while (n > 1) { n >>= 1; lg++; }
	return (unsigned short int)(2 * lg);
}
/*The kw_sort() introsort above, generated for any struct and ordering.

LIKER_DEFINE_SORT(T, PFX, LESS) defines PFX_sort(T *a, size_t n), an in-place
ascending sort of a[0..n-1] under LESS(x, y) -- which takes two *values* of
type T, as KW_LESS does, and must be a strict weak ordering.

It is the same algorithm, transcribed: median of three left at the midpoint so
both partition scans have a sentinel, recursion into the shorter side and a
loop on the longer so the stack stays O(log n) deep, a heapsort fallback past
2*floor(log2 n) levels so a median-of-three killer cannot reach O(n^2), and one
insertion sort over the nearly-ordered remainder.

The point of generating it is the comparison. qsort() reaches its comparator
through a function pointer it cannot inline, and for a sort of a few thousand
elements that indirect call is most of the cost: nv_sort() below measures 210us
against qsort()'s 355us on 5000 NVs. glibc's qsort also allocates a scratch
buffer the size of the whole array, which this does not.

kw_sort() itself is left hand-written rather than generated from this macro:
its comments record measurements taken against that code, and converting it
would move two call sites and delete kw_depth_limit() for no gain.

NaN cannot be ordered by any comparison sort, here or by qsort -- every
comparison against one is false. What this guarantees on such input is what a
caller relies on: the result is a permutation of the input and no scan leaves
[a, a+n), because a NaN stops both scans where they stand rather than letting
either run past it, so each pass still narrows the range by one from each end.*/
#define LIKER_SORT_ISORT_MAX 16		//runs this short finish by insertion sort

#define LIKER_DEFINE_SORT(T, PFX, LESS)                                       \
static void PFX##_sift(T *a, size_t root, size_t n) {                \
	T tmp = a[root];                                                          \
	for (;;) {                                                                \
		size_t child = 2 * root + 1;                                          \
		if (child >= n) break;                                                \
		if (child + 1 < n && LESS(a[child], a[child + 1])) child++;            \
		if (!LESS(tmp, a[child])) break;                                       \
		a[root] = a[child];                                                   \
		root = child;                                                         \
	}                                                                         \
	a[root] = tmp;                                                            \
}                                                                             \
static void PFX##_heapsort(T *a, size_t n) {                         \
	if (n < 2) return;                                                        \
	for (size_t i = n / 2; i > 0; i--) PFX##_sift(a, i - 1, n);                \
	for (size_t i = n; i > 1; i--) {                                          \
		T t = a[0]; a[0] = a[i - 1]; a[i - 1] = t;                             \
		PFX##_sift(a, 0, i - 1);                                               \
	}                                                                         \
}                                                                             \
static void PFX##_isort(T *a, size_t n) {                            \
	for (size_t i = 1; i < n; i++) {                                          \
		T v = a[i];                                                           \
		size_t j = i;                                                         \
		while (j > 0 && LESS(v, a[j - 1])) { a[j] = a[j - 1]; j--; }           \
		a[j] = v;                                                             \
	}                                                                         \
}                                                                             \
/*No restrict on a[]: it is re-pointed as the loop walks into the larger       \
partition, and the recursive call reaches the same allocation.*/              \
static void PFX##_introsort(T *a, size_t n, unsigned short int depth) {       \
	while (n > LIKER_SORT_ISORT_MAX) {                                        \
		if (depth == 0) { PFX##_heapsort(a, n); return; }                      \
		depth--;                                                              \
		{                                                                     \
		T *lo = a, *mid = a + (n >> 1), *hi = a + n - 1;                       \
		if (LESS(*mid, *lo)) { T t = *mid; *mid = *lo; *lo = t; }              \
		if (LESS(*hi, *mid)) {                                                \
			T t = *hi; *hi = *mid; *mid = t;                                   \
			if (LESS(*mid, *lo)) { T u = *mid; *mid = *lo; *lo = u; }          \
		}                                                                     \
		{                                                                     \
		const T piv = *mid;                                                   \
		T *i = lo, *j = hi;                                                    \
		for (;;) {                                                            \
			while (LESS(*i, piv)) i++;                                         \
			while (LESS(piv, *j)) j--;                                         \
			if (i >= j) break;                                                \
			{ T t = *i; *i = *j; *j = t; }                                     \
			i++; j--;                                                         \
		}                                                                     \
		{                                                                     \
		const size_t left = (size_t)(j - a) + 1;                              \
		if (left < n - left) {                                                \
			PFX##_introsort(a, left, depth); a += left; n -= left;             \
		} else {                                                              \
			PFX##_introsort(a + left, n - left, depth); n = left;              \
		}                                                                     \
		} } }                                                                 \
	}                                                                         \
	PFX##_isort(a, n);                                                        \
}                                                                             \
static void PFX##_sort(T *a, size_t n) {                                      \
	unsigned short int lg = 0;                                                \
	if (n < 2) return;                                                        \
	for (size_t t = n; t > 1; t >>= 1) lg++;	/*floor(log2 n)*/             \
	PFX##_introsort(a, n, (unsigned short int)(2 * lg));                      \
}

/* Generates a single binomial random variate. 
Uses the standard Bernoulli trial loop. Drand01() taps into Perl's PRNG.*/
static size_t generate_binomial(pTHX_ const size_t size, const NV prob) {
	if (prob <= 0.0) return 0;
	if (prob >= 1.0) return size;

	size_t successes = 0;
	for (size_t i = 0; i < size; i++) {
		if (Drand01() <= prob) successes++;
	}
	return successes;
}

#define FT_EPS 2.220446049250313e-16
#define FT_TOL 0.0001220703125 // .Machine$double.eps^0.25, R uniroot default

static NV ft_lchoose(long n, long k) {
	if (k < 0 || k > n || n < 0) return -INFINITY;
	return nv_lgamma((NV)n + 1) - nv_lgamma((NV)k + 1) - nv_lgamma((NV)(n - k) + 1);
}

/*Loader's saddle-point binomial, in log form; defined with the binom_test
helpers further down.  Declared here because the hypergeometric density
below is built out of it.*/
static NV bt_dbinom_raw_log(NV x, NV n, NV p, NV q);

/*log dhyper(x; m white, n black, k drawn), by R's dhyper():

     dhyper = dbinom(x; m, p) * dbinom(k-x; n, p) / dbinom(k; m+n, p),
     p = k/(m+n)

Differencing lgamma() gets the same answer for small tables and loses the
back half of it for large ones: lgamma(8.4e7) is about 1.4e9, where a
double's spacing is 2.4e-7, so a table like SciPy's gh-3014
([[1,2],[9,84419233]]) came out right to only seven digits.  The three
saddle-point terms stay O(1) whatever the margins are, which is exactly why
R computes its own hypergeometric this way.*/
static NV ft_dhyper_log(long x, long m, long n, long k) {
	if (x < 0 || x > k || x > m || k - x > n) return -INFINITY;
	if (k == 0) return (x == 0) ? 0.0 : -INFINITY;
	NV N = (NV)m + (NV)n;
	NV p = (NV)k / N, q = (N - (NV)k) / N;
	return bt_dbinom_raw_log((NV)x, (NV)m, p, q)
	     + bt_dbinom_raw_log((NV)(k - x), (NV)n, p, q)
	     - bt_dbinom_raw_log((NV)k, N, p, q);
}

typedef struct {
	long lo, hi, ns, m, n, k, x;
	NV *logdc;   // central log hypergeometric density over the support
} ft_support;

static int ft_init(ft_support *S, long a, long b, long c, long d) {
	S->m = a + c; S->n = b + d; S->k = a + b; S->x = a;
	S->lo = (S->k - S->n > 0) ? (S->k - S->n) : 0;
	S->hi = (S->k < S->m) ? S->k : S->m;
	S->ns = S->hi - S->lo + 1;
	if (S->ns <= 0) { S->logdc = NULL; return 0; }
	Newx(S->logdc, S->ns, NV);
	for (long i = 0; i < S->ns; i++) {
	  long j = S->lo + i;
	  S->logdc[i] = ft_dhyper_log(j, S->m, S->n, S->k);
	}
	return 1;
}
static void ft_free(ft_support *S) { Safefree(S->logdc); S->logdc = NULL; }

static void ft_dnhyper(const ft_support *restrict S, NV ncp, NV *restrict out) {
	NV lncp = nv_log(ncp), mx = -INFINITY;
	for (long i = 0; i < S->ns; i++) {
	  out[i] = S->logdc[i] + lncp * (NV)(S->lo + i);
	  if (out[i] > mx) mx = out[i];
	}
	NV s = 0;
	for (long i = 0; i < S->ns; i++) { out[i] = nv_exp(out[i] - mx); s += out[i]; }
	for (long i = 0; i < S->ns; i++) out[i] /= s;
}

static NV ft_mnhyper(const ft_support *restrict S, NV ncp, NV *restrict scratch) {
	if (ncp == 0)     return (NV)S->lo;
	if (nv_isinf(ncp))   return (NV)S->hi;
	ft_dnhyper(S, ncp, scratch);
	NV mu = 0;
	for (long i = 0; i < S->ns; i++) mu += (NV)(S->lo + i) * scratch[i];
	return mu;
}

// upper != 0 => P(X >= q), upper == 0 => P(X <= q)
static NV ft_pnhyper(const ft_support *restrict S, long q, NV ncp, bool upper,
                     NV *restrict scratch) {
	if (ncp == 1.0) {
	  NV s = 0;
	  for (long i = 0; i < S->ns; i++) {
		   long j = S->lo + i;
		   if (upper ? (j >= q) : (j <= q)) s += nv_exp(S->logdc[i]);
	  }
	  return s;
	}
	if (ncp == 0.0)   return upper ? (NV)(q <= S->lo) : (NV)(q >= S->lo);
	if (nv_isinf(ncp))   return upper ? (NV)(q <= S->hi) : (NV)(q >= S->hi);
	ft_dnhyper(S, ncp, scratch);
	NV s = 0;
	for (long i = 0; i < S->ns; i++) {
	  long j = S->lo + i;
	  if (upper ? (j >= q) : (j <= q)) s += scratch[i];
	}
	return s;
}

//R's src/library/stats/src/zeroin.c (Brent-Dekker)
typedef NV (*ft_fn)(NV t, void *ctx);
static NV ft_zeroin(NV ax, NV bx, ft_fn f, void *ctx, NV tol, int maxit) {
	NV a = ax, b = bx, fa = f(a, ctx), fb = f(b, ctx), c = a, fc = fa;
	while (maxit-- > 0) {
	  NV prev = b - a;
	  if (nv_fabs(fc) < nv_fabs(fb)) { a = b; b = c; c = a; fa = fb; fb = fc; fc = fa; }
	  NV tol_act = 2 * FT_EPS * nv_fabs(b) + tol / 2;
	  NV step = (c - b) / 2;
	  if (nv_fabs(step) <= tol_act || fb == 0.0) return b;
	  if (nv_fabs(prev) >= tol_act && nv_fabs(fa) > nv_fabs(fb)) {
		   NV cb = c - b, p, q;
		   if (a == c) { NV t1 = fb / fa; p = cb * t1; q = 1.0 - t1; }
		   else {
			   NV q0 = fa / fc, t1 = fb / fc, t2 = fb / fa;
			   p = t2 * (cb * q0 * (q0 - t1) - (b - a) * (t1 - 1.0));
			   q = (q0 - 1.0) * (t1 - 1.0) * (t2 - 1.0);
		   }
		   if (p > 0) q = -q; else p = -p;
		   if (p < 0.75 * cb * q - nv_fabs(tol_act * q) / 2 && p < nv_fabs(prev * q / 2)) step = p / q;
	  }
	  if (nv_fabs(step) < tol_act) step = step > 0 ? tol_act : -tol_act;
	  a = b; fa = fb; b += step; fb = f(b, ctx);
	  if ((fb > 0) == (fc > 0)) { c = a; fc = fa; }
	}
	return b;
}

typedef struct { const ft_support *S; NV target; NV *scratch; int mode; } ft_rc;
/*mode 0: mnhyper(t)-target      1: mnhyper(1/t)-target
mode 2: pnhyper(x,t,low)-tgt   3: pnhyper(x,1/t,low)-tgt
mode 4: pnhyper(x,t,up)-tgt    5: pnhyper(x,1/t,up)-tgt*/
static NV ft_rootf(NV t, void *ctx) {
	ft_rc *r = (ft_rc *)ctx; const ft_support *S = r->S;
	switch (r->mode) {
	  case 0: return ft_mnhyper(S, t, r->scratch) - r->target;
	  case 1: return ft_mnhyper(S, 1.0 / t, r->scratch) - r->target;
	  case 2: return ft_pnhyper(S, S->x, t, 0, r->scratch) - r->target;
	  case 3: return ft_pnhyper(S, S->x, 1.0 / t, 0, r->scratch) - r->target;
	  case 4: return ft_pnhyper(S, S->x, t, 1, r->scratch) - r->target;
	  default:return ft_pnhyper(S, S->x, 1.0 / t, 1, r->scratch) - r->target;
	}
}

static NV exact_p_value(long a, long b, long c, long d, const char *alt) {
	ft_support S;
	if (!ft_init(&S, a, b, c, d)) return 1.0;
	NV *sc; Newx(sc, S.ns, NV);
	NV p;
	if (!strcmp(alt, "less"))         p = ft_pnhyper(&S, S.x, 1.0, 0, sc);
	else if (!strcmp(alt, "greater")) p = ft_pnhyper(&S, S.x, 1.0, 1, sc);
	else {
	  ft_dnhyper(&S, 1.0, sc);
	  NV dx = sc[S.x - S.lo], relErr = 1 + 1e-7, s = 0;
	  for (long i = 0; i < S.ns; i++) if (sc[i] <= dx * relErr) s += sc[i];
	  p = s;
	}
	if (p < 0) p = 0; if (p > 1) p = 1;
	Safefree(sc); ft_free(&S);
	return p;
}

static void calculate_exact_stats(long a, long b, long c, long d, NV conf,
								  const char *alt, NV *orp, NV *lop, NV *hip) {
	ft_support S;
	if (!ft_init(&S, a, b, c, d)) { *orp = NAN; *lop = NAN; *hip = NAN; return; }
	NV *sc; Newx(sc, S.ns, NV);
	long x = S.x, lo = S.lo, hi = S.hi;

	// conditional MLE of the odds ratio
	NV est;
	if      (x == lo) est = 0.0;
	else if (x == hi) est = INFINITY;
	else {
	  NV mu = ft_mnhyper(&S, 1.0, sc);
	  ft_rc r = { &S, (NV)x, sc, 0 };
	  if      (mu > x) { r.mode = 0; est = ft_zeroin(0, 1, ft_rootf, &r, FT_TOL, 1000); }
	  else if (mu < x) { r.mode = 1; est = 1.0 / ft_zeroin(FT_EPS, 1, ft_rootf, &r, FT_TOL, 1000); }
	  else             est = 1.0;
	}
	*orp = est;
	// confidence interval via inversion of the noncentral hypergeometric
	NV clo, chi;
	ft_rc r = { &S, 0, sc, 0 };
	#define FT_NCP_L(alpha, dst) do {                                                    \
	  if (x == lo) { dst = 0.0; } else {                                               \
		   NV p = ft_pnhyper(&S, x, 1.0, 1, sc);                                     \
		   if (p > (alpha))      { r.mode = 4; r.target = (alpha); dst = ft_zeroin(0, 1, ft_rootf, &r, FT_TOL, 1000); } \
		   else if (p < (alpha)) { r.mode = 5; r.target = (alpha); dst = 1.0 / ft_zeroin(FT_EPS, 1, ft_rootf, &r, FT_TOL, 1000); } \
		   else dst = 1.0; } } while (0)
	#define FT_NCP_U(alpha, dst) do {                                                    \
	  if (x == hi) { dst = INFINITY; } else {                                          \
		   NV p = ft_pnhyper(&S, x, 1.0, 0, sc);                                     \
		   if (p < (alpha))      { r.mode = 2; r.target = (alpha); dst = ft_zeroin(0, 1, ft_rootf, &r, FT_TOL, 1000); } \
		   else if (p > (alpha)) { r.mode = 3; r.target = (alpha); dst = 1.0 / ft_zeroin(FT_EPS, 1, ft_rootf, &r, FT_TOL, 1000); } \
		   else dst = 1.0; } } while (0)

	if      (!strcmp(alt, "less"))    { clo = 0.0;            FT_NCP_U(1 - conf, chi); }
	else if (!strcmp(alt, "greater")) { FT_NCP_L(1 - conf, clo); chi = INFINITY; }
	else { NV al = (1 - conf) / 2; FT_NCP_L(al, clo); FT_NCP_U(al, chi); }

	*lop = clo; *hip = chi;
	Safefree(sc); ft_free(&S);
}

/*General R x C exact test (used for anything that is not 2x2)

The 2x2 machinery above cannot describe larger tables, so the R x C case
is handled by direct enumeration of every contingency table that shares
the observed row and column margins.  Under the null the probability of a
table T with fixed margins is the multivariate hypergeometric

     P(T) = (prod_i R_i!)(prod_j C_j!) / ( N! prod_ij t_ij! )

The (two-sided) p-value is the sum of P(T) over all such T whose
probability is <= P(observed).  Only two-sided is defined for R x C, so
'alternative' is ignored for larger tables (matching R's fisher.test).*/
typedef struct {
	unsigned nrow, ncol;
	const long *R;  //fixed row totals
	long *C_rem;    //remaining column totals (mutated)
	const NV *lgR;  //lgR[i]  = sum_{k>=i} lgamma(R_k+1)
	const NV *jenR; //jenR[i] = sum_{k>=i} cheapest split of R_k
	NV const_term;           //sum lgamma(R_i+1)+lgamma(C_j+1)-lgamma(N+1)
	NV log_p_obs_tol;        //log P(observed) + log1p(relErr)
	NV p_total;              //accumulated p-value
	long long nodes, cap;    //work counter + runaway guard
	short int aborted;       //set once cap is exceeded
} ft_rxc_ctx;

static void ft_rxc_row(ft_rxc_ctx *restrict X, int row, int col, long row_rem,
                       NV cur_lc);

//qsort comparator: ascending margin totals.
static int ft_long_cmp(const void *a, const void *b) {
	long x = *(const long *)a, y = *(const long *)b;
	return (x > y) - (x < y);
}

/*The smallest sum of lgamma(t+1) that k cells adding up to `total` can have.
lgamma(x+1) is convex, so the minimum is the most even split there is: the
remainder r gets q+1 and the other k-r cells get q.  The continuous Jensen
bound k*lgamma(total/k + 1) is easier to write but slacker, and the slack
is what decides whether a subtree gets summed in closed form or walked.*/
static NV ft_even_split_lc(long total, long k) {
	long q = total / k, r = total % k;
	return (NV)r * nv_lgamma((NV)q + 2.0) + (NV)(k - r) * nv_lgamma((NV)q + 1.0);
}

/*Decide a whole subtree without walking it, where that is possible.

With rows 0..row-1 placed (their lgamma(t+1) terms already summed into
cur_lc) and C_rem holding what is left of each column, every completion T
of the table satisfies

     log P(T) = const_term - cur_lc - S,
     S = sum of lgamma(t_ij + 1) over the cells still to be filled,

so bounding S bounds log P over the entire subtree.  lgamma(x+1) is convex,
so Jensen puts a floor under S -- spreading a row (or column) total evenly
is the cheapest it can ever be -- and a! b! <= (a+b)! puts a ceiling on it,
since piling a total into one cell is the dearest.  Rows and columns each
yield both bounds; the tighter of the two is used.

If even the most probable completion is already at or below the observed
table's probability then every completion counts, and their combined mass
has a closed form.  Counting the N' = sum(C_rem) remaining observations two
ways -- assigned directly to rows, or column by column -- gives

     sum over completions of prod 1/t_ij!
         = N'! / ( prod_{i>=row} R_i!  prod_j C_rem_j! )

which is the whole subtree in a single exp() instead of a walk over it.  If
even the least probable completion sits above the threshold, nothing in the
subtree counts and it is dropped outright.  Both tests are exact: they skip
only work the enumeration would have done, and never change the sum.

Returns 1 if the subtree was added whole, 2 if it was discarded whole, and
0 if it has to be enumerated after all.*/
static int ft_rxc_prune(ft_rxc_ctx *restrict X, int row, NV cur_lc) {
	const long nrem = (long)(X->nrow - row);
	NV n_left = 0.0;      //N'
	NV lg_c = 0.0;        //sum_j lgamma(C_rem_j + 1)
	NV jen_c = 0.0;       //sum_j (cheapest split of C_rem_j over nrem cells)
	for (int j = 0; j < X->ncol; j++) {
		long c = X->C_rem[j];
		n_left += (NV)c;
		lg_c   += nv_lgamma((NV)c + 1.0);
		jen_c  += ft_even_split_lc(c, nrem);
	}
	NV s_lo = X->jenR[row] > jen_c ? X->jenR[row] : jen_c;  //S >= s_lo
	NV s_hi = X->lgR[row]  < lg_c  ? X->lgR[row]  : lg_c;   //S <= s_hi
	NV base = X->const_term - cur_lc;

	/*A rounding wobble at the threshold must not take a shortcut the
	enumeration itself would not have taken, so both tests are asked for a
	little more than they strictly need; falling through is always safe.*/
	const NV slack = 1e-9;
	if (base - s_lo <= X->log_p_obs_tol - slack) {
		X->p_total += nv_exp(base + nv_lgamma(n_left + 1.0) - X->lgR[row] - lg_c);
		return 1;
	}
	if (base - s_hi > X->log_p_obs_tol + slack) return 2;
	return 0;
}

/*Finish the current row; either recurse to the next free row, or (once the
last free row is placed) derive the final row from the column residuals.*/
static void ft_rxc_after_row(ft_rxc_ctx *restrict X, int row, NV cur_lc) {
	if (row == X->nrow - 2) {
		NV lc = cur_lc;
		for (int j = 0; j < X->ncol; j++) lc += nv_lgamma((NV)X->C_rem[j] + 1.0);
		NV logP = X->const_term - lc;
		if (logP <= X->log_p_obs_tol) X->p_total += nv_exp(logP);
		if (++X->nodes > X->cap) X->aborted = 1;
		return;
	}
	ft_rxc_row(X, row + 1, 0, X->R[row + 1], cur_lc);
}

/*Distribute row `row`'s total across the columns.  The last column of the
row is fixed by the remaining row total; interior columns range over every
value that keeps both the row and the column residuals nonnegative.*/
static void ft_rxc_row(ft_rxc_ctx *restrict X, int row, int col, long row_rem,
                       NV cur_lc) {
	if (X->aborted) return;
	/*Every visit is counted, not just the leaves: a table like PR#4688's
	(4x3, N = 16442) spends minutes inside the interior of the tree before
	it reaches enough leaves for a leaf-only counter to notice.*/
	if (++X->nodes > X->cap) { X->aborted = 1; return; }
	if (col == 0) {
		int decided = ft_rxc_prune(X, row, cur_lc);
		if (decided) return;
	}
	if (col == X->ncol - 1) {
		long v = row_rem;
		if (v < 0 || v > X->C_rem[col]) return;
		X->C_rem[col] -= v;
		ft_rxc_after_row(X, row, cur_lc + nv_lgamma((NV)v + 1.0));
		X->C_rem[col] += v;
		return;
	}
	long maxv = row_rem < X->C_rem[col] ? row_rem : X->C_rem[col];
	for (long v = 0; v <= maxv; v++) {
		X->C_rem[col] -= v;
		ft_rxc_row(X, row, col + 1, row_rem - v, cur_lc + nv_lgamma((NV)v + 1.0));
		X->C_rem[col] += v;
		if (X->aborted) return;
	}
}

/*Returns the two-sided exact p-value, or -1.0 if the enumeration exceeded
the safety cap (the caller turns that into a croak).*/
static NV fisher_rxc_pvalue(pTHX_ const long *restrict cells, unsigned nrow, unsigned ncol) {
	/*No restrict on R and C: the transpose below swaps them, which points each
	at what the other named. `cells` carries the annotation instead, and that is
	the half the margin loop wants -- the two accumulators are `long *` like
	cells is, so nothing else can tell the compiler that R[i] += and C[j] += do
	not land in the table being read.*/
	long *R = NULL, *C = NULL;
	Newxz(R, nrow, long);
	Newxz(C, ncol, long);
	long N = 0;
	for (unsigned i = 0; i < nrow; i++)
		for (unsigned j = 0; j < ncol; j++) {
			long v = cells[i * ncol + j];
			R[i] += v; C[j] += v; N += v;
		}

	NV const_term = -nv_lgamma((NV)N + 1.0);
	for (unsigned i = 0; i < nrow; i++) const_term += nv_lgamma((NV)R[i] + 1.0);
	for (unsigned j = 0; j < ncol; j++) const_term += nv_lgamma((NV)C[j] + 1.0);

	NV obs_lc = 0.0;
	for (unsigned i = 0; i < nrow * ncol; i++) obs_lc += nv_lgamma((NV)cells[i] + 1.0);

	/*Everything the enumeration needs -- the two margins, const_term and
	obs_lc -- is unchanged by permuting rows and columns or by transposing
	the table, but the amount of walking is not, so the margins are put in
	the cheapest arrangement before the walk starts.
	
	A row is laid out one cell at a time with its last cell forced by what
	is left of the row, and the final row is forced outright by the column
	residuals, so the branching factor of a row grows like R_i^(ncol-1) and
	whatever lands last costs nothing.  Two consequences: keep the shorter
	side as the columns (transposing MP6's 5x7 to 7x5 drops its worst case
	from ~1e14 completions to ~1e11), and sort both margins ascending so
	that the fattest row and the fattest column are the ones forced.*/
	if (ncol > nrow) {
		long *t = R; R = C; C = t;
		unsigned int ti = nrow; nrow = ncol; ncol = ti;
	}
	qsort(R, nrow, sizeof(long), ft_long_cmp);
	qsort(C, ncol, sizeof(long), ft_long_cmp);

	// Suffix sums over the rows still to be placed, for ft_rxc_prune()
	NV *restrict lgR = NULL, *restrict jenR = NULL;
	Newx(lgR, nrow + 1, NV);
	Newx(jenR, nrow + 1, NV);
	lgR[nrow] = jenR[nrow] = 0.0;
	for (int i = nrow - 1; i >= 0; i--) {
		lgR[i]  = lgR[i + 1]  + nv_lgamma((NV)R[i] + 1.0);
		jenR[i] = jenR[i + 1] + ft_even_split_lc(R[i], ncol);
	}

	ft_rxc_ctx X;
	X.nrow = nrow; X.ncol = ncol; X.R = R; X.C_rem = C;
	X.lgR = lgR; X.jenR = jenR;
	X.const_term = const_term;
	X.log_p_obs_tol = (const_term - obs_lc) + nv_log1p(1e-7);
	X.p_total = 0.0;
	X.nodes = 0; X.cap = 50000000LL; X.aborted = 0;

	ft_rxc_row(&X, 0, 0, R[0], 0.0);

	NV p = X.aborted ? -1.0 : X.p_total;
	if (p > 1.0) p = 1.0;
	Safefree(R); Safefree(C); Safefree(lgR); Safefree(jenR);
	return p;
}

// qsort comparator: order (key,value) pairs by their string key
typedef struct { const char *k; SV *v; } ft_kv;
static int ft_kv_cmp(const void *a, const void *b) {
	return strcmp(((const ft_kv *)a)->k, ((const ft_kv *)b)->k);
}

// small helper: fetch a nonnegative integer cell from an SV, with validation
static long ft_cell(pTHX_ SV *sv, const char *what) {
	if (!sv || !SvOK(sv)) croak("fisher_test: %s is undef", what);
	if (!looks_like_number(sv)) croak("fisher_test: %s is not a number", what);
	IV v = SvIV(sv);
	if (v < 0) croak("fisher_test: %s must be nonnegative (got %" IVdf ")", what, v);
	return (long)v;
}

/* R accumulates every sum inside chisq.test() -- sum(), rowSums(), colSums()
 -- in an LDOUBLE, i.e. a long double, and only rounds back to a double when
 the result is stored.  Doing the same here is what makes the statistic agree
 with R in its last bits rather than a couple of ulp away; a plain NV
 accumulator drifts on any table with more than a handful of cells.  On a
 __float128 perl the NV is already wider than a long double, so it stays the
 accumulator.*/
#ifdef USE_QUADMATH
typedef NV ct_acc_t;
#else
typedef long double ct_acc_t;
#endif

/* av_fetch() returns NULL for a hole in a sparse array (@a = (1,2,3) after
 delete $a[1]), so the SV** it hands back cannot be dereferenced blind.
 The chisq_test readers below treat a hole as the undef it prints as.*/
static SV *ct_av_get(pTHX_ AV *av, SSize_t i) {
	SV **p = av_fetch(av, i, 0);
	return p ? *p : NULL;
}

/* chisq_test cell reader.  R's chisq.test() refuses to coerce: every entry of
 'x' has to be a nonnegative finite number ("all entries of 'x' must be
 nonnegative and finite"), and an undef or a string is an error rather than a
 silent zero.  Kept in one place so the array, hash and collapsed-matrix paths
 cannot drift apart.  Counts are read as NV, not IV, because R accepts
 non-integer weights here too.*/
static NV ct_cell(pTHX_ SV *sv, const char *what) {
	if (!sv || !SvOK(sv)) croak("chisq_test: %s is undef", what);
	if (!looks_like_number(sv)) croak("chisq_test: %s is not a number", what);
	NV v = SvNV(sv);
	if (!nv_isfinite(v) || v < 0.0)
		croak("chisq_test: all entries of 'x' must be nonnegative and finite (%s)", what);
	return v;
}

// chisq_test 'p' reader: a probability, so nonnegative and finite (R: "probabilities must be non-negative.")
static NV ct_prob(pTHX_ SV *sv, const char *what) {
	if (!sv || !SvOK(sv)) croak("chisq_test: %s is undef", what);
	if (!looks_like_number(sv)) croak("chisq_test: %s is not a number", what);
	NV v = SvNV(sv);
	if (!nv_isfinite(v) || v < 0.0) croak("chisq_test: probabilities must be non-negative");
	return v;
}

/*Helpers for lm Linear Regression: OLS Matrix Math & Formula Parsing
-
 Sweep operator for symmetric positive-definite matrices (e.g., XtX).
 This gracefully handles collinearity by bypassing aliased columns.
 Utilizes a relative tolerance check to prevent dropping micro-variance features.*/
static int sweep_matrix_ols(NV *restrict A, size_t n, bool *restrict aliased) {
	int rank = 0;
	NV *restrict orig_diag = (NV*)safemalloc(n * sizeof(NV));
	// Save the original diagonal values to use as a baseline for relative variance
	for (size_t k = 0; k < n; k++) {
		aliased[k] = FALSE;
		orig_diag[k] = A[k * n + k];
	}
	for (size_t k = 0; k < n; k++) {
		/* Check pivot for collinearity using a RELATIVE tolerance
		 (Fallback to a tiny absolute tolerance of 1e-24 to catch literal zero vectors)*/
		if (nv_fabs(A[k * n + k]) <= 1e-10 * orig_diag[k] || nv_fabs(A[k * n + k]) < 1e-24) {
			aliased[k] = TRUE;
			// Isolate this column so it doesn't affect the rest of the matrix
			for (size_t i = 0; i < n; i++) { 
				A[k * n + i] = 0.0; 
				A[i * n + k] = 0.0; 
			}
			continue;
		}
		rank++;
		NV pivot = 1.0 / A[k * n + k];
		A[k * n + k] = 1.0;
		for (size_t j = 0; j < n; j++) A[k * n + j] *= pivot;
		for (size_t i = 0; i < n; i++) {
			if (i != k && A[i * n + k] != 0.0) {
				  NV factor = A[i * n + k];
				  A[i * n + k] = 0.0;
				  for (size_t j = 0; j < n; j++) {
					   A[i * n + j] -= factor * A[k * n + j];
				  }
			}
		}
	}
	Safefree(orig_diag);
	return rank;
}

// Internal extractor resolving single data values. Returns NAN on missing or non-numeric.
static NV get_data_value(pTHX_ HV *data_hoa, HV **row_hashes, unsigned int i, const char *var) {
	SV **val = NULL;
	if (row_hashes) {
		val = hv_fetch(row_hashes[i], var, strlen(var), 0);
		if (val && SvROK(*val) && SvTYPE(SvRV(*val)) == SVt_PVAV) {
			AV*av = (AV*)SvRV(*val);
			val = av_fetch(av, 0, 0);
		}
	} else if (data_hoa) {
		SV**col = hv_fetch(data_hoa, var, strlen(var), 0);
		if (col && SvROK(*col) && SvTYPE(SvRV(*col)) == SVt_PVAV) {
			AV*av = (AV*)SvRV(*col);
			val = av_fetch(av, i, 0);
		}
	}
	if (val && SvOK(*val)) {
		if (looks_like_number(*val)) return SvNV(*val);
		return NAN; // Catch strings like "blue"
	}
	return NAN; // Catch undef/missing keys
}

// Helper: Get all available columns for the '.' operator expansion
static AV* get_all_columns(pTHX_ HV *data_hoa, HV **row_hashes, size_t n) {
	AV *cols = newAV();
	if (data_hoa) {
		hv_iterinit(data_hoa);
		HE *entry;
		while ((entry = hv_iternext(data_hoa))) {
			av_push(cols, newSVsv(hv_iterkeysv(entry)));
		}
	} else if (row_hashes && n > 0 && row_hashes[0]) {
		hv_iterinit(row_hashes[0]);
		HE *entry;
		while ((entry = hv_iternext(row_hashes[0]))) {
			av_push(cols, newSVsv(hv_iterkeysv(entry)));
		}
	}
	return cols;
}

// Recursive formula resolver with tightened NaN and Null handling
static NV evaluate_term(pTHX_ HV *data_hoa, HV **row_hashes, unsigned int i, const char *term) {
	if (!term || term[0] == '\0') return NAN;

	char *term_cpy = savepv(term); 
	char *colon = strchr(term_cpy, ':');
	if (colon) {
		*colon = '\0';
		NV left = evaluate_term(aTHX_ data_hoa, row_hashes, i, term_cpy);
		NV right = evaluate_term(aTHX_ data_hoa, row_hashes, i, colon + 1);
		Safefree(term_cpy); 
		if (nv_isnan(left) || nv_isnan(right)) return NAN;
		return left * right;
	}
	if (strncmp(term_cpy, "I(", 2) == 0) {
		char *end = strrchr(term_cpy, ')');
		if (end) *end = '\0';
		char *inner = term_cpy + 2;
		char *caret = strchr(inner, '^');
		int power = 1;
		if (caret) {
			*caret = '\0';
			power = atoi(caret + 1);
		}
		NV v = get_data_value(aTHX_ data_hoa, row_hashes, i, inner);
		Safefree(term_cpy); 

		if (nv_isnan(v)) return NAN;
		return power == 1 ? v : nv_pow(v, power);
	}
	NV result = get_data_value(aTHX_ data_hoa, row_hashes, i, term_cpy);
	Safefree(term_cpy); 
	return result;
}

// Helper to infer column type from its first valid element
static bool is_column_categorical(pTHX_ HV *data_hoa, HV **row_hashes, size_t n, const char *var) {
	for (size_t i = 0; i < n; i++) {
		SV **val = NULL;
		if (row_hashes) {
			val = hv_fetch(row_hashes[i], var, strlen(var), 0);
			if (val && SvROK(*val) && SvTYPE(SvRV(*val)) == SVt_PVAV) {
				 AV*av = (AV*)SvRV(*val);
				 val = av_fetch(av, 0, 0);
			}
		} else if (data_hoa) {
			SV **col = hv_fetch(data_hoa, var, strlen(var), 0);
			if (col && SvROK(*col) && SvTYPE(SvRV(*col)) == SVt_PVAV) {
				 AV*av = (AV*)SvRV(*col);
				 val = av_fetch(av, i, 0);
			}
		}
		if (val && SvOK(*val)) {
			if (looks_like_number(*val)) return FALSE; // First valid is number -> Numeric Column
			return TRUE; // First valid is string -> Categorical Column
		}
	}
	return FALSE;
}

//Internal extractor resolving single data string values using dynamic allocation.
static char* get_data_string_alloc(pTHX_ HV *data_hoa, HV **row_hashes, size_t i, const char *var) {
	SV **val = NULL;
	if (row_hashes) {
		val = hv_fetch(row_hashes[i], var, strlen(var), 0);
		if (val && SvROK(*val) && SvTYPE(SvRV(*val)) == SVt_PVAV) {
			AV*av = (AV*)SvRV(*val);
			val = av_fetch(av, 0, 0);
		}
	} else if (data_hoa) {
		SV **col = hv_fetch(data_hoa, var, strlen(var), 0);
		if (col && SvROK(*col) && SvTYPE(SvRV(*col)) == SVt_PVAV) {
			AV*av = (AV*)SvRV(*col);
			val = av_fetch(av, i, 0);
		}
	}
	if (val && SvOK(*val)) {
		return savepv(SvPV_nolen(*val)); //Allocates and returns string
	}
	return NULL;
}

/*Design-matrix construction, shared by lm() and glm().

 A model term is a set of variables: "wt" is one, "wt:hp" is two, and a
 variable holding strings is a factor that expands to indicator columns. The
 question each factor raises is whether to emit a column for every level or to
 drop the first as a reference, and R answers it with the margin rule:

   The factor f inside term T is coded by contrasts -- reference level dropped
   -- when T with f removed is itself a term of the model, and by full
   indicators when it is not. The empty margin, which is what a main effect
   reduces to once its own variable is removed, counts as present whenever the
   model has an intercept. Without an intercept it counts as present only
   after the first factor main effect has consumed it.

 That one rule reproduces R everywhere:

   y ~ g          g's margin is empty and the intercept supplies it, so g is
                  coded by contrasts: gb, gc.
   y ~ g - 1      nothing supplies the empty margin, so g is coded in full:
                  ga, gb, gc. This is the case that used to lose a level and
                  fit a model forcing the reference group's fitted values to 0.
   y ~ a + b - 1  a consumes the empty margin and is coded in full; b then
                  finds it present and is coded by contrasts. Coding both in
                  full would be rank deficient.
   y ~ a * b      both main effects are present, so both components of a:b are
                  coded by contrasts: aB:bY.
   y ~ a:b        neither main effect is present, so both components are coded
                  in full and the term spans the whole cross-classification.

Terms are ordered by degree first, as R's terms() does, so that a margin is
always decided against terms that precede it.*/

// Defined further down, next to the other qsort comparators
static int cmp_string_wt(const void *a, const void *b);

//One component of one design column.
typedef struct {
	int         fbase; //index into LmDesign.factor, or -1 when continuous
	const char *level; //borrowed from LmFactor.level, when fbase >= 0
	const char *expr;  //borrowed from LmDesign.var,   when fbase <  0
} LmComp;

typedef struct {
	char        *name;
	char       **level;
	unsigned int nlevel;
} LmFactor;

typedef struct {
	char        *name; //the coefficient name, e.g. "woolB:tensionM"
	LmComp      *comp;
	unsigned int ncomp; //0 marks the intercept column
} LmCol;

typedef struct {
	LmFactor    *factor;
	unsigned int nfactor;
	LmCol       *col;
	unsigned int ncol;
	char       **var;  //every distinct variable named by any term
	unsigned int nvar;
	char       **raw;  //scratch: this row's raw level per factor
} LmDesign;

static void lm_design_free(pTHX_ LmDesign *d) {
	unsigned int i, j;
	if (!d) return;
	if (d->factor) {
		for (i = 0; i < d->nfactor; i++) {
			if (d->factor[i].level) {
				for (j = 0; j < d->factor[i].nlevel; j++)
					Safefree(d->factor[i].level[j]);
				Safefree(d->factor[i].level);
			}
			Safefree(d->factor[i].name);
		}
		Safefree(d->factor);
	}
	if (d->col) {
		for (i = 0; i < d->ncol; i++) {
			Safefree(d->col[i].name);
			if (d->col[i].comp) Safefree(d->col[i].comp);
		}
		Safefree(d->col);
	}
	if (d->var) {
		for (i = 0; i < d->nvar; i++) Safefree(d->var[i]);
		Safefree(d->var);
	}
	if (d->raw) Safefree(d->raw);
	Safefree(d);
}

/*Split a term on top-level ':' only, so that a ':' inside I(...) is left
alone. Returns the component count and fills starts[]/lens[].*/
static unsigned int lm_split_term(const char *restrict term,
                                  const char **restrict starts,
                                  size_t *restrict lens,
                                  unsigned int cap) {
	unsigned int n = 0;
	int depth = 0;
	const char *restrict p = term, *start = term;
	for (;; p++) {
		if (*p == '(') depth++;
		else if (*p == ')') { if (depth > 0) depth--; }
		if ((*p == ':' && depth == 0) || *p == '\0') {
			if (n < cap) { starts[n] = start; lens[n] = (size_t)(p - start); }
			n++;
			if (*p == '\0') break;
			start = p + 1;
		}
	}
	return n;
}

/*Build the design description for a set of unique model terms. Returns NULL
only on an allocation path that cannot happen; croaks nowhere, so callers can
free their own state. xlevels_hv, when non-NULL, receives every factor's
sorted level list.*/
static LmDesign *lm_design_build(pTHX_ HV *data_hoa,
                                 HV **row_hashes, size_t n,
                                 char **uniq_terms,
                                 unsigned int num_uniq,
                                 bool has_intercept,
                                 HV *xlevels_hv) {
	LmDesign *d;
	unsigned int i, j, k, t, c, max_comp = 0, tcount = 0, col_cap, comp_cap;
	unsigned int *restrict tstart = NULL, *restrict tlen = NULL;
	unsigned int *restrict tvar = NULL;      //flat variable indices per term
	int          *restrict vfac = NULL;      //variable -> factor index or -1
	unsigned int  nwords;
	UV           *restrict tmask = NULL, *restrict margin = NULL;
	bool         *restrict full = NULL;      //per flat component: full coding?
	bool          empty_present = has_intercept;

	Newxz(d, 1, LmDesign);

	//pass 1: intern variables, record each term's component list
	for (i = 0; i < num_uniq; i++) {
		if (strEQ(uniq_terms[i], "Intercept")) continue;
		max_comp += lm_split_term(uniq_terms[i], NULL, NULL, 0);
		tcount++;
	}
	if (max_comp == 0) max_comp = 1;
	Newxz(tstart, tcount ? tcount : 1, unsigned int);
	Newxz(tlen,   tcount ? tcount : 1, unsigned int);
	Newxz(tvar,   max_comp, unsigned int);
	Newxz(d->var, max_comp, char*);

	{
		const char **restrict cs = NULL;
		size_t      *restrict cl = NULL;
		unsigned int flat = 0;
		Newxz(cs, max_comp, const char*);
		Newxz(cl, max_comp, size_t);
		t = 0;
		for (i = 0; i < num_uniq; i++) {
			unsigned int nc;
			if (strEQ(uniq_terms[i], "Intercept")) continue;
			nc = lm_split_term(uniq_terms[i], cs, cl, max_comp);
			tstart[t] = flat;
			tlen[t]   = nc;
			for (c = 0; c < nc; c++) {
				char *nm;
				bool found = FALSE;
				Newx(nm, cl[c] + 1, char);
				memcpy(nm, cs[c], cl[c]);
				nm[cl[c]] = '\0';
				for (j = 0; j < d->nvar; j++) {
					if (strEQ(d->var[j], nm)) { tvar[flat] = j; found = TRUE; break; }
				}
				if (found) Safefree(nm);
				else { d->var[d->nvar] = nm; tvar[flat] = d->nvar; d->nvar++; }
				flat++;
			}
			t++;
		}
		Safefree(cs); Safefree(cl);
	}

	// pass 2: which variables are factors, and what are their levels
	Newxz(vfac, d->nvar ? d->nvar : 1, int);
	Newxz(d->factor, d->nvar ? d->nvar : 1, LmFactor);
	for (j = 0; j < d->nvar; j++) {
		vfac[j] = -1;
		if (!is_column_categorical(aTHX_ data_hoa, row_hashes, n, d->var[j])) continue;
		{
			char       **levels = NULL;
			unsigned int nlev = 0, cap = 8;
			Newx(levels, cap, char*);
			for (i = 0; i < n; i++) {
				char *s = get_data_string_alloc(aTHX_ data_hoa, row_hashes,
				                                         i, d->var[j]);
				if (!s) continue;
				{
					bool found = FALSE;
					for (k = 0; k < nlev; k++)
						if (strEQ(levels[k], s)) { found = TRUE; break; }
					if (!found) {
						if (nlev >= cap) { cap *= 2; Renew(levels, cap, char*); }
						levels[nlev++] = savepv(s);
					}
				}
				Safefree(s);
			}
			/*A column of strings with nothing readable in it is no use as a
			factor; fall back to treating it as continuous, which is what
			this code did before factors were expanded per component.*/
			if (nlev == 0) { Safefree(levels); continue; }
			qsort(levels, nlev, sizeof(char*), cmp_string_wt);
			vfac[j] = (int)d->nfactor;
			d->factor[d->nfactor].name   = savepv(d->var[j]);
			d->factor[d->nfactor].level  = levels;
			d->factor[d->nfactor].nlevel = nlev;
			d->nfactor++;
			if (xlevels_hv) {
				AV *lv = newAV();
				for (k = 0; k < nlev; k++) av_push(lv, newSVpv(levels[k], 0));
				hv_store(xlevels_hv, d->var[j], (I32)strlen(d->var[j]),
				         newRV_noinc((SV*)lv), 0);
			}
		}
	}

	//pass 3: order terms by degree, as R's terms() does
	{
		unsigned int *restrict order = NULL;
		unsigned int w = 0, deg;
		Newxz(order, tcount ? tcount : 1, unsigned int);
		for (deg = 1; deg <= max_comp; deg++)
			for (t = 0; t < tcount; t++)
				if (tlen[t] == deg) order[w++] = t;
		/*Any term whose degree somehow exceeded max_comp would be dropped, so
		sweep up the remainder rather than losing it.*/
		if (w < tcount)
			for (t = 0; t < tcount; t++) {
				bool seen = FALSE;
				for (i = 0; i < w; i++) if (order[i] == t) { seen = TRUE; break; }
				if (!seen) order[w++] = t;
			}
		{
			unsigned int *restrict ns = NULL, *restrict nl = NULL;
			Newxz(ns, tcount ? tcount : 1, unsigned int);
			Newxz(nl, tcount ? tcount : 1, unsigned int);
			for (i = 0; i < tcount; i++) { ns[i] = tstart[order[i]]; nl[i] = tlen[order[i]]; }
			Safefree(tstart); Safefree(tlen);
			tstart = ns; tlen = nl;
		}
		Safefree(order);
	}
	// pass 4: the margin rule
	nwords = (d->nvar + (unsigned int)(8 * sizeof(UV)) - 1) / (unsigned int)(8 * sizeof(UV));
	if (nwords == 0) nwords = 1;
	Newxz(tmask,  (size_t)tcount * nwords + nwords, UV);
	Newxz(margin, nwords, UV);
	Newxz(full,   max_comp, bool);
	for (t = 0; t < tcount; t++)
		for (c = 0; c < tlen[t]; c++) {
			unsigned int v = tvar[tstart[t] + c];
			tmask[(size_t)t * nwords + v / (8 * sizeof(UV))] |=
				((UV)1 << (v % (8 * sizeof(UV))));
		}
	for (t = 0; t < tcount; t++) {
		for (c = 0; c < tlen[t]; c++) {
			unsigned int v = tvar[tstart[t] + c];
			bool present = FALSE, empty = TRUE;
			if (vfac[v] < 0) continue;              //continuous: nothing to code
			for (i = 0; i < nwords; i++) margin[i] = tmask[(size_t)t * nwords + i];
			margin[v / (8 * sizeof(UV))] &= ~((UV)1 << (v % (8 * sizeof(UV))));
			for (i = 0; i < nwords; i++) if (margin[i]) { empty = FALSE; break; }
			if (empty) {
				present = empty_present;
				if (!present) empty_present = TRUE;  //consumed by this term
			} else {
				for (k = 0; k < t && !present; k++) {
					bool same = TRUE;
					for (i = 0; i < nwords; i++)
						if (tmask[(size_t)k * nwords + i] != margin[i]) { same = FALSE; break; }
					present = same;
				}
			}
			full[tstart[t] + c] = !present;
		}
	}

	//pass 5: emit the columns
	col_cap = 16; comp_cap = 4;
	Newxz(d->col, col_cap, LmCol);
	if (has_intercept) {
		d->col[0].name = savepv("Intercept");
		d->col[0].comp = NULL;
		d->col[0].ncomp = 0;
		d->ncol = 1;
	}
	for (t = 0; t < tcount; t++) {
		unsigned int nc = tlen[t];
		unsigned int *restrict lo = NULL, *restrict hi = NULL, *restrict at = NULL;
		size_t combos = 1;
		if (nc > comp_cap) comp_cap = nc;
		Newxz(lo, nc ? nc : 1, unsigned int);
		Newxz(hi, nc ? nc : 1, unsigned int);
		Newxz(at, nc ? nc : 1, unsigned int);
		for (c = 0; c < nc; c++) {
			int f = vfac[tvar[tstart[t] + c]];
			if (f < 0) { lo[c] = 0; hi[c] = 1; }
			else {
				lo[c] = full[tstart[t] + c] ? 0 : 1;
				hi[c] = d->factor[f].nlevel;
			}
			if (hi[c] <= lo[c]) { combos = 0; break; }
			combos *= (size_t)(hi[c] - lo[c]);
		}
		/*combos == 0 happens for a single-level factor coded by contrasts:
		the term contributes nothing, exactly as before.*/
		for (c = 0; c < nc; c++) at[c] = lo[c];
		while (combos > 0) {
			size_t len = 0;
			char *nm = NULL;
			LmComp *restrict cm = NULL;
			if (d->ncol >= col_cap) {
				col_cap *= 2;
				Renew(d->col, col_cap, LmCol);
				for (i = d->ncol; i < col_cap; i++) {
					d->col[i].name = NULL; d->col[i].comp = NULL; d->col[i].ncomp = 0;
				}
			}
			Newxz(cm, nc ? nc : 1, LmComp);
			for (c = 0; c < nc; c++) {
				int f = vfac[tvar[tstart[t] + c]];
				if (f < 0) {
					cm[c].fbase = -1;
					cm[c].expr  = d->var[tvar[tstart[t] + c]];
					cm[c].level = NULL;
					len += strlen(cm[c].expr);
				} else {
					cm[c].fbase = f;
					cm[c].level = d->factor[f].level[at[c]];
					cm[c].expr  = NULL;
					len += strlen(d->factor[f].name) + strlen(cm[c].level);
				}
			}
			len += nc;                       //separators and the NUL
			Newxz(nm, len + 1, char);
			for (c = 0; c < nc; c++) {
				if (c) strcat(nm, ":");
				if (cm[c].fbase < 0) strcat(nm, cm[c].expr);
				else {
					strcat(nm, d->factor[cm[c].fbase].name);
					strcat(nm, cm[c].level);
				}
			}
			d->col[d->ncol].name  = nm;
			d->col[d->ncol].comp  = cm;
			d->col[d->ncol].ncomp = nc;
			d->ncol++;
			/*Odometer, leftmost component fastest, which is R's column order
			within a term.*/
			for (c = 0; c < nc; c++) {
				at[c]++;
				if (at[c] < hi[c]) break;
				at[c] = lo[c];
			}
			if (c == nc) break;
		}
		Safefree(lo); Safefree(hi); Safefree(at);
	}

	if (d->nfactor) Newxz(d->raw, d->nfactor, char*);

	Safefree(tstart); Safefree(tlen); Safefree(tvar);
	Safefree(vfac); Safefree(tmask); Safefree(margin); Safefree(full);
	return d;
}

/*Expand one `*`-crossed chunk of a formula into model terms.

`a*b` is a + b + a:b, and crossing is associative, so `a*b*c` is every
non-empty subset: a, b, c, a:b, a:c, b:c, a:b:c. Subsets are emitted by
increasing degree and, within a degree, in the left-to-right order of the
formula, which is the order R's terms() produces. A chunk with no `*` is one
term and is appended unchanged.

`^` is crossing rather than exponentiation in a formula, so a trailing `^n` on
a component is dropped -- `hp^2` is just hp -- unless the component is an
I(...) escape, where the caret is arithmetic and belongs to evaluate_term.

chunk is written through: the separators become NULs.*/
static void lm_expand_cross(pTHX_ char *chunk,
                            const char *fname,
                            char ***terms,
                            unsigned int *num_terms,
                            unsigned int *term_cap) {
	char *part[16];
	unsigned int k = 0, i;
	UV mask, limit;
	char *s = chunk;

	for (;;) {
		char *star = strchr(s, '*');
		if (k >= (unsigned int)(sizeof(part) / sizeof(part[0])))
			croak("%s: formula crosses more than %u terms with '*'", fname,
			      (unsigned int)(sizeof(part) / sizeof(part[0])));
		if (star) *star = '\0';
		{
			char *caret = strchr(s, '^');
			if (caret && strncmp(s, "I(", 2) != 0) *caret = '\0';
		}
		part[k++] = s;
		if (!star) break;
		s = star + 1;
	}

	limit = (UV)1 << k;
	//Grow once for the worst case rather than testing inside the loop.
	if (*num_terms + (limit - 1) + 1 >= (UV)*term_cap) {
		while ((UV)*term_cap <= *num_terms + limit) *term_cap *= 2;
		Renew(*terms, *term_cap, char*);
	}
	for (i = 1; i <= k; i++) {                    //degree
		for (mask = 1; mask < limit; mask++) {
			unsigned int bits = 0, b;
			size_t len = 0;
			char *nm;
			for (b = 0; b < k; b++) if (mask & ((UV)1 << b)) bits++;
			if (bits != i) continue;
			for (b = 0; b < k; b++)
				if (mask & ((UV)1 << b)) len += strlen(part[b]) + 1;
			Newxz(nm, len + 1, char);
			for (b = 0; b < k; b++) {
				if (!(mask & ((UV)1 << b))) continue;
				if (*nm) strcat(nm, ":");
				strcat(nm, part[b]);
			}
			(*terms)[(*num_terms)++] = nm;
		}
	}
}

/*Fill one row of the design matrix. Returns FALSE when the row is incomplete,
i.e. when any factor it needs has no readable value or any continuous term
evaluates to NaN; the caller drops such rows, as R's na.omit does.*/
static bool lm_design_row(pTHX_ LmDesign *d, HV *data_hoa,
                          HV **row_hashes, size_t i,
                          NV *out) {
	unsigned int f, j, c;
	bool ok = TRUE;
	for (f = 0; f < d->nfactor; f++) {
		d->raw[f] = get_data_string_alloc(aTHX_ data_hoa, row_hashes, i,
		                                  d->factor[f].name);
		if (!d->raw[f]) ok = FALSE;
	}
	if (ok) {
		for (j = 0; j < d->ncol && ok; j++) {
			NV v = 1.0;
			for (c = 0; c < d->col[j].ncomp; c++) {
				const LmComp *cm = &d->col[j].comp[c];
				if (cm->fbase >= 0) {
					v *= strEQ(d->raw[cm->fbase], cm->level) ? 1.0 : 0.0;
				} else {
					NV e = evaluate_term(aTHX_ data_hoa, row_hashes,
					                     (unsigned int)i, cm->expr);
					if (nv_isnan(e)) { ok = FALSE; break; }
					v *= e;
				}
			}
			out[j] = v;
		}
	}
	for (f = 0; f < d->nfactor; f++) {
		if (d->raw[f]) { Safefree(d->raw[f]); d->raw[f] = NULL; }
	}
	return ok;
}

// Struct for sorting p-values while remembering their original index
typedef struct {
	NV p;
	size_t orig_idx;
} PVal;

// Comparator for qsort
static int cmp_pval(const void *a, const void *b) {
	NV diff = ((PVal*)a)->p - ((PVal*)b)->p;
	if (diff < 0) return -1;
	if (diff > 0) return 1;
	/*Stabilize sort by falling back to original index. Compare as size_t
	rather than returning the subtraction: orig_idx is unsigned, so
	a - b would wrap and then truncate to int with the wrong sign.*/
	size_t ai = ((PVal*)a)->orig_idx, bi = ((PVal*)b)->orig_idx;
	return (ai > bi) - (ai < bi);
}

/*p_adjust() helpers
p_adjust() takes either a flat list of p-values or a whole data frame
(AoA, AoH, HoA or HoH). Either way the p-values are gathered into one
family, run through the same kernel, and written back into slots reserved
while walking the input, so the result comes out in the shape and the
order it arrived in.*/

#define PA_METH_LEN 64

// Lowercase `method` into `out` (PA_METH_LEN bytes) and resolve its aliases
static void pa_method(const char *method, char *out) {
	strncpy(out, method, PA_METH_LEN - 1); out[PA_METH_LEN - 1] = '\0';
	for (unsigned short int i = 0; out[i]; i++) out[i] = tolower(out[i]);
	if (strstr(out, "benjamini") && strstr(out, "hochberg"))  strcpy(out, "bh");
	if (strstr(out, "benjamini") && strstr(out, "yekutieli")) strcpy(out, "by");
	if (strcmp(out, "fdr") == 0) strcpy(out, "bh");
}

static int pa_known(const char *meth) {
	return strcmp(meth, "bonferroni") == 0 || strcmp(meth, "holm")   == 0
	    || strcmp(meth, "hochberg")   == 0 || strcmp(meth, "bh")     == 0
	    || strcmp(meth, "by")         == 0 || strcmp(meth, "hommel") == 0
	    || strcmp(meth, "none")       == 0;
}

/*Adjust n p-values. p[] and adj[] are indexed identically and must not
alias; `meth` is already normalized and known to pa_known().*/
static void pa_kernel(const NV *p, NV *adj, size_t n,
                      const char *meth) {
	PVal *arr;
	Newx(arr, n, PVal);
	for (size_t i = 0; i < n; i++) { arr[i].p = p[i]; arr[i].orig_idx = i; }
	// Sort ascending (stable sort using the original index)
	qsort(arr, n, sizeof(PVal), cmp_pval);

	if (strcmp(meth, "bonferroni") == 0) {
		for (size_t i = 0; i < n; i++) {
			NV v = arr[i].p * n;
			adj[arr[i].orig_idx] = (v < 1.0) ? v : 1.0;
		}
	} else if (strcmp(meth, "holm") == 0) {
		NV cummax = 0.0;
		for (size_t i = 0; i < n; i++) {
			 NV v = arr[i].p * (n - i);
			 if (v > cummax) cummax = v;
			 adj[arr[i].orig_idx] = (cummax < 1.0) ? cummax : 1.0;
		}
	} else if (strcmp(meth, "hochberg") == 0) {
		NV cummin = 1.0;
		for (ssize_t i = n - 1; i >= 0; i--) {
			 NV v = arr[i].p * (n - i);
			 if (v < cummin) cummin = v;
			 adj[arr[i].orig_idx] = (cummin < 1.0) ? cummin : 1.0;
		}
	} else if (strcmp(meth, "bh") == 0) {
		NV cummin = 1.0;
		for (ssize_t i = n - 1; i >= 0; i--) {
			NV v = arr[i].p * n / (i + 1.0);
			if (v < cummin) cummin = v;
			adj[arr[i].orig_idx] = (cummin < 1.0) ? cummin : 1.0;
		}
	} else if (strcmp(meth, "by") == 0) {
		NV q = 0.0;
		for (size_t i = 1; i <= n; i++) q += 1.0 / i;
		NV cummin = 1.0;
		for (ssize_t i = n - 1; i >= 0; i--) {
			NV v = arr[i].p * n / (i + 1.0) * q;
			if (v < cummin) cummin = v;
			adj[arr[i].orig_idx] = (cummin < 1.0) ? cummin : 1.0;
		}
	} else if (strcmp(meth, "hommel") == 0) {
		NV *pa, *q_arr;
		Newx(pa, n, NV);
		Newx(q_arr, n, NV);
		// Initial: min(n * p[i] / (i + 1))
		NV min_val = n * arr[0].p;
		for (size_t i = 1; i < n; i++) {
			NV temp = (n * arr[i].p) / (i + 1.0);
			if (temp < min_val) {
			   min_val = temp;
			}
		}
		// pa <- q <- rep(min, n)
		for (size_t i = 0; i < n; i++) {
			 pa[i] = min_val;
			 q_arr[i] = min_val;
		}
		for (size_t j = n - 1; j >= 2; j--) {
			 ssize_t n_mj = n - j;       // Max index for 'ij'. Length is n_mj + 1
			 ssize_t i2_len = j - 1;     // Length of 'i2
			 // Calculate q1 = min(j * p[i2] / (2:j))
			 NV q1 = (j * arr[n_mj + 1].p) / 2.0;
			 for (size_t k = 1; k < i2_len; k++) {
				 NV temp_q1 = (j * arr[n_mj + 1 + k].p) / (2.0 + k);
				 if (temp_q1 < q1) {
					 q1 = temp_q1;
				 }
			 }
			 // q[ij] <- pmin(j * p[ij], q1)
			 for (size_t i = 0; i <= n_mj; i++) {
				 NV v = j * arr[i].p;
				 q_arr[i] = (v < q1) ? v : q1;
			 }
			 // q[i2] <- q[n - j]
			 for (size_t i = 0; i < i2_len; i++) {
				 q_arr[n_mj + 1 + i] = q_arr[n_mj];
			}
			 // pa <- pmax(pa, q)
			for (size_t i = 0; i < n; i++) {
				if (pa[i] < q_arr[i]) {
				   pa[i] = q_arr[i];
				}
			}
		}
		// pmin(1, pmax(pa, p))[ro] — map sorted results back to original indices
		for (size_t i = 0; i < n; i++) {
			NV v = (pa[i] > arr[i].p) ? pa[i] : arr[i].p;
			if (v > 1.0) v = 1.0;
			adj[arr[i].orig_idx] = v;
		}
		Safefree(pa);  Safefree(q_arr);
	} else {   //"none" — pa_known() already rejected anything else
		for (size_t i = 0; i < n; i++) {
			adj[arr[i].orig_idx] = arr[i].p;
		}
	}
	Safefree(arr);
}

/*Order hash entries by key, so that tied p-values break the same way on
every run instead of following hash iteration order.*/
static int pa_cmp_he(const void *a, const void *b) {
	HE *const ha = *(HE * const *)a;
	HE *const hb = *(HE * const *)b;
	STRLEN la, lb;
	const char *ka, *kb;
/*Read the key bytes straight out of the entry. HePV would do the same,
except for an SV key, where it goes through SvPV -- and SvPV wants the
interpreter context, which qsort has no way to hand a comparator. On a
threaded or MULTIPLICITY perl that is a compile error, so take the SV
key branch ourselves and pay for a dTHX only there.*/
	if (HeKLEN(ha) == HEf_SVKEY || HeKLEN(hb) == HEf_SVKEY) {
		dTHX;
		ka = HePV(ha, la);
		kb = HePV(hb, lb);
	} else {
		ka = HeKEY(ha);  la = (STRLEN)HeKLEN(ha);
		kb = HeKEY(hb);  lb = (STRLEN)HeKLEN(hb);
	}
	STRLEN m = la < lb ? la : lb;
	int c = m ? memcmp(ka, kb, m) : 0;
	if (c) return c;
	return (la > lb) - (la < lb);
}

static SSize_t pa_sorted_keys(pTHX_ HV *hv, HE **out) {
	SSize_t k = 0;
	HE *e;
	hv_iterinit(hv);
	while ((e = hv_iternext(hv))) out[k++] = e;
	qsort(out, (size_t)k, sizeof(HE*), pa_cmp_he);
	return k;
}

/*Is this column one of the ones holding p-values? `want == NULL` means the
caller named none, so every column counts. Returns the marker SV for the
column and flags it as seen, so an unmatched name can be reported.*/
static SV *pa_mark(pTHX_ HV *want, const char *key,
                   STRLEN klen, U32 utf8) {
	if (!want) return &PL_sv_yes;
	SV **m = hv_fetch(want, key, utf8 ? -(I32)klen : (I32)klen, 0);
	if (!m) return NULL;
	sv_setiv(*m, 1);
	return *m;
}

/*A cell in a frame must be a number or undef; anything else is far more
likely to be a label column the caller forgot to exclude than a p-value.*/
static void pa_check(pTHX_ SV *cell, const char *col, IV idx) {
	if (!cell || !SvOK(cell) || looks_like_number(cell)) return;
	if (col)
		croak("p_adjust: '%s' in column '%s' is not a p-value; name the columns "
		      "that hold p-values with columns => [...]", SvPV_nolen(cell), col);
	croak("p_adjust: '%s' in column %" IVdf " is not a p-value; name the columns "
	      "that hold p-values with columns => [...]", SvPV_nolen(cell), idx);
}

/*Reserve this cell's place in the family and return the SV that stands in
for it in the output frame until the adjusted value is written back.*/
static SV *pa_place(pTHX_ SV *cell, NV *pv,
                    SV **slots, size_t *k, size_t n) {
	NV p = (cell && SvOK(cell)) ? SvNV(cell) : 1.0;
	SV *place = newSVnv(p);
	if (*k < n) { pv[*k] = p; slots[(*k)++] = place; }
	return place;
}

static SV *pa_copy(pTHX_ SV *cell) {
	return cell ? newSVsv(cell) : newSV(0);
}

/*Helpers for cor(): ranking (Spearman), Pearson r, Kendall tau-b/
Item used to sort values while remembering their original index,
  needed for average-rank tie-breaking in Spearman correlation.*/
typedef struct {
	NV val;
	size_t idx;
} RankItem;
/*Ascending by value only. The index is carried, not compared: every member of
a tie group is given the same averaged rank, so their relative order cannot
reach the answer.*/
#define RANKITEM_LESS(a, b) ((a).val < (b).val)
LIKER_DEFINE_SORT(RankItem, rankitem, RANKITEM_LESS)

/*Compute 1-based average ranks with tie-breaking into out[].
in[] is not modified.

restrict on both: every caller ranks one buffer into a second, freshly
allocated one -- compute_cor() and cov()'s spearman branches, roc_delong()'s
three midrank calls, cor_test(), dunn_test(), and friedman_test()'s per-row
rank.*/
static void rank_data(const NV *restrict in, NV *restrict out, size_t n) {
	RankItem *ri;
	Newx(ri, n, RankItem);
	for (size_t i = 0; i < n; i++) { ri[i].val = in[i]; ri[i].idx = i; }
	rankitem_sort(ri, n);

	size_t i = 0;
	while (i < n) {
		size_t j = i;
		//Find the full extent of this tie group
		while (j + 1 < n && ri[j + 1].val == ri[j].val) j++;
		//All members get the average of ranks i+1 … j+1 (1-based)
		NV avg = (NV)(i + j) / 2.0 + 1.0;
		for (size_t k = i; k <= j; k++) out[ri[k].idx] = avg;
		i = j + 1;
	}
	Safefree(ri);
}

/*Pearson product-moment r between two n-element arrays.
Returns NAN when either variable has zero variance (matches R).*/
/*Pearson correlation, two-pass about the sample means.

The one-pass form this replaces -- (n*sxy - sx*sy) / sqrt((n*sx2 - sx^2) *
(n*sy2 - sy^2)) -- subtracts two nearly equal large numbers in each of its
three terms, so it loses a digit of the answer for every digit by which the
mean exceeds the spread.  On a column with mean 1e9 and spread 0.05 it does
not merely lose precision: n*sx2 - sx*sx comes out negative, the sqrt is NaN,
and cor() returns NaN for a perfectly ordinary pair of vectors.  R reports
0.063454463733801467 for that case (t/var_sd_cov.R.t, offset_1e9).

Centring first is what R does too -- cov.c sums (x - xm)*(y - ym) and the two
centred squares, never the raw cross-products -- and the trailing correction
terms are the same compensated two-pass identity nv_cov2() uses, with the
common 1/(n-1) cancelling between numerator and denominator.

No restrict: the matrix branch of cor() calls this once per column pair, and
while it never passes the same column twice (the diagonal is short-circuited
to 1.0), the contract is not worth pinning on that.*/
static NV pearson_corr(const NV *x, const NV *y, size_t n) {
	NV sx = 0, sy = 0;
	for (size_t i = 0; i < n; i++) { sx += x[i]; sy += y[i]; }
	{
		const NV mx = sx / n, my = sy / n;
		NV cx = 0, cy = 0, sxx = 0, syy = 0, sxy = 0;
		for (size_t i = 0; i < n; i++) {
			const NV dx = x[i] - mx, dy = y[i] - my;
			cx  += dx;      cy  += dy;
			sxx += dx * dx; syy += dy * dy; sxy += dx * dy;
		}
		{
			const NV vxx = sxx - cx * cx / n;
			const NV vyy = syy - cy * cy / n;
			const NV vxy = sxy - cx * cy / n;
			/*Rounding can leave a centred sum of squares a hair below zero on
			a constant column; sqrt() of that would be NaN where the honest
			answer is "no variance to correlate".*/
			const NV den = (vxx > 0.0 && vyy > 0.0) ? nv_sqrt(vxx * vyy) : 0.0;
			if (den == 0.0) return NV_NAN;
			return vxy / den;
		}
	}
}

/*Sample covariance of two equal-length NV columns, two-pass.

The single-pass Welford update this replaces carried two divides per element in
a loop-carried dependency chain, so each element waited on the previous one's
latency.  The two-pass form is also the one R computes: cov.c takes a mean per
column, refines it with a second pass (the MEAN macro, tmp = tmp + sum(x-tmp)/n)
and sums the centred products about the refined means.  Expanding that about
the unrefined means leaves sum(dx*dy) - sum(dx)*sum(dy)/n, so carrying the two
sums of deviations alongside the sum of their products gives R's answer without
the extra pass.

n >= 2 is the caller's to guarantee; cov() returns NaN below that before
reaching here.

No restrict, as in pearson_corr() above: nothing here is stored through, so
there is nothing for it to disambiguate, and cov(x, x) -- the variance -- is a
call a caller may legitimately make.*/
static NV nv_cov2(const NV *x, const NV *y, size_t n) {
	NV sx = 0.0, sy = 0.0;
	for (size_t i = 0; i < n; i++) { sx += x[i]; sy += y[i]; }
	{
		const NV mx = sx / n, my = sy / n;
		NV cx = 0.0, cy = 0.0, sxy = 0.0;
		for (size_t i = 0; i < n; i++) {
			const NV dx = x[i] - mx, dy = y[i] - my;
			cx += dx;
			cy += dy;
			sxy += dx * dy;
		}
		return (sxy - cx * cy / n) / (n - 1);
	}
}

//(x,y) pair sorted by x ascending, then y ascending — for Kendall's tau.
typedef struct { NV xv, yv; } KPair;
/*The y tiebreak is what makes the (x, y) tie blocks contiguous, so the scan
in kendall_tau_b() can count pairs of equal x and pairs of equal (x, y) in a
single walk of the sorted array.*/
#define KPAIR_LESS(a, b) ((a).xv < (b).xv \
	|| ((a).xv == (b).xv && (a).yv < (b).yv))
LIKER_DEFINE_SORT(KPair, kpair, KPAIR_LESS)

/*Count pairs i<j with a[i] > a[j] (strict) while merge-sorting a[] ascending
into itself via scratch tmp[].  Equal elements are not inversions.*/
static uint64_t nv_merge_count(NV *restrict a, NV *restrict tmp, size_t lo, size_t hi) {
	if (hi - lo < 2) return 0;
	size_t mid = lo + (hi - lo) / 2;
	uint64_t inv = nv_merge_count(a, tmp, lo, mid) + nv_merge_count(a, tmp, mid, hi);
	size_t i = lo, j = mid, k = lo;
	while (i < mid && j < hi) {
		if (a[i] <= a[j]) tmp[k++] = a[i++];
		else { tmp[k++] = a[j++]; inv += (uint64_t)(mid - i); }
	}
	while (i < mid) tmp[k++] = a[i++];
	while (j < hi)  tmp[k++] = a[j++];
	for (size_t t = lo; t < hi; t++) a[t] = tmp[t];
	return inv;
}

/*Kendall's tau-b between two n-element arrays.

  tau-b = (C − D) / sqrt((C + D + T_x)(C + D + T_y))

where C = concordant pairs, D = discordant, T_x = pairs tied only on
x, T_y = pairs tied only on y.  Joint ties (both zero) are excluded
from numerator and denominator, matching R's cor(method="kendall").
Returns NAN when the denominator is zero.

Implemented via Knight's O(n log n) algorithm: sort by (x,y), tally the
tie corrections, and count discordant pairs D as y-inversions with a
merge sort.  With tot = n(n-1)/2, xtie/ytie = pairs tied on x/y (incl.
joint), ntie = pairs tied on both, the identity
  C − D = tot − xtie − ytie + ntie − 2·D
recovers the exact same tau-b as the former O(n²) double loop.*/
static void nv_sort(NV *a, size_t n);	//defined below, with nv_select()
static NV kendall_tau_b(const NV *x, const NV *y, size_t n) {
	if (n < 2) return NAN;
	KPair *restrict p;
	Newx(p, n, KPair);
	for (size_t i = 0; i < n; i++) { p[i].xv = x[i]; p[i].yv = y[i]; }
	kpair_sort(p, n);

	const uint64_t tot = (uint64_t)n * (n - 1) / 2;

	//xtie: pairs of equal x; ntie: pairs of equal (x,y) — both from p[].
	uint64_t xtie = 0, ntie = 0;
	size_t i = 0;
	while (i < n) {
		size_t j = i;
		while (j + 1 < n && p[j + 1].xv == p[i].xv) j++;
		uint64_t t = (uint64_t)(j - i + 1);
		xtie += t * (t - 1) / 2;
		size_t a = i;                       //subgroup by equal y within equal x
		while (a <= j) {
			size_t b = a;
			while (b + 1 <= j && p[b + 1].yv == p[a].yv) b++;
			uint64_t u = (uint64_t)(b - a + 1);
			ntie += u * (u - 1) / 2;
			a = b + 1;
		}
		i = j + 1;
	}

	//ytie: pairs of equal y over all data — from a separate y sort.
	NV *restrict ys;
	Newx(ys, n, NV);
	for (size_t k = 0; k < n; k++) ys[k] = y[k];
	nv_sort(ys, n);
	uint64_t ytie = 0;
	i = 0;
	while (i < n) {
		size_t j = i;
		while (j + 1 < n && ys[j + 1] == ys[i]) j++;
		uint64_t t = (uint64_t)(j - i + 1);
		ytie += t * (t - 1) / 2;
		i = j + 1;
	}
	Safefree(ys);

	//D: discordant pairs = y-inversions in (x,y)-sorted order.
	NV *restrict yv, *restrict tmp;
	Newx(yv, n, NV);
	Newx(tmp, n, NV);
	for (size_t k = 0; k < n; k++) yv[k] = p[k].yv;
	uint64_t dis = nv_merge_count(yv, tmp, 0, n);
	Safefree(yv); Safefree(tmp); Safefree(p);

	NV num   = (NV)tot - (NV)xtie - (NV)ytie + (NV)ntie - 2.0 * (NV)dis;
	NV denom = nv_sqrt(((NV)tot - (NV)xtie) * ((NV)tot - (NV)ytie));
	if (denom == 0.0) return NAN;
	return num / denom;
}

/*Single dispatch: compute correlation according to method string.
Allocates and frees temporary rank arrays internally for Spearman.*/
static NV compute_cor(const NV *x, const NV *y,
						   size_t n, const char *method) {
	if (strcmp(method, "spearman") == 0) {
	  NV *rx, *ry;
	  Newx(rx, n, NV); Newx(ry, n, NV);
	  rank_data(x, rx, n);
	  rank_data(y, ry, n);
	  NV r = pearson_corr(rx, ry, n);
	  Safefree(rx); Safefree(ry);
	  return r;
	}
	if (strcmp(method, "kendall") == 0)
	  return kendall_tau_b(x, y, n);
	//default: pearson
	return pearson_corr(x, y, n);
}
/*TRUE when every non-NaN value in a[0..n-1] is the same value -- the zero
variance cor() refuses, because r is 0/0 there.  A column that is entirely
NaN counts as constant.

It returns on the first pair that differs rather than sweeping the column,
which is what the whole column costs on real data: cor() used to make a full
pass per column to reach the same answer.*/
static bool nv_all_equal(const NV *a, size_t n) {
	NV first = NV_NAN;
	for (size_t i = 0; i < n; i++) {
		const NV v = a[i];
		if (nv_isnan(v)) continue;
		if (nv_isnan(first)) first = v;
		else if (v != first) return FALSE;
	}
	return TRUE;
}
/*Transpose an AoA matrix into one NV buffer per column, for cor()'s matrix
branch.  rows[] holds the nrows row AVs, already validated as array refs;
cols[j] must have room for nrows values; rowbuf is scratch for ncols values.

One pass over the rows, not one pass per column.  The old loop nest read
column j by fetching row i afresh for every (i, j), so it walked the whole
perl structure ncols times over and paid an av_fetch() plus an SvRV() on the
outer array for each of the ncols * nrows cells; this pays nrows of those in
total, and reads each row's cells in the order they are stored.  The transpose
itself still scatters into ncols separate buffers, so a very wide matrix keeps
that many write streams open -- which is still the cheaper half of the trade,
because the alternative walks the perl structure again per column.

av_extract_or_nan() does the reading, so a row shorter than ncols, a hole, an
undef, a non-numeric cell and a tied array all behave here exactly as they do
in cor()'s vector branch -- the short row's missing cells become NaN below,
and pairwise-complete deletion in compute_cor()'s caller drops them.

rows[] holds borrowed AV pointers, not counted references, so perl code run
from inside a cell (a tied FETCH, an overloaded 0+, a __WARN__ handler on a
non-numeric string) that empties the outer array leaves the later entries
dangling.  The av_fetch()-per-cell loop this replaces was no safer -- it read
row i back through the outer array without re-checking that the slot was still
a reference, so the same callback took it through SvRV(NULL) instead.  Making
it actually safe means holding a reference per row, which is nrows refcount
pairs for a case no ordinary input reaches; it is left as it was found.*/
static void cor_extract_cols(pTHX_ AV *const *restrict rows, size_t nrows,
	NV *const *restrict cols, size_t ncols, NV *restrict rowbuf)
{
	for (size_t i = 0; i < nrows; i++) {
		AV *row = rows[i];
		SSize_t rlen = av_len(row) + 1;
		if (rlen > (SSize_t)ncols) rlen = (SSize_t)ncols;	//extra columns are ignored
		if (rlen > 0) av_extract_or_nan(aTHX_ row, rlen, rowbuf);
		else rlen = 0;						//av_len() is -1 on an empty row
		for (size_t j = (size_t)rlen; j < ncols; j++) rowbuf[j] = NV_NAN;
		for (size_t j = 0; j < ncols; j++) cols[j][i] = rowbuf[j];
	}
}

// Math macros
#define MAX_ITER 500
#define EPS 3.0e-15
#define FPMIN 1.0e-30

/*Lentz's continued fraction for the incomplete beta (NR's betacf).

The iteration count needed grows with the shape parameters -- about
1.3*sqrt(a+b) terms for a+b ~ 1e3, falling to 0.25*sqrt(a+b) by a+b ~ 1e7 --
so a flat MAX_ITER silently truncates once the parameters are large.  At
a = b = 1e7 (a binomial tail at n = 2e7, which is what an All of Us cohort
looks like) 500 terms leaves a relative error of 9e-5: four correct digits.
The cap therefore scales with sqrt(a+b), with MAX_ITER as its floor.  The
loop still exits on convergence, so the larger cap costs nothing except in
the cases that were previously being cut short.

MAX_CF_ITER is a ceiling on that scaling, so the cap stays a safety net and
never becomes a way to spend billions of iterations: a+b can legitimately
reach 1e18 here (binom_test accepts any n up to LONG_MAX), and 2*sqrt of that
is 2e9.  The ceiling still covers a+b up to 2.5e9, past any real cohort, and
beyond it the continued fraction is the wrong algorithm anyway.*/
#define MAX_CF_ITER 100000
static NV _incbeta_cf(NV a, NV b, NV x) {
	NV scaled = MAX_ITER + 2.0 * nv_sqrt(a + b);
	long m, maxit = (scaled > (NV)MAX_CF_ITER) ? MAX_CF_ITER : (long)scaled;
	NV aa, c, d, del, h, qab, qam, qap;
	qab = a + b; qap = a + 1.0; qam = a - 1.0;
	c = 1.0; d = 1.0 - qab * x / qap;
	if (nv_fabs(d) < FPMIN) d = FPMIN;
	d = 1.0 / d; h = d;
	for (m = 1; m <= maxit; m++) {
	  NV m2 = 2.0 * m;	//NV: m2 is only ever used in NV arithmetic below
	  aa = m * (b - m) * x / ((qam + m2) * (a + m2));
	  d = 1.0 + aa * d;
	  if (nv_fabs(d) < FPMIN) d = FPMIN;
	  c = 1.0 + aa / c;
	  if (nv_fabs(c) < FPMIN) c = FPMIN;
	  d = 1.0 / d; h *= d * c;
	  aa = -(a + m) * (qab + m) * x / ((a + m2) * (qap + m2));
	  d = 1.0 + aa * d;
	  if (nv_fabs(d) < FPMIN) d = FPMIN;
	  c = 1.0 + aa / c;
	  if (nv_fabs(c) < FPMIN) c = FPMIN;
	  d = 1.0 / d; del = d * c; h *= del;
	  if (nv_fabs(del - 1.0) < EPS) break;
	}
	return h;
}

/*The front factor  x^a (1-x)^b / B(a,b)  of the continued fraction, built out
of Loader's saddle-point binomial rather than differenced lgamma()s (this is
what R's brcomp() does).  Substituting n = a+b and k = a into

    dbinom_raw(k, n, x, 1-x) = Gamma(n+1)/(Gamma(k+1)Gamma(n-k+1)) x^k (1-x)^(n-k)

and cancelling Gamma(z+1) = z*Gamma(z) three times gives

    x^a (1-x)^b / B(a,b) = (a*b/(a+b)) * dbinom_raw(a, a+b, x, 1-x).

The lgamma() form loses digits to cancellation: at a = b = 1e7 the three
lgamma()s are each ~1.6e8 and sum to ~1.5e7, so their last bits are worth
4e-8 in the exponent -- and exp() turns an absolute error in the exponent
into a relative error in the result.  stirlerr()/bd0() never form those large
intermediates, so they hold ~1e-15 at any size.  Written a/(a+b)*b so the
product cannot overflow for huge a and b.*/
static NV _incbeta_front(NV a, NV b, NV x) {
	return (a / (a + b)) * b * nv_exp(bt_dbinom_raw_log(a, a + b, x, 1.0 - x));
}

static NV incbeta(NV a, NV b, NV x) {
	if (x <= 0.0) return 0.0;
	if (x >= 1.0) return 1.0;
	if (x < (a + 1.0) / (a + b + 2.0))
		return _incbeta_front(a, b, x) * _incbeta_cf(a, b, x) / a;
	return 1.0 - _incbeta_front(b, a, 1.0 - x) * _incbeta_cf(b, a, 1.0 - x) / b;
}

// P(T > t): pt(t, df, lower.tail = FALSE)
static NV pt_upper(NV t, NV df) {
	NV prob_2tail = incbeta(df / 2.0, 0.5, df / (df + t * t));
	return (t > 0) ? 0.5 * prob_2tail : 1.0 - 0.5 * prob_2tail;
}

static NV get_t_pvalue(NV t, NV df, const char*alt) {
	NV x = df / (df + t * t);
	NV prob_2tail = incbeta(df / 2.0, 0.5, x);
	if (strcmp(alt, "less") == 0) return (t < 0) ? 0.5 * prob_2tail : 1.0 - 0.5 * prob_2tail;
	if (strcmp(alt, "greater") == 0) return (t > 0) ? 0.5 * prob_2tail : 1.0 - 0.5 * prob_2tail;
	return prob_2tail;
}

/*qt(p_tail, df, lower.tail = FALSE): the t with P(T > t) == p_tail.

Symmetry first, so the bracket is always [0, high) and the root always
positive; then bisection to adjacent doubles. Searching upward from zero
alone cannot express the negative quantile a p_tail above 0.5 asks for --
which is what a one-sided interval at conf_level < 0.5 needs -- and the old
1e6 ceiling on the doubling silently saturated instead of failing, so two
different extreme conf_levels came back with the identical interval. The
convergence test is relative for the same reason: an absolute 1e-8 on the
quantile is an error of 1e-8 * std_err on the interval, which grows without
bound as the data's scale does.*/
static NV qt_tail(NV df, NV p_tail) {
	if (!(p_tail > 0.0)) return INFINITY;    //also catches NaN
	if (p_tail >= 1.0)   return -INFINITY;
	if (p_tail == 0.5)   return 0.0;
	if (p_tail  > 0.5)   return -qt_tail(df, 1.0 - p_tail);
	NV low = 0.0, high = 1.0;
	/*t * t overflows past sqrt(DBL_MAX); pt_upper() there is already 0, so the
	loop ends on its own well before that, and the guard is only a backstop.*/
	while (high < nv_sqrt(DBL_MAX) && pt_upper(high, df) > p_tail) {
		low   = high;
		high *= 2.0;
	}
	for (unsigned short int i = 0; i < 200; i++) {
		NV mid = 0.5 * (low + high);
		if (mid <= low || mid >= high) break;   //low and high are adjacent
		if (pt_upper(mid, df) > p_tail) low = mid; else high = mid;
	}
	return 0.5 * (low + high);
}

/*Welford over one sample for t_test(), skipping undef and NaN the way R's
t.test() drops NA (is.na(NaN) is TRUE there too). Infinities are kept, as R
keeps them. Returns the number of values used; *var_out is NaN for a single
value, matching var() of length one, and the caller must not fold that into a
pooled variance -- R skips the term instead.

AvARRAY, not av_fetch: the length is already known and a sample here is a
plain array of numbers, so the bounds check and the call per element are the
only things standing between the loop and the data.*/
static size_t t_test_scan(pTHX_ AV *av, NV *mean_out, NV *var_out) {
	const size_t n = (size_t)(av_len(av) + 1);
	size_t kept = 0;
	NV mean = 0.0, M2 = 0.0;
	SV **a = AvARRAY(av);
	for (size_t i = 0; a && i < n; i++) {
		SV *e = a[i];
		if (!e || !SvOK(e)) continue;
		const NV v = SvNV(e);
		if (v != v) continue;
		kept++;
		const NV delta = v - mean;
		mean += delta / (NV)kept;
		M2   += delta * (v - mean);
	}
	*mean_out = mean;
	*var_out  = (kept > 1) ? M2 / (NV)(kept - 1) : NAN;
	return kept;
}

int compare_doubles(const void *a, const void *b) {
	NV da = *(const NV*)a;
	NV db = *(const NV*)b;
	return (da > db) - (da < db);
}

/*order statistics
A median is the middle one or two values, not a sorted array, so median()
selects those instead of ordering everything: quickselect touches ~2n
elements on average where qsort spends n log n comparisons, every one of
them an indirect call through a function pointer the compiler cannot see
into, let alone inline.

The refinements are the usual ones.  A median-of-three pivot keeps the data
people actually have -- already sorted, reverse sorted, mostly duplicates --
off the quadratic path; a small range finishes with an insertion sort; and a
depth limit hands the rest to heapsort, so an input crafted to defeat the
pivot choice degrades to O(n log n) rather than O(n^2).  That combination is
introselect, the same shape numpy's partition uses.

NaN makes every comparison false, which stops each scan where it stands
instead of running it off the end of the array, so a NaN in the data cannot
push the partition out of bounds.  Which value comes back is as undefined as
it was when this went through qsort.*/
#define NV_SEL_ISORT 20		//ranges this small finish with an insertion sort

static void nv_swap(NV *x, NV *y) { NV t = *x; *x = *y; *y = t; }

static void nv_isort(NV *a, size_t n) {
	for (size_t i = 1; i < n; i++) {
		NV v = a[i];
		size_t j = i;
		while (j > 0 && a[j - 1] > v) { a[j] = a[j - 1]; j--; }
		a[j] = v;
	}
}

//sift a[root] down through the heap held in a[0..n-1]
static void nv_sift(NV *a, size_t root, size_t n) {
	NV v = a[root];
	size_t child;
	while ((child = 2 * root + 1) < n) {
		if (child + 1 < n && a[child] < a[child + 1]) child++;
		if (!(v < a[child])) break;
		a[root] = a[child];
		root = child;
	}
	a[root] = v;
}

static void nv_heapsort(NV *a, size_t n) {
	if (n < 2) return;
	for (size_t i = n / 2; i-- > 0; ) nv_sift(a, i, n);
	for (size_t end = n - 1; end > 0; end--) {
		nv_swap(&a[0], &a[end]);
		nv_sift(a, 0, end);
	}
}

/*A full sort of a[0..n-1], the same introsort nv_select() partitions with,
carried all the way down instead of stopping at the wanted rank: median of
three, recurse into the smaller half and loop on the larger (so the stack
stays at log2 n frames), heapsort once the depth limit says the pivots are
being defeated, and one insertion sort over the nearly-ordered remainder.

It exists because qsort() cannot see its comparator.  Ordering 5000 NVs
costs about 61000 comparisons, and paying for an indirect call on each is
most of what a sort of that size costs -- measured here, qsort() takes 355us
where this takes 210us, which is the difference between shapiro_test()
spending its time on the sort and spending it on the statistic.

NaN is safe to pass in but cannot be ordered, here or by qsort: every
comparison against one is false, so no comparison sort can place it.  What
this does guarantee on such input is what a caller relies on -- the result is
a permutation of the input, and neither scan leaves [lo, hi].  The scans stop
*early* on a NaN rather than running past it (a[i] < pivot and a[j] > pivot
are both false), and a NaN pivot stops both at once, so the partition still
narrows by at least one from each end every pass.  Fuzzed under ASan and
UBSan over 200000 NaN/Inf arrays.  A caller that needs the NaNs gone must
drop them first; shapiro_test() does, quantile() does not.

No restrict on a[]: the recursive call reaches the same allocation, which is
the whole point of the recursion.*/
static void nv_introsort(NV *a, size_t lo, size_t hi, unsigned int depth) {
	while (hi - lo >= NV_SEL_ISORT) {
		if (depth-- == 0) { nv_heapsort(a + lo, hi - lo + 1); return; }

		/*median of three, left in place: a[lo] <= pivot <= a[hi], so both
		ends double as sentinels that stop the scans below*/
		size_t mid = lo + (hi - lo) / 2;
		if (a[mid] < a[lo])  nv_swap(&a[mid], &a[lo]);
		if (a[hi]  < a[lo])  nv_swap(&a[hi],  &a[lo]);
		if (a[hi]  < a[mid]) nv_swap(&a[hi],  &a[mid]);
		const NV pivot = a[mid];

		size_t i = lo, j = hi;
		for (;;) {
			do { i++; } while (a[i] < pivot);
			do { j--; } while (a[j] > pivot);
			if (i >= j) break;
			nv_swap(&a[i], &a[j]);
		}
		//a[lo..j] <= pivot <= a[j+1..hi]; recurse into whichever is shorter
		if (j - lo < hi - j - 1) { nv_introsort(a, lo, j, depth); lo = j + 1; }
		else                     { nv_introsort(a, j + 1, hi, depth); hi = j; }
	}
	nv_isort(a + lo, hi - lo + 1);
}

static void nv_sort(NV *a, size_t n) {
	unsigned int depth = 0;
	if (n < 2) return;
	for (size_t t = n; t > 1; t >>= 1) depth += 2;	//2*floor(log2 n)
	nv_introsort(a, 0, n - 1, depth);
}

/*Leave the k-th smallest of a[lo..hi] at a[k], everything between lo and k no
larger and everything between k and hi no smaller.  a[] is reordered in place,
and only within [lo, hi] -- which is what lets nv_select_multi() below place
one order statistic and then keep working inside the two halves it separates.*/
static void nv_select_range(NV *a, size_t lo, size_t hi, size_t k) {
	if (lo >= hi) return;	//0 or 1 elements: already its own order statistic
	unsigned depth = 0;
	for (size_t t = hi - lo + 1; t > 1; t >>= 1) depth += 2;	//2*floor(log2 n)

	while (hi - lo >= NV_SEL_ISORT) {
		if (depth-- == 0) { nv_heapsort(a + lo, hi - lo + 1); return; }

		/*median of three, left in place: a[lo] <= pivot <= a[hi], so both
		ends double as sentinels that stop the scans below*/
		size_t mid = lo + (hi - lo) / 2;
		if (a[mid] < a[lo])  nv_swap(&a[mid], &a[lo]);
		if (a[hi]  < a[lo])  nv_swap(&a[hi],  &a[lo]);
		if (a[hi]  < a[mid]) nv_swap(&a[hi],  &a[mid]);
		const NV pivot = a[mid];

		size_t i = lo, j = hi;
		for (;;) {
			do { i++; } while (a[i] < pivot);
			do { j--; } while (a[j] > pivot);
			if (i >= j) break;
			nv_swap(&a[i], &a[j]);
		}
		//a[lo..j] <= pivot <= a[j+1..hi]; keep only the side holding k
		if (k <= j) hi = j; else lo = j + 1;
	}
	nv_isort(a + lo, hi - lo + 1);
}

/*Leave the k-th smallest of a[0..n-1] at a[k].*/
static void nv_select(NV *a, size_t n, size_t k) {
	if (n < 2) return;
	nv_select_range(a, 0, n - 1, k);
}

/*Place every one of ks[klo..khi-1] -- ascending, distinct, all within
[lo, hi] -- at its own index in a[], leaving the rest of a[] partitioned
around them but unsorted.

Taking the middle index first and recursing into the two ranges it separates
costs O(n log k) rather than the O(n k) a left-to-right sweep of selects would,
because each level of the recursion touches each element at most once and the
index list halves at every level.

This is what quantile() wants instead of a full sort, and is what R does too:
quantile.default() passes the order statistics it needs to sort(partial=), and
numpy reaches np.partition() for the same reason.  On 1e6 random doubles the
10 order statistics of the 5 default probs cost 19.2 ms this way against 69.1
ms for the full nv_sort() (perl-5.44.0, -O2, both routines from this file).*/
static void nv_select_multi(NV *a, size_t lo, size_t hi,
	const size_t *restrict ks, size_t klo, size_t khi) {
	if (klo >= khi) return;
	size_t kmid = klo + (khi - klo) / 2;
	size_t k = ks[kmid];
	nv_select_range(a, lo, hi, k);
	//a[k] is final, so the indices below it can only be in [lo, k-1]
	if (k > lo) nv_select_multi(a, lo, k - 1, ks, klo, kmid);
	if (k < hi) nv_select_multi(a, k + 1, hi, ks, kmid + 1, khi);
}

/*Ascending comparator for qsort() over size_t, for the index list above.
qsort_r() would let the comparator be a closure, but its argument order differs
between glibc, the BSDs and Solaris, so a plain file-static comparator it is.
Subtracting would overflow; comparing twice cannot.*/
static int size_t_cmp(const void *a, const void *b) {
	const size_t x = *(const size_t *)a, y = *(const size_t *)b;
	return (x > y) - (x < y);
}
//Helper to calculate the number of bins using Sturges' formula: log2(n) + 1
static size_t calculate_sturges_bins(size_t n) {
	if (n == 0) return 1;
	return (size_t)(nv_log((NV)n) / nv_log(2.0) + 1.0);
}

// Logic for distributing data into bins (Optimized to O(N))
static void compute_hist_logic(NV *restrict x, size_t n, NV *restrict breaks,
 size_t n_bins, size_t *restrict counts, NV *restrict mids,
 NV *restrict density) {
	NV total_n = (NV)n;
	NV min_val = breaks[0];
	NV step = (n_bins > 0) ? (breaks[1] - breaks[0]) : 0.0;
	// Initialize counts and compute midpoints
	for (size_t i = 0; i < n_bins; i++) {
	  counts[i] = 0;
	  mids[i] = (breaks[i] + breaks[i+1]) / 2.0;
	}
	// Single O(N) pass to assign elements to bins
	if (step > 0.0) {
		for (size_t j = 0; j < n; j++) {
			NV val = x[j];
			// Ignore out-of-bounds or invalid values
			if (nv_isnan(val) || nv_isinf(val) || val < min_val) continue;
			// Calculate initial bin index mathematically
			size_t idx = (size_t)((val - min_val) / step);
			// Clamp to valid array bounds first to prevent overflow */
			if (idx >= n_bins) {
				 idx = n_bins - 1;
			}
			//Adjust for exact boundaries (R's right-inclusive default: (a, b])

			/*If value is exactly on or slightly below the lower boundary of the assigned bin,
			it belongs in the previous bin. (First bin [a, b] is inclusive on both ends)*/
			while (idx > 0 && val <= breaks[idx]) {
				 idx--;
			}
			// Conversely, if floating-point truncation placed it too low, push it up
			while (idx < n_bins - 1 && val > breaks[idx + 1]) {
				 idx++;
			}
			counts[idx]++;
		}
	} else if (n_bins > 0) {
		// Edge case: All data points have the exact same value (step == 0)
		counts[0] = n;
	}
	// Compute densities
	for (size_t i = 0; i < n_bins; i++) {
		NV bin_width = breaks[i+1] - breaks[i];
		if (bin_width > 0) {
			density[i] = (NV)counts[i] / (total_n * bin_width);
		} else {
			density[i] = (n_bins == 1) ? 1.0 : 0.0;
		}
	}
}

// Standard Normal CDF approximation
NV approx_pnorm(NV x) {
	// Nothing erfc() returns this far out is a number: see PNORM_LOWER_ZERO
	if (x <= PNORM_LOWER_ZERO) return 0.0;
	return 0.5 * nv_erfc(-x * 0.70710678118654752440); // 0.707... = 1/sqrt(2)
}
#ifndef M_SQRT1_2
#define M_SQRT1_2 0.70710678118654752440
#endif

//Macro for exact Wilcoxon 3D array indexing
#define DP_INDEX(i, j, k, n2, max_u) ((i) * ((n2) + 1) * ((max_u) + 1) + (j) * ((max_u) + 1) + (k))
static NV inverse_normal_cdf(NV p) {
	NV a[4] = {2.50662823884, -18.61500062529, 41.39119773534, -25.44106049637};
	NV b[4] = {-8.47351093090, 23.08336743743, -21.06224101826, 3.13082909833};
	NV c[9] = {0.3374754822726147, 0.9761690190917186, 0.1607979714918209,
		0.0276438810333863, 0.0038405729373609, 0.0003951896511919,
		0.0000321767881768, 0.0000002888167364, 0.0000003960315187};
	NV x, r, y;
	y = p - 0.5;
	if (nv_fabs(y) < 0.42) {
	  r = y * y;
	  x = y * (((a[3]*r + a[2])*r + a[1])*r + a[0]) /
			   ((((b[3]*r + b[2])*r + b[1])*r + b[0])*r + 1.0);
	} else {
	  r = p;
	  if (y > 0) r = 1.0 - p;
	  r = nv_log(-nv_log(r));
	  x = c[0] + r * (c[1] + r * (c[2] + r * (c[3] + r * (c[4] +
		   r * (c[5] + r * (c[6] + r * (c[7] + r * c[8])))))));
	  if (y < 0) x = -x;
	}
	return x;
}

/*Moro's approximation above is good to about 1e-9, which is not enough for
anything in this file. Royston's AS R94 weights feed the expected normal order
statistics straight into W, so nine digits there cap W at nine digits where R
reports sixteen; and a Wald confidence limit inherits every digit its critical
value is missing, which is visible as soon as one is compared against R's.
Newton against approx_pnorm() -- erfc, a few ulp at every NV width -- squares
the error each pass, and the loop below stops the moment another pass could not
move z, so a double pays for one pass and only the wider NVs pay for a second.

Takes p in (0, 1). The domain guards, and the reflection that keeps the result
accurate above the median, live in std_qnorm() below: call that, not this.

The 1/sqrt(2*pi) literal is only ever a divisor of the correction, so its own
rounding scales an already-converged step and never limits the answer.*/
static NV normal_quantile_hp(NV p) {
	NV z = inverse_normal_cdf(p);
	for (unsigned short int i = 0; i < 4; i++) {
		NV dens = 0.39894228040143267794 * nv_exp(-0.5 * z * z);
		NV step;
		if (!(dens > 0.0)) break;
		step = (approx_pnorm(z) - p) / dens;
		z -= step;
		/* Newton squares the error, so the pass after this one would move z
		   by about |z|/2 * step^2; stop once that is below eps*|z|.  A
		   double is done after one pass, the wider NVs after two, and the
		   test costs a multiply rather than an assumption about either. */
		if (step * step <= 2.0 * NV_EPSILON) break;
	}
	return z;
}

/*The standard normal quantile over the whole of [0, 1]. This is the one entry
point for every caller in this file that needs a z, so which function asked for
a critical value can no longer change which digits it gets.

Reflected at the median, because normal_quantile_hp()'s Newton correction is
(approx_pnorm(z) - p) / dens: for p near 1 both terms of that numerator are
near 1, so the correction is formed by subtracting numbers that agree to as
many places as p has. Below the median both terms are small and the step is
formed cleanly, so inverting min(p, 1-p) and negating removes the effect
entirely -- which is how R's qnorm is written, for this reason.

Measured against mpmath at 60 digits, at the p the C expression
1 - (1 - conf.level)/2 actually forms: unreflected, the error grows with the
confidence level, 0.4 ulp at conf.level = 0.95 but 3 ulp at 0.99, 37 ulp at
0.999 and 254 ulp at 0.9999. Reflected it is under half an ulp at every one of
them, and 9.3e-18 at p = 1 - 2^-16 where unreflected costs 5.8e-14.

The reflection is free rather than a trade: for p >= 0.5 the two operands of
1 - p lie within a factor of two of each other, so Sterbenz's lemma makes that
subtraction exact, and no new error is introduced in place of the one removed.*/
static NV std_qnorm(NV p) {
	if (nv_isnan(p) || p < 0.0 || p > 1.0) return NV_NAN;
	if (p == 0.0) return -NV_INF;
	if (p == 1.0) return  NV_INF;
	return (p > 0.5) ? -normal_quantile_hp(1.0 - p) : normal_quantile_hp(p);
}

/* AS 181.2's poly(): the algebraic polynomial of order nord-1 whose zero
   order coefficient is cc[0].  Horner, exactly as R's swilk.c evaluates it,
   so the AS R94 coefficient blocks below can be transcribed unchanged. */
static NV as181_poly(const NV *cc, unsigned short int nord, NV x) {
	NV p = cc[nord - 1];
	for (unsigned short int j = nord - 1; j > 0; j--) p = p * x + cc[j - 1];
	return p;
}
/*--
Exact Spearman p-value via exhaustive permutation enumeration.

Under H0, all n! orderings of ranks are equally probable.  We visit
every permutation of {1..n} with Heap's algorithm (O(n!), no allocs
inside the loop) and count how many yield S ≤ s_obs ("lower tail",
i.e. rho ≥ rho_obs) and how many yield S ≥ s_obs ("upper tail").

Mirrors R's default: exact = (n < 10) with no ties.
Valid up to n = 9 (362 880 iterations — negligible cost).
-----------------------------------------------------------------------*/
static NV spearman_exact_pvalue(NV s_obs, size_t n, const char *alt) {
	int *perm = (int*)safemalloc(n * sizeof(int));
	int *c    = (int*)safemalloc(n * sizeof(int));
	for (size_t i = 0; i < n; i++) { perm[i] = i + 1; c[i] = 0; }

	long count_le = 0, count_ge = 0, total = 0;

	#define TALLY_PERM() do {                                    \
	  NV s_ = 0.0;                                     \
	  for (int ii = 0; ii < n; ii++) {                    \
		   NV d_ = (NV)(ii + 1) - (NV)perm[ii];\
		   s_ += d_ * d_;                                   \
	  }                                                    \
	  if (s_ <= s_obs + 1e-9) count_le++;                 \
	  if (s_ >= s_obs - 1e-9) count_ge++;                 \
	  total++;                                             \
	} while (0)

	TALLY_PERM();   //initial permutation [1, 2, ..., n]

	unsigned int k = 1;
	while (k < n) {
		if (c[k] < k) {
			int tmp;
			if (k % 2 == 0) {
				 tmp = perm[0]; perm[0] = perm[k]; perm[k] = tmp;
			} else {
				 tmp = perm[c[k]]; perm[c[k]] = perm[k]; perm[k] = tmp;
			}
			TALLY_PERM();
			c[k]++;
			k = 1;
		} else {
			c[k] = 0;
			k++;
		}
	}
	#undef TALLY_PERM
	Safefree(perm); Safefree(c);
	/*p_le = P(S ≤ s_obs) ≡ P(rho ≥ rho_obs)  — upper rho tail
	p_ge = P(S ≥ s_obs) ≡ P(rho ≤ rho_obs)  — lower rho tail*/
	NV p_le = (NV)count_le / (NV)total;
	NV p_ge = (NV)count_ge / (NV)total;

	if (strcmp(alt, "greater") == 0) return p_le;
	if (strcmp(alt, "less")    == 0) return p_ge;
	//two.sided: 2 × the smaller tail, clamped to 1
	NV p = 2.0 * (p_le < p_ge ? p_le : p_ge);
	return (p > 1.0) ? 1.0 : p;
}
/*Exact Kendall p-value via Mahonian Numbers (Inversions distribution)
Matches R's behavior for N < 50 without ties.*/
static NV kendall_exact_pvalue(size_t n, NV s_obs, const char *alt) {
	long max_inv = (long)n * (n - 1) / 2;
	/*Two ping-pong buffers, allocated once, instead of one malloc/free per
	outer step.  The inner recurrence
	  next_dp[k] = (1/i) * sum_{j=0..min(i-1,k)} dp[k-j]
	is a fixed-width (i) sliding window over dp[], so a running sum makes
	each cell O(1) rather than O(i) — dropping the build from O(n^4) to
	O(n^3).  Results match the from-scratch sum to floating-point noise.*/
	NV *buf_a = (NV*)safemalloc((max_inv + 1) * sizeof(NV));
	NV *buf_b = (NV*)safemalloc((max_inv + 1) * sizeof(NV));
	for (long i = 0; i <= max_inv; i++) buf_a[i] = 0.0;
	buf_a[0] = 1.0;
	NV *dp = buf_a, *next_dp = buf_b;
	//Build the distribution of inversions via DP
	for (size_t i = 2; i <= n; i++) {
		long current_max_inv = (long)i * (i - 1) / 2;
		for (long k = 0; k <= max_inv; k++) next_dp[k] = 0.0;
		NV window = 0.0;
		for (long k = 0; k <= current_max_inv; k++) {
			window += dp[k];              //element entering the window
			long out = k - (long)i;       //element leaving it (width i)
			if (out >= 0) window -= dp[out];
			// Divide by 'i' directly to keep array as pure probabilities and prevent overflow
			next_dp[k] = window / (NV)i;
		}
		NV *tmp = dp; dp = next_dp; next_dp = tmp;
	}
	// Convert S statistic to target number of inversions
	long i_obs = (long)nv_round((max_inv - s_obs) / 2.0);
	if (i_obs < 0) i_obs = 0;
	if (i_obs > max_inv) i_obs = max_inv;
	NV p_le = 0.0; //P(S <= S_obs)
	for (long k = i_obs; k <= max_inv; k++) p_le += dp[k];
	NV p_ge = 0.0; //P(S >= S_obs)
	for (long k = 0; k <= i_obs; k++) p_ge += dp[k];
	Safefree(buf_a); Safefree(buf_b);
	if (strcmp(alt, "greater") == 0) return p_ge;
	if (strcmp(alt, "less") == 0) return p_le;
	// two.sided
	NV p = 2.0 * (p_ge < p_le ? p_ge : p_le);
	return p > 1.0 ? 1.0 : p;
}
// F-distribution Cumulative Distribution Function P(F <= f)
static NV pf(NV f, NV df1, NV df2) {
	if (f <= 0.0) return 0.0;
	NV x = (df1 * f) / (df1 * f + df2);
	return incbeta(df1 / 2.0, df2 / 2.0, x);
}

/*Upper tail P(F > f)  ==  R's pf(f, df1, df2, lower.tail = FALSE).

Computed in the upper tail directly via the beta symmetry
  1 - I_x(a, b) = I_{1-x}(b, a),  x = df1·f / (df1·f + df2)
so 1-x = df2 / (df1·f + df2) is formed without any subtraction.  Writing
this as `1 - pf(...)` instead throws away the whole answer once the p-value
drops below ~1e-16 (the ulp of 1.0): R reports 1.2e-76 where the naive form
returns a flat 0, and loses relative precision from about 1e-9 downward.*/
static NV pf_upper(NV f, NV df1, NV df2) {
	if (nv_isnan(f) || nv_isnan(df1) || nv_isnan(df2)) return NAN;   //NaN in, NaN out
	if (f <= 0.0)   return 1.0;
	if (nv_isinf(f))   return 0.0;   //zero within-group variance: R gives p = 0
	NV denom = df1 * f + df2;
	if (nv_isinf(denom)) return 0.0; //p underflows anyway
	return incbeta(df2 / 2.0, df1 / 2.0, df2 / denom);
}

//Householder QR Decomposition for Sequential Sums of Squares
static void apply_householder_aov(NV** restrict X, NV* restrict y, size_t n, size_t p, bool* restrict aliased, size_t* restrict rank_map) {
	size_t r = 0; // Rank/Row tracker
	for (size_t k = 0; k < p; k++) {
		aliased[k] = FALSE;
		if (r >= n) {
			aliased[k] = TRUE;
			continue;
		}

		NV max_val = 0;
		for (size_t i = r; i < n; i++) {
			if (nv_fabs(X[i][k]) > max_val) max_val = nv_fabs(X[i][k]);
		}
		if (max_val < 1e-10) { 
			aliased[k] = TRUE; 
			continue; 
		} // Collinear or zero column

		NV norm = 0;
		for (size_t i = r; i < n; i++) {
			X[i][k] /= max_val;
			norm += X[i][k] * X[i][k];
		}
		norm = nv_sqrt(norm);
		NV s = (X[r][k] > 0) ? -norm : norm;
		NV u1 = X[r][k] - s;
		X[r][k] = s * max_val;

		for (size_t j = k + 1; j < p; j++) {
			NV dot = u1 * X[r][j];
			for (size_t i = r + 1; i < n; i++) dot += X[i][j] * X[i][k];
			NV tau = dot / (s * u1);
			X[r][j] += tau * u1;
			for (size_t i = r + 1; i < n; i++) X[i][j] += tau * X[i][k];
		}

		// Transform the response vector y
		NV dot_y = u1 * y[r];
		for (size_t i = r + 1; i < n; i++) dot_y += y[i] * X[i][k];
		NV tau_y = dot_y / (s * u1);
		y[r] += tau_y * u1;
		for (size_t i = r + 1; i < n; i++) y[i] += tau_y * X[i][k];

		rank_map[k] = r; // Map original column index to orthogonal row index
		r++;
	}
}

/* write_table Helpers
 Sorts string arrays alphabetically*/
static int cmp_string_wt(const void *a, const void *b) {
	return strcmp(*(const char**)a, *(const char**)b);
}

/*write_table: the "wrote <file>" confirmation line.

This is say 'wrote ' . colored(['black on_cyan'], $file), with the SGR codes
written out inline (black foreground 30, cyan background 46, reset 0) so the
module keeps no dependency on Term::ANSIColor.

Every format announces itself the same way -- delimited, LaTeX and .xlsx
alike -- so a caller always learns where the table went, and learns it in
the same shape whatever they asked for. The colour is unconditional, exactly
as it was when only LaTeX and .xlsx printed this: a caller who is capturing
STDOUT and does not want the escape sequences should capture and strip, or
redirect, as they would for any other coloured tool.

The line is assembled and written in one go, then flushed. PerlIO_stdout()
carries its own buffer, distinct from any handle Perl code prints through
(Test::More's, say), so when fd 1 is a pipe an unflushed announcement sits
in that buffer until exit and its eventual flush can land in the middle of
another writer's line. One write plus one flush keeps every announcement
whole and in order with everything else on fd 1.*/
static void write_table_announce(pTHX_ const char *file) {
	PerlIO *out = PerlIO_stdout();
	if (!out || !file) return;
	static const char pre[]  = "wrote \033[30;46m";
	static const char post[] = "\033[0m\n";
	const size_t flen = strlen(file);
	const size_t need = (sizeof(pre) - 1) + flen + (sizeof(post) - 1);
	char stackbuf[512];
	char *line = need <= sizeof(stackbuf)
		? stackbuf : (char*)malloc(need);
	if (line) {
		memcpy(line, pre, sizeof(pre) - 1);
		memcpy(line + sizeof(pre) - 1, file, flen);
		memcpy(line + sizeof(pre) - 1 + flen, post, sizeof(post) - 1);
		PerlIO_write(out, line, need);
		if (line != stackbuf) free(line);
	} else {/*out of memory: fall back to three writes*/
		PerlIO_write(out, pre, sizeof(pre) - 1);
		PerlIO_write(out, file, flen);
		PerlIO_write(out, post, sizeof(post) - 1);
	}
	PerlIO_flush(out);
}

// Emulates Perl's /\D/ check
static bool contains_nondigit(pTHX_ SV *sv) {
	if (!sv || !SvOK(sv)) return 0;
	STRLEN len;
	char *s = SvPVbyte(sv, len);
	for (size_t i = 0; i < len; i++) {
	  if (!isdigit(s[i])) return 1;
	}
	return 0;
}

static void print_string_row(pTHX_ PerlIO *fh,
	const char **fields, size_t n, const char *sep,
	AV *collect)
{
	const size_t sep_len = sep ? strlen(sep) : 0;
/*When 'collect' is non-NULL the caller wants the rows captured for the
LaTeX renderer (the 'tex' option): stash a copy of this record's fields
as an array of SVs so write_tex_tabular() can format them afterwards.
The copy captures exactly the fields that would be written to the
delimited file, including undef.val substitution. When 'fh' is NULL the
row is only collected, not rendered (tex-only output).*/
	AV *crow = collect ? newAV() : NULL;
	for (size_t i = 0; i < n; i++) {
		const char *f = fields[i];
		if (crow) {
			SV *fsv = newSVpv(f ? f : "", 0);
/* Flattening the cell to a C string dropped its UTF-8 flag; put it
 back so write_tex_tabular() decodes code points (and can map
 Greek). Only when the bytes are valid UTF-8 with a byte >= 0x80:
 pure ASCII needs no flag, and invalid/Latin-1 bytes stay bytes.*/
			STRLEN flen = SvCUR(fsv);
			const U8 *fb = (const U8*)SvPVX(fsv);
			bool high = 0;
			for (STRLEN k = 0; k < flen; k++) if (fb[k] >= 0x80) { high = 1; break; }
			if (high && is_utf8_string(fb, flen)) SvUTF8_on(fsv);
			av_push(crow, fsv);
		}
		if (!fh) continue; //collect-only mode: no delimited rendering
		if (i && sep_len) PerlIO_write(fh, sep, sep_len);
		if (!f || !*f) continue; //undef/empty -> print nothing

		//Does this field need quoting?
		bool need_quotes = 0;
		if (strchr(f, '"') || strchr(f, '\n') || strchr(f, '\r')) {
			need_quotes = 1;
		} else if (sep_len && strstr(f, sep)) {
			need_quotes = 1;
		}
		if (!need_quotes) {
			PerlIO_write(fh, f, strlen(f));
		} else {
			PerlIO_putc(fh, '"');
			for (const char *p = f; *p; p++) {
				if (*p == '"') PerlIO_putc(fh, '"'); //double it
				PerlIO_putc(fh, *p);
			}
			PerlIO_putc(fh, '"');
		}
	}
	if (fh) PerlIO_putc(fh, '\n');
	if (collect) av_push(collect, newRV_noinc((SV*)crow));
}

/*  write_table: LaTeX tabular output (the 'tex' option / a ".tex" file name).

Modeled on a stand-alone "2D array -> LaTeX tabular" routine, but driven by
the rows print_string_row() already assembled, so every data shape the
delimited writer supports (flat hash, HoA, HoH, AoH, AoA) produces a table
with no shape-specific code here. The xlsx / worksheet / JSON side outputs
of the original routine are intentionally omitted.*/
#define TEX_PUTS(fh, lit) PerlIO_write((fh), (lit), sizeof(lit) - 1)

/*Loose match for /^\includesvg.*\{.+\.svg\}$/: such cells pass through
unescaped so an embedded graphics macro survives verbatim.*/
static bool tex_is_includesvg(const char *s) {
	size_t n = strlen(s);
	if (n < 5 || strncmp(s, "\\includesvg", 11) != 0) return 0;
	return strcmp(s + n - 5, ".svg}") == 0;
}

/* Map a Greek code point to its textgreek macro (\usepackage{textgreek}),
 e.g. U+0394 -> \textDelta. Covers the monotonic Greek block, upper and
 lower case, plus both sigma forms; returns NULL for anything else so the
 caller passes it through unchanged. Add rows here for other symbols.*/
static const char *tex_greek_macro(UV cp) {
	switch (cp) {
	case 0x0391: return "\\textAlpha";
	case 0x0392: return "\\textBeta";
	case 0x0393: return "\\textGamma";
	case 0x0394: return "\\textDelta";
	case 0x0395: return "\\textEpsilon";
	case 0x0396: return "\\textZeta";
	case 0x0397: return "\\textEta";
	case 0x0398: return "\\textTheta";
	case 0x0399: return "\\textIota";
	case 0x039A: return "\\textKappa";
	case 0x039B: return "\\textLambda";
	case 0x039C: return "\\textMu";
	case 0x039D: return "\\textNu";
	case 0x039E: return "\\textXi";
	case 0x039F: return "\\textOmikron";
	case 0x03A0: return "\\textPi";
	case 0x03A1: return "\\textRho";
	case 0x03A3: return "\\textSigma";
	case 0x03A4: return "\\textTau";
	case 0x03A5: return "\\textUpsilon";
	case 0x03A6: return "\\textPhi";
	case 0x03A7: return "\\textChi";
	case 0x03A8: return "\\textPsi";
	case 0x03A9: return "\\textOmega";
	case 0x03B1: return "\\textalpha";
	case 0x03B2: return "\\textbeta";
	case 0x03B3: return "\\textgamma";
	case 0x03B4: return "\\textdelta";
	case 0x03B5: return "\\textepsilon";
	case 0x03B6: return "\\textzeta";
	case 0x03B7: return "\\texteta";
	case 0x03B8: return "\\texttheta";
	case 0x03B9: return "\\textiota";
	case 0x03BA: return "\\textkappa";
	case 0x03BB: return "\\textlambda";
	case 0x03BC: return "\\textmu";
	case 0x03BD: return "\\textnu";
	case 0x03BE: return "\\textxi";
	case 0x03BF: return "\\textomikron";
	case 0x03C0: return "\\textpi";
	case 0x03C1: return "\\textrho";
	case 0x03C2: return "\\textvarsigma";
	case 0x03C3: return "\\textsigma";
	case 0x03C4: return "\\texttau";
	case 0x03C5: return "\\textupsilon";
	case 0x03C6: return "\\textphi";
	case 0x03C7: return "\\textchi";
	case 0x03C8: return "\\textpsi";
	case 0x03C9: return "\\textomega";
	default:     return NULL;
	}
}

/*Escape one cell into 'out' (reset first): the LaTeX-active characters
# _ % & gain a leading backslash and '>' becomes \textgreater. When the
source SV is UTF-8, Greek letters are turned into their textgreek macros
(e.g. U+0394 Greek Delta -> \textDelta{}; the trailing {} keeps a following letter
from being swallowed into the control word). With do_format set, a numeric
cell is first rendered with %.4g (mirrors the original 'format' option).*/
static void tex_escape_sv(pTHX_ SV *out, const char *s,
	bool is_utf8, bool do_format)
{
	sv_setpvs(out, "");
	if (!s) return;
	char numbuf[64];
	if (do_format && *s) {
		SV *tmp = sv_2mortal(newSVpv(s, 0));
		if (looks_like_number(tmp)) {
/* snprintf_nv (my_snprintf), not snprintf: NVgf is "g", "Lg" or "Qg"
 depending on the build, and the C library only knows the first two. A
 quadmath build gets "%.4Qg" right here only because libquadmath's
 constructor teaches glibc the Q modifier -- a glibc extension no other
 platform offers. my_snprintf routes through quadmath_snprintf() itself,
 so it is correct on every build.*/
			snprintf_nv(numbuf, sizeof(numbuf), "%.4" NVgf, SvNV(tmp));
			s = numbuf;
			is_utf8 = 0; // the formatted number is plain ASCII
		}
	}
	if (tex_is_includesvg(s)) { sv_catpv(out, s); return; }
	if (is_utf8) {
/* Walk one Unicode code point at a time so multi-byte letters can be
 remapped. utf8n_to_uvchr (not the _buf form) keeps this on 5.10.*/
		const U8 *p   = (const U8*)s;
		const U8 *end = p + strlen(s);
		while (p < end) {
			STRLEN clen;
			UV cp = utf8n_to_uvchr(p, (STRLEN)(end - p), &clen, 0);
			if (clen == 0) clen = 1; // never stall on malformed input
			if (cp < 0x80) {
				const char c = (char)cp;
				if (c == '#' || c == '_' || c == '%' || c == '&') {
					sv_catpvn(out, "\\", 1);
					sv_catpvn(out, (const char*)p, 1);
				} else if (c == '>') {
					sv_catpvn(out, "\\textgreater{}", 14);
				} else {
					sv_catpvn(out, (const char*)p, 1);
				}
			} else {
				const char *mac = tex_greek_macro(cp);
				if (mac) { sv_catpv(out, mac); sv_catpvn(out, "{}", 2); }
				else sv_catpvn(out, (const char*)p, clen); // pass through
			}
			p += clen;
		}
		return;
	}
	for (const char *p = s; *p; p++) {
		const char c = *p;
		if (c == '#' || c == '_' || c == '%' || c == '&') {
			sv_catpvn(out, "\\", 1);
			sv_catpvn(out, p, 1);
		} else if (c == '>') {
			sv_catpvn(out, "\\textgreater{}", 14);
		} else {
			sv_catpvn(out, p, 1);
		}
	}
}

/* Build the provenance path "<cwd>/<RealScript>" as a mortal SV, mirroring the
 original pure-Perl `getcwd() . '/' . $RealScript`. getcwd() is Cwd::getcwd
 (core, cross-platform) and $RealScript is $FindBin::RealScript; both are read
 from Perl-land so behaviour matches the original. Returns NULL if neither the
 cwd nor a script name is available. Shared by the LaTeX and xlsx writers.*/
static SV *provenance_path(pTHX) {
	SV *out = sv_2mortal(newSVpvs(""));
	bool have = 0;
// cwd via Cwd::getcwd() -- load Cwd (core) if it is not already in.
	if (!get_cv("Cwd::getcwd", 0))
		load_module(PERL_LOADMOD_NOIMPORT, newSVpvs("Cwd"), NULL);
	if (get_cv("Cwd::getcwd", 0)) {
		dSP;
		ENTER; SAVETMPS;
		PUSHMARK(SP);
		PUTBACK;
		int cnt = call_pv("Cwd::getcwd", G_SCALAR);
		SPAGAIN;
		SV *cwd = (cnt > 0) ? POPs : NULL;
		if (cwd && SvOK(cwd)) {
			STRLEN l; const char *cs = SvPV(cwd, l);
			if (l) { sv_catpvn(out, cs, l); have = 1; }
		}
		PUTBACK;
		FREETMPS; LEAVE;
	}
/* Script name: prefer $FindBin::RealScript (what the original used); fall
 back to basename($0) when FindBin was never loaded.*/
	SV *rs = get_sv("FindBin::RealScript", 0);
	const char *script = NULL;
	STRLEN sl = 0;
	if (rs && SvOK(rs)) {
		script = SvPV(rs, sl);
	} else {
		SV *dollar0 = get_sv("0", 0);
		if (dollar0 && SvOK(dollar0)) {
			STRLEN l0; const char *s0 = SvPV(dollar0, l0);
			const char *slash = strrchr(s0, '/');
			script = slash ? slash + 1 : s0;
			sl = strlen(script);
		}
	}
	if (script && sl) {
		sv_catpvn(out, "/", 1);
		sv_catpvn(out, script, sl);
		have = 1;
	}
	return have ? out : NULL;
}

/* The LaTeX provenance banner "%written by <cwd>/<script>", or NULL when no
 path is available (the caller then emits a generic fallback line).*/
static SV *tex_written_by(pTHX) {
	SV *path = provenance_path(aTHX);
	if (!path) return NULL;
	SV *out = sv_2mortal(newSVpvs("%written by "));
	sv_catsv(out, path);
	return out;
}

/* The xlsx provenance string "written by <cwd>/<script>" for the workbook's
 document "comments" property; a generic line when no path is available.*/
static SV *xlsx_written_by(pTHX) {
	SV *path = provenance_path(aTHX);
	SV *out = sv_2mortal(newSVpvs("written by "));
	if (path) sv_catsv(out, path);
	else      sv_catpvn(out, "Stats::LikeR write_table", 24);
	return out;
}

/*Emit one header record -- bold cells joined by " & ", no row terminator.
Factored out because 'tex.longtable.head' writes the same record twice
(\endfirsthead and \endhead), and the two must never drift apart.*/
static void tex_put_header_row(pTHX_ PerlIO *fh, AV *header,
	size_t ncols, SV *scratch)
{
	for (size_t j = 0; j < ncols; j++) {
		if (j) TEX_PUTS(fh, " & ");
		SV **cp = av_fetch(header, (SSize_t)j, 0);
		SV *cv = (cp && *cp && SvOK(*cp)) ? *cp : NULL;
		const char *cs = cv ? SvPV_nolen(cv) : "";
		TEX_PUTS(fh, "\\textbf{");
		tex_escape_sv(aTHX_ scratch, cs, cv ? (SvUTF8(cv) ? 1 : 0) : 0, 0);
		PerlIO_write(fh, SvPVX(scratch), SvCUR(scratch));
		PerlIO_putc(fh, '}');
	}
}

/*Write the full LaTeX tabular. 'rows' is the collected table: element 0 is
the header record, the rest are data records (each an AV of SVs).*/
static void write_tex_tabular(pTHX_ AV *rows, const char *file,
	const char *col_align, bool bold_first_col, bool do_format,
	const char *size, SV *comment, bool longtable,
	SV *longtable_head)
{
	PerlIO *fh = PerlIO_open(file, "w");
	if (!fh)
		croak("write_table: Could not open '%s' for writing", file);
	SV *scratch = sv_2mortal(newSVpvs(""));
// Provenance banner (see tex_written_by); fall back to a generic line.
	SV *prov = tex_written_by(aTHX);
	if (prov) {
		STRLEN pl; const char *ps = SvPV(prov, pl);
		PerlIO_write(fh, ps, pl); PerlIO_putc(fh, '\n');
	} else {
		TEX_PUTS(fh, "%written by Stats::LikeR write_table\n");
	}
	if (comment && SvOK(comment)) {
		if (SvROK(comment) && SvTYPE(SvRV(comment)) == SVt_PVAV) {
			AV *ca = (AV*)SvRV(comment);
			for (SSize_t i = 0; i <= av_len(ca); i++) {
				SV **c = av_fetch(ca, i, 0);
				if (c && *c && SvOK(*c)) {
					STRLEN l; const char *cs = SvPV(*c, l);
					TEX_PUTS(fh, "% "); PerlIO_write(fh, cs, l); PerlIO_putc(fh, '\n');
				}
			}
		} else if (!SvROK(comment)) {
			STRLEN l; const char *cs = SvPV(comment, l);
			TEX_PUTS(fh, "% "); PerlIO_write(fh, cs, l); PerlIO_putc(fh, '\n');
		}
	}
	SV **h0 = av_fetch(rows, 0, 0);
	AV *header = (h0 && *h0 && SvROK(*h0)) ? (AV*)SvRV(*h0) : NULL;
	const size_t ncols = header ? (size_t)(av_len(header) + 1) : 0;
/* With 'tex.longtable' the caller writes the surrounding
 \begin{longtable}{...} ... \end{longtable} (and any \caption / \label)
 and \input{}s this file, so emit only the body: a top rule, the header,
 the data rows, a bottom rule -- no \begin{tabular}/\end{tabular}. The real
 column spec lives on the caller's \begin{longtable}; we emit it once as a
 % comment so the caller can copy a spec with the right number of columns.*/
	if (longtable) {
/* Copy-paste hint for the wrapper the caller must supply, e.g.
   % \begin{longtable}{ccc}
 one 'tex.col.align' char per column. It is a comment, so it never affects
 typesetting -- the caller still writes the real \begin{longtable}{...}.*/
		TEX_PUTS(fh, "% \\begin{longtable}{");
		for (size_t i = 0; i < ncols; i++)
			PerlIO_write(fh, col_align, strlen(col_align));
		TEX_PUTS(fh, "}\n");
//		TEX_PUTS(fh, "\\hline\n");
	} else {
		TEX_PUTS(fh, "\\begin{tabular}{|");
		for (size_t i = 0; i < ncols; i++) {
			PerlIO_write(fh, col_align, strlen(col_align));
			PerlIO_putc(fh, '|');
		}
		TEX_PUTS(fh, "} \\hline\n");
	}
	if (size && *size) { PerlIO_write(fh, size, strlen(size)); PerlIO_putc(fh, '\n'); }
/* 'tex.longtable.head': emit the header inside longtable's repeat machinery
 instead of as a plain first row. Without it the header is an ordinary body
 row, so the header frozen at the top of every page is whichever one the
 caller hand-wrote into \endfirsthead / \endhead -- which silently stops
 matching 'col.names' the moment the column order changes, and leaves the
 generated header showing up a second time as the first body row.*/
	const bool lt_head = longtable && longtable_head && SvTRUE(longtable_head);
	if (header) {
		if (lt_head) {
	/* No leading \hline: \hline expands to \noalign, and TeX has already
	 begun a row by the time it expands the caller's \input, so a rule as
	 the file's first token is a "Misplaced \noalign" error. The top rule
	 for the first page belongs on the caller's \caption line ("\\ \hline"),
	 where it is a static token that cannot fall out of step with the data.
	 Every later \hline here follows a \\ inside this file, where the
	 lookahead sees it and it is legal.*/
			tex_put_header_row(aTHX_ fh, header, ncols, scratch);
			TEX_PUTS(fh, " \\\\ \\hline\n\\endfirsthead\n");
	/* A non-numeric 'tex.longtable.head' is the caption for every page after
	 the first, written verbatim so LaTeX macros survive. The empty optional
	 argument keeps the continuation out of the List of Tables.*/
			if (contains_nondigit(aTHX_ longtable_head)) {
				STRLEN cl;
				const char *cc = SvPV(longtable_head, cl);
				TEX_PUTS(fh, "\\caption[]{");
				PerlIO_write(fh, cc, cl);
				TEX_PUTS(fh, "}\\\\\n");
			}
			TEX_PUTS(fh, "\\hline\n");
			tex_put_header_row(aTHX_ fh, header, ncols, scratch);
	/* \endfoot (no \endlastfoot) rules the bottom of every page, the last
	 one included -- the counterpart of the tabular branch's closing \hline.*/
			TEX_PUTS(fh, " \\\\ \\hline\n\\endhead\n\\hline\n\\endfoot\n");
		} else {
			tex_put_header_row(aTHX_ fh, header, ncols, scratch);
			TEX_PUTS(fh, " \\\\ \\hline\n");
		}
	}
	const size_t nrows = av_len(rows) + 1;
	for (size_t i = 1; i < nrows; i++) {
		SV **rp = av_fetch(rows, i, 0);
		AV *row = (rp && *rp && SvROK(*rp)) ? (AV*)SvRV(*rp) : NULL;
		const size_t rc = row ? (size_t)(av_len(row) + 1) : 0;
		for (size_t j = 0; j < rc; j++) {
			if (j) TEX_PUTS(fh, " & ");
			const bool bold = (bold_first_col && j == 0);
			SV **cp = av_fetch(row, (SSize_t)j, 0);
			SV *cv = (cp && *cp && SvOK(*cp)) ? *cp : NULL;
			const char *cs = cv ? SvPV_nolen(cv) : "";
			if (bold) TEX_PUTS(fh, "\\textbf{");
			tex_escape_sv(aTHX_ scratch, cs, cv ? (SvUTF8(cv) ? 1 : 0) : 0, do_format);
			PerlIO_write(fh, SvPVX(scratch), SvCUR(scratch));
			if (bold) PerlIO_putc(fh, '}');
		}
		TEX_PUTS(fh, "\\\\\n");
	}
	if (!longtable) {
		TEX_PUTS(fh, "\\hline \\end{tabular}\n");
	}
	PerlIO_close(fh);
}

/*write_table: .xlsx (Excel) output, dependency-free
An .xlsx file is a ZIP of XML parts. We build the parts as strings and pack
them into a STORED (uncompressed) ZIP ourselves, so there is no zlib / CPAN
dependency and everything stays in XS. The provenance line (provenance_path)
is written into the workbook's document properties as the "comments" field
-- dc:description in docProps/core.xml -- mirroring
    $workbook->set_properties(comments => comments());
from Excel::Writer::XLSX. A numeric-looking cell is written as a number;
every other non-empty cell as an inline string. read_table reads it back.*/
#define SV_CATLIT(sv, lit) sv_catpvn((sv), "" lit, sizeof(lit) - 1)

// CRC-32/IEEE over a byte buffer (each stored ZIP member needs its checksum)
static uint32_t xlsx_crc32(const unsigned char *data, size_t len) {
	/*The 256-entry lookup table is data-independent, so build it once and
	reuse it across the many calls per workbook.  A concurrent first call
	on another thread merely recomputes the identical constants — benign.*/
	static uint32_t table[256];
	static bool table_ready = 0;
	if (!table_ready) {
		for (uint32_t i = 0; i < 256; i++) {
			uint32_t c = i;
			for (int k = 0; k < 8; k++)
				c = (c & 1u) ? (0xEDB88320u ^ (c >> 1)) : (c >> 1);
			table[i] = c;
		}
		table_ready = 1;
	}
	uint32_t crc = 0xFFFFFFFFu;
	for (size_t i = 0; i < len; i++)
		crc = table[(crc ^ data[i]) & 0xFFu] ^ (crc >> 8);
	return crc ^ 0xFFFFFFFFu;
}

// little-endian field writers, appending to a byte-buffer SV
static void zip_le16(pTHX_ SV *b, unsigned v) {
	unsigned char x[2] = { (unsigned char)(v & 0xFF), (unsigned char)((v >> 8) & 0xFF) };
	sv_catpvn(b, (char*)x, 2);
}
static void zip_le32(pTHX_ SV *b, uint32_t v) {
	unsigned char x[4] = { (unsigned char)(v & 0xFF), (unsigned char)((v >> 8) & 0xFF),
		(unsigned char)((v >> 16) & 0xFF), (unsigned char)((v >> 24) & 0xFF) };
	sv_catpvn(b, (char*)x, 4);
}

// Append an unsigned integer's decimal text to an SV
static void xlsx_cat_uint(pTHX_ SV *b, unsigned long v) {
	char tmp[24];
	int n = snprintf(tmp, sizeof(tmp), "%lu", v);
	if (n > 0) sv_catpvn(b, tmp, (STRLEN)n);
}

/*Append s (UTF-8 bytes) to out, escaping XML metacharacters and dropping the
control characters XML 1.0 forbids (all but tab / newline / carriage-return).*/
static void xlsx_xml_cat(pTHX_ SV *out, const char *s, STRLEN len) {
	for (STRLEN i = 0; i < len; i++) {
		unsigned char c = (unsigned char)s[i];
		switch (c) {
		case '&':  SV_CATLIT(out, "&amp;");  break;
		case '<':  SV_CATLIT(out, "&lt;");   break;
		case '>':  SV_CATLIT(out, "&gt;");   break;
		case '"':  SV_CATLIT(out, "&quot;"); break;
		case '\'': SV_CATLIT(out, "&apos;"); break;
		default:
			if (c < 0x20 && c != '\t' && c != '\n' && c != '\r') break;
			sv_catpvn(out, (const char*)&s[i], 1);
		}
	}
}

// 0-based column index -> A1-style letters (A, B, ..., Z, AA, ...) appended
static void xlsx_col_letters(pTHX_ SV *b, size_t idx) {
	char tmp[16];
	int n = 0;
	size_t v = idx + 1; // bijective base-26
	while (v > 0 && n < (int)sizeof(tmp)) {
		v -= 1;
		tmp[n++] = (char)('A' + (int)(v % 26));
		v /= 26;
	}
	while (n > 0) { char c = tmp[--n]; sv_catpvn(b, &c, 1); }
}

/*True when a cell should be written as an xlsx number: looks_like_number and
made only of the characters a plain/scientific decimal uses, so "Inf"/"NaN"
and space-padded values fall back to text and never produce an invalid <v>.*/
static bool xlsx_plain_number(pTHX_ SV *cell) {
	if (!cell || !SvOK(cell) || !looks_like_number(cell)) return 0;
	STRLEN l; const char *s = SvPV(cell, l);
	if (l == 0) return 0;
	for (STRLEN i = 0; i < l; i++) {
		char c = s[i];
		if (!((c >= '0' && c <= '9') || c == '.' || c == 'e' || c == 'E'
				|| c == '+' || c == '-')) return 0;
	}
	return 1;
}

/*Append one STORED (uncompressed) member to the ZIP under construction: 'zip'
is the growing archive, 'cdir' accumulates its central-directory records and
'*count' the member count.*/
static void xlsx_zip_add(pTHX_ SV *zip, SV *cdir,
	unsigned *count, const char *name, SV *content)
{
	STRLEN nlen = strlen(name);
	STRLEN clen; const char *cdata = SvPV(content, clen);
	uint32_t crc = xlsx_crc32((const unsigned char*)cdata, (size_t)clen);
	uint32_t off = (uint32_t)SvCUR(zip);
	//local file header
	zip_le32(aTHX_ zip, 0x04034b50);
	zip_le16(aTHX_ zip, 20);		//version needed to extract
	zip_le16(aTHX_ zip, 0);			//general-purpose flags
	zip_le16(aTHX_ zip, 0);			//method 0 = stored
	zip_le16(aTHX_ zip, 0);			//mod time
	zip_le16(aTHX_ zip, 0x21);		//mod date = 1980-01-01
	zip_le32(aTHX_ zip, crc);
	zip_le32(aTHX_ zip, (uint32_t)clen);	//compressed size
	zip_le32(aTHX_ zip, (uint32_t)clen);	//uncompressed size
	zip_le16(aTHX_ zip, (unsigned)nlen);
	zip_le16(aTHX_ zip, 0);			//extra length
	sv_catpvn(zip, name, nlen);
	sv_catpvn(zip, cdata, clen);
	//central-directory header
	zip_le32(aTHX_ cdir, 0x02014b50);
	zip_le16(aTHX_ cdir, 20);		//version made by
	zip_le16(aTHX_ cdir, 20);		//version needed
	zip_le16(aTHX_ cdir, 0);
	zip_le16(aTHX_ cdir, 0);
	zip_le16(aTHX_ cdir, 0);
	zip_le16(aTHX_ cdir, 0x21);
	zip_le32(aTHX_ cdir, crc);
	zip_le32(aTHX_ cdir, (uint32_t)clen);
	zip_le32(aTHX_ cdir, (uint32_t)clen);
	zip_le16(aTHX_ cdir, (unsigned)nlen);
	zip_le16(aTHX_ cdir, 0);		//extra length
	zip_le16(aTHX_ cdir, 0);		//comment length
	zip_le16(aTHX_ cdir, 0);		//disk number start
	zip_le16(aTHX_ cdir, 0);		//internal attributes
	zip_le32(aTHX_ cdir, 0);		//external attributes
	zip_le32(aTHX_ cdir, off);		//local-header offset
	sv_catpvn(cdir, name, nlen);
	(*count)++;
}

/*Build a complete .xlsx from the collected rows (element 0 = header record,
the rest data records, each an AV of SVs -- exactly what print_string_row()
gathers for the tex path) and write it to 'file'. freeze_rows / freeze_cols
give the number of leading rows / columns to freeze in place (0 = none).*/
static void write_xlsx_workbook(pTHX_ AV *rows, const char *file,
	const char *sheet_name, SV *comment,
	unsigned freeze_rows, unsigned freeze_cols)
{
	//worksheet
	SV *sheet = sv_2mortal(newSVpvs(
		"<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"yes\"?>"
		"<worksheet xmlns=\"http://schemas.openxmlformats.org/spreadsheetml/2006/main\">"));
	/*Freeze panes: a <sheetViews> block, which the schema requires *before*
	<sheetData>. topLeftCell is the first cell below/right of the frozen
	region -- e.g. freezing 1 row gives "A2"; 1 row + 2 cols gives "C2".*/
	if (freeze_rows || freeze_cols) {
		SV *tl = sv_2mortal(newSVpvs(""));
		xlsx_col_letters(aTHX_ tl, (size_t)freeze_cols);
		xlsx_cat_uint(aTHX_ tl, (unsigned long)freeze_rows + 1);
		STRLEN tll; const char *tls = SvPV(tl, tll);
		const char *ap = (freeze_rows && freeze_cols) ? "bottomRight"
			: freeze_cols ? "topRight" : "bottomLeft";
		SV_CATLIT(sheet, "<sheetViews><sheetView workbookViewId=\"0\"><pane ");
		if (freeze_cols) {
			SV_CATLIT(sheet, "xSplit=\"");
			xlsx_cat_uint(aTHX_ sheet, (unsigned long)freeze_cols);
			SV_CATLIT(sheet, "\" ");
		}
		if (freeze_rows) {
			SV_CATLIT(sheet, "ySplit=\"");
			xlsx_cat_uint(aTHX_ sheet, (unsigned long)freeze_rows);
			SV_CATLIT(sheet, "\" ");
		}
		SV_CATLIT(sheet, "topLeftCell=\"");
		sv_catpvn(sheet, tls, tll);
		SV_CATLIT(sheet, "\" activePane=\"");
		sv_catpv(sheet, ap);
		SV_CATLIT(sheet, "\" state=\"frozen\"/><selection pane=\"");
		sv_catpv(sheet, ap);
		SV_CATLIT(sheet, "\" activeCell=\"");
		sv_catpvn(sheet, tls, tll);
		SV_CATLIT(sheet, "\" sqref=\"");
		sv_catpvn(sheet, tls, tll);
		SV_CATLIT(sheet, "\"/></sheetView></sheetViews>");
	}
	SV_CATLIT(sheet, "<sheetData>");
	SSize_t nrows = av_len(rows) + 1;
	for (SSize_t r = 0; r < nrows; r++) {
		SV **rp = av_fetch(rows, r, 0);
		AV *row = (rp && *rp && SvROK(*rp)
			&& SvTYPE(SvRV(*rp)) == SVt_PVAV) ? (AV*)SvRV(*rp) : NULL;
		SSize_t ncols = row ? av_len(row) + 1 : 0;
		SV_CATLIT(sheet, "<row r=\"");
		xlsx_cat_uint(aTHX_ sheet, (unsigned long)(r + 1));
		SV_CATLIT(sheet, "\">");
		for (SSize_t c = 0; c < ncols; c++) {
			SV **cp = av_fetch(row, c, 0);
			SV *cell = (cp && *cp) ? *cp : NULL;
			if (!cell || !SvOK(cell)) continue;	//undef -> omit cell
			if (xlsx_plain_number(aTHX_ cell)) {
				STRLEN vl; const char *vs = SvPV(cell, vl);
				SV_CATLIT(sheet, "<c r=\"");
				xlsx_col_letters(aTHX_ sheet, (size_t)c);
				xlsx_cat_uint(aTHX_ sheet, (unsigned long)(r + 1));
				SV_CATLIT(sheet, "\"><v>");
				sv_catpvn(sheet, vs, vl);
				SV_CATLIT(sheet, "</v></c>");
			} else {
				STRLEN vl; const char *vs = SvPVutf8(cell, vl);
				if (vl == 0) continue;		//empty string -> omit cell
				SV_CATLIT(sheet, "<c r=\"");
				xlsx_col_letters(aTHX_ sheet, (size_t)c);
				xlsx_cat_uint(aTHX_ sheet, (unsigned long)(r + 1));
				SV_CATLIT(sheet, "\" t=\"inlineStr\"><is><t xml:space=\"preserve\">");
				xlsx_xml_cat(aTHX_ sheet, vs, vl);
				SV_CATLIT(sheet, "</t></is></c>");
			}
		}
		SV_CATLIT(sheet, "</row>");
	}
	SV_CATLIT(sheet, "</sheetData></worksheet>");

	// document properties: provenance goes in the "comments" field
	SV *core = sv_2mortal(newSVpvs(
		"<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"yes\"?>"
		"<cp:coreProperties "
		"xmlns:cp=\"http://schemas.openxmlformats.org/package/2006/metadata/core-properties\" "
		"xmlns:dc=\"http://purl.org/dc/elements/1.1/\" "
		"xmlns:dcterms=\"http://purl.org/dc/terms/\" "
		"xmlns:dcmitype=\"http://purl.org/dc/dcmitype/\" "
		"xmlns:xsi=\"http://www.w3.org/2001/XMLSchema-instance\">"
		"<dc:creator>Stats::LikeR</dc:creator>"
		"<cp:lastModifiedBy>Stats::LikeR</cp:lastModifiedBy>"
		"<dc:description>"));
	if (comment && SvOK(comment)) {
		STRLEN dl; const char *ds = SvPVutf8(comment, dl);
		xlsx_xml_cat(aTHX_ core, ds, dl);
	}
	SV_CATLIT(core, "</dc:description></cp:coreProperties>");

	SV *ctypes = sv_2mortal(newSVpvs(
		"<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"yes\"?>"
		"<Types xmlns=\"http://schemas.openxmlformats.org/package/2006/content-types\">"
		"<Default Extension=\"rels\" ContentType=\"application/vnd.openxmlformats-package.relationships+xml\"/>"
		"<Default Extension=\"xml\" ContentType=\"application/xml\"/>"
		"<Override PartName=\"/xl/workbook.xml\" ContentType=\"application/vnd.openxmlformats-officedocument.spreadsheetml.sheet.main+xml\"/>"
		"<Override PartName=\"/xl/worksheets/sheet1.xml\" ContentType=\"application/vnd.openxmlformats-officedocument.spreadsheetml.worksheet+xml\"/>"
		"<Override PartName=\"/docProps/core.xml\" ContentType=\"application/vnd.openxmlformats-package.core-properties+xml\"/>"
		"</Types>"));
	SV *rels = sv_2mortal(newSVpvs(
		"<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"yes\"?>"
		"<Relationships xmlns=\"http://schemas.openxmlformats.org/package/2006/relationships\">"
		"<Relationship Id=\"rId1\" Type=\"http://schemas.openxmlformats.org/officeDocument/2006/relationships/officeDocument\" Target=\"xl/workbook.xml\"/>"
		"<Relationship Id=\"rId2\" Type=\"http://schemas.openxmlformats.org/package/2006/relationships/metadata/core-properties\" Target=\"docProps/core.xml\"/>"
		"</Relationships>"));
	SV *wbrels = sv_2mortal(newSVpvs(
		"<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"yes\"?>"
		"<Relationships xmlns=\"http://schemas.openxmlformats.org/package/2006/relationships\">"
		"<Relationship Id=\"rId1\" Type=\"http://schemas.openxmlformats.org/officeDocument/2006/relationships/worksheet\" Target=\"worksheets/sheet1.xml\"/>"
		"</Relationships>"));
	SV *workbook = sv_2mortal(newSVpvs(
		"<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"yes\"?>"
		"<workbook xmlns=\"http://schemas.openxmlformats.org/spreadsheetml/2006/main\" "
		"xmlns:r=\"http://schemas.openxmlformats.org/officeDocument/2006/relationships\">"
		"<sheets><sheet name=\""));
	xlsx_xml_cat(aTHX_ workbook, sheet_name, strlen(sheet_name));
	SV_CATLIT(workbook, "\" sheetId=\"1\" r:id=\"rId1\"/></sheets></workbook>");

	// pack the ZIP (stored, no compression) */
	SV *zip  = sv_2mortal(newSVpvs(""));
	SV *cdir = sv_2mortal(newSVpvs(""));
	unsigned count = 0;
	xlsx_zip_add(aTHX_ zip, cdir, &count, "[Content_Types].xml",        ctypes);
	xlsx_zip_add(aTHX_ zip, cdir, &count, "_rels/.rels",                rels);
	xlsx_zip_add(aTHX_ zip, cdir, &count, "docProps/core.xml",          core);
	xlsx_zip_add(aTHX_ zip, cdir, &count, "xl/workbook.xml",            workbook);
	xlsx_zip_add(aTHX_ zip, cdir, &count, "xl/_rels/workbook.xml.rels", wbrels);
	xlsx_zip_add(aTHX_ zip, cdir, &count, "xl/worksheets/sheet1.xml",   sheet);
	// central directory, then end-of-central-directory record */
	uint32_t cd_off = (uint32_t)SvCUR(zip);
	STRLEN cd_len; const char *cd = SvPV(cdir, cd_len);
	sv_catpvn(zip, cd, cd_len);
	zip_le32(aTHX_ zip, 0x06054b50);
	zip_le16(aTHX_ zip, 0);			//number of this disk
	zip_le16(aTHX_ zip, 0);			//disk with central directory
	zip_le16(aTHX_ zip, (unsigned)count);	//central-dir entries this disk
	zip_le16(aTHX_ zip, (unsigned)count);	//total central-dir entries
	zip_le32(aTHX_ zip, (uint32_t)cd_len);
	zip_le32(aTHX_ zip, cd_off);
	zip_le16(aTHX_ zip, 0);			//archive comment length

	PerlIO *fh = PerlIO_open(file, "wb");
	if (!fh) croak("write_table: Could not open '%s' for writing", file);
	STRLEN zl; const char *zb = SvPV(zip, zl);
	PerlIO_write(fh, zb, zl);
	PerlIO_close(fh);
}

/* Calculates the Regularized Upper Incomplete Gamma Function Q(a, x)
 Perfectly replicates R's pchisq(..., lower.tail=FALSE)*/
NV igamc(NV a, NV x) {
	if (x < 0.0 || a <= 0.0) return 1.0;
	if (x == 0.0) return 1.0;

	// Series expansion for x < a + 1
	if (x < a + 1.0) {
		NV sum = 1.0 / a;
		NV term = 1.0 / a;
		NV n = 1.0;
		while (nv_fabs(term) > 1e-15) {
			term *= x / (a + n);
			sum += term;
			n += 1.0;
		}
		return 1.0 - (sum * nv_exp(-x + a * nv_log(x) - nv_lgamma(a)));
	}

	// Continued fraction for x >= a + 1
	NV b = x + 1.0 - a;
	NV c = 1.0 / 1e-30;
	NV d = 1.0 / b;
	NV h = d, i = 1.0;
	while (i < 10000) { // Safety bound
		NV an = -i * (i - a);
		b += 2.0;
		d = an * d + b;
		if (nv_fabs(d) < 1e-30) d = 1e-30;
		c = b + an / c;
		if (nv_fabs(c) < 1e-30) c = 1e-30;
		d = 1.0 / d;
		NV del = d * c;
		h *= del;
		if (nv_fabs(del - 1.0) < 1e-15) break;
		i += 1.0;
	}
	return h * nv_exp(-x + a * nv_log(x) - nv_lgamma(a));
}

/*Regularized LOWER incomplete gamma P(a, x) -- R's pchisq(..., lower = TRUE)
on (df/2, x/2), and the quantity igamc() above has always formed internally:
its x < a + 1 branch computes P by series and then returns 1 - P.

Exposing P directly is the whole point. A lower tail reached as 1 - igamc()
keeps almost nothing of a small one: at pchisq(0.001, 1) the lower tail is
2.5e-2 and igamc is 0.975, which is fine, but at pchisq(1e-30, 1) the tail is
2.5e-15 while 1 - igamc() can only report a multiple of NV_EPSILON there. Same
series and same 1e-15 term cutoff as igamc(), so where both are well
conditioned the two agree by construction rather than by coincidence.*/
static NV igam(NV a, NV x) {
	if (x < 0.0 || a <= 0.0) return 0.0;
	if (x == 0.0) return 0.0;
	if (x < a + 1.0) {
		NV sum = 1.0 / a;
		NV term = 1.0 / a;
		NV n = 1.0;
		while (nv_fabs(term) > 1e-15) {
			term *= x / (a + n);
			sum += term;
			n += 1.0;
		}
		return sum * nv_exp(-x + a * nv_log(x) - nv_lgamma(a));
	}
	/*x >= a + 1 puts the lower tail near 1, where the subtraction is the
	well-conditioned direction and the continued fraction is the accurate one.*/
	return 1.0 - igamc(a, x);
}

// Chi-Squared p-value is simply the Incomplete Gamma of (df/2, stat/2)
NV get_p_value(NV stat, int df) {
	/*NaN in, NaN out, and say so here: every comparison below is false for a
	NaN, so without this the statistic reaches igamc()'s continued fraction and
	spins its whole 10000-iteration safety bound before returning the NaN
	anyway. R does the same -- pchisq(NaN, df) is NaN -- and a Kruskal-Wallis
	on constant data is the case that gets here (0/0 tie correction).*/
	if (nv_isnan(stat)) return NV_NAN;
	if (df <= 0) return 1.0;
	if (stat <= 0.0) return 1.0;   // includes -Inf: the whole mass is above it
	/*The upper tail at +Inf is 0, which is what R's pchisq(Inf, df, lower =
	FALSE) gives.  Without this the statistic reaches igamc()'s continued
	fraction, where the first 1/d is 1/Inf = 0 and then del = 0 * Inf = NaN, so
	an overwhelmingly significant result was reported as no result at all.  It
	is reachable: kruskal_test() on a sample with no variation divides an
	inexact 0 by an exact 0 once n^3 is past 2^53 and the tie correction's
	(n^3 - n) rounds to n^3 -- R's own kruskal.test() returns Inf there too.*/
	if (nv_isinf(stat)) return 0.0;
	return igamc((NV)df / 2.0, stat / 2.0);
}

/*Digamma psi(x) and trigamma psi'(x) for x > 0, via recurrence up to x>=6
then an asymptotic (Stirling) series. Accuracy ~1e-12, matching R's
digamma()/trigamma() to the precision the negative-binomial theta ML needs.*/
static NV c_digamma(NV x) {
	NV result = 0.0;
	while (x < 6.0) { result -= 1.0 / x; x += 1.0; }
	NV f = 1.0 / (x * x);
	result += nv_log(x) - 0.5 / x
		- f * (1.0/12.0 - f * (1.0/120.0 - f * (1.0/252.0 - f * (1.0/240.0))));
	return result;
}
static NV c_trigamma(NV x) {
	NV result = 0.0;
	while (x < 6.0) { result += 1.0 / (x * x); x += 1.0; }
	NV f = 1.0 / (x * x);
	result += 1.0 / x + 0.5 * f
		+ (f / x) * (1.0/6.0 - f * (1.0/30.0 - f * (1.0/42.0)));
	return result;
}

/*ML estimate of the negative-binomial dispersion theta at the fitted means
mu[i], following MASS::theta.ml step for step: unit weights, the moment
estimator n / sum((y/mu - 1)^2) as the starting value, and Newton on the
score using the observed information.

The stopping rule is MASS's, and it is deliberately slack for a Newton
iteration: an ABSOLUTE step tolerance of .Machine$double.eps^0.25, which is
exactly 2^-13 (1.22e-4), and at most limit - 1 steps. Because Newton squares
its error, a step that small means theta itself is already good to around
1e-8, so the looseness costs little -- and reproducing it matters more than
tightening it would gain, since glm.nb's alternation feeds each theta straight
back into the next fit. Iterating further here would converge to a slightly
different fixed point of that alternation than MASS reaches.

MASS also has `t0 <- abs(t0)` at the top of each step and truncates a negative
result at zero; the truncation is floored at a tiny positive value instead,
because theta divides the variance downstream and an exact zero would poison
the fit rather than report it.*/
static NV nb_theta_ml(const NV *y, const NV *mu, size_t n,
                      unsigned int limit) {
	NV denom = 0.0;
	for (size_t i = 0; i < n; i++) {
		NV r = y[i] / mu[i] - 1.0;
		denom += r * r;
	}
	NV t0 = (denom > 0.0) ? (NV)n / denom : 1.0;
	if (!(t0 > 0.0) || !nv_isfinite(t0)) t0 = 1.0;
	{
		const NV eps = nv_pow((NV)DBL_EPSILON, 0.25);   //MASS: double.eps^0.25
		NV del = 1.0;
		unsigned int it = 0;
		//MASS: while ((it <- it + 1) < limit && abs(del) > eps)
		while (++it < limit && nv_fabs(del) > eps) {
			NV score = 0.0, info = 0.0;
			t0 = nv_fabs(t0);
			for (size_t i = 0; i < n; i++) {
				NV mt = mu[i] + t0;
				score += c_digamma(t0 + y[i]) - c_digamma(t0)
					+ nv_log(t0) + 1.0 - nv_log(mt) - (y[i] + t0) / mt;
				info += -c_trigamma(t0 + y[i]) + c_trigamma(t0)
					- 1.0 / t0 + 2.0 / mt - (y[i] + t0) / (mt * mt);
			}
			if (info == 0.0 || !nv_isfinite(info)) break;
			del = score / info;
			t0 += del;
		}
	}
	if (!(t0 > 0.0) || !nv_isfinite(t0)) t0 = 1e-8;
	return t0;
}

//Per-observation unit deviance for the log-link count families.
static NV dev_poisson(NV y, NV mu) {
	NV t = (y > 0.0) ? y * nv_log(y / mu) : 0.0;
	return 2.0 * (t - (y - mu));
}
static NV dev_negbin(NV y, NV mu, NV th) {
	NV t = (y > 0.0) ? y * nv_log(y / mu) : 0.0;
	/*log1p keeps (y+th)*log((y+th)/(mu+th)) accurate when th >> mu (the log
	of a ratio very near 1), preventing negative deviances near the
	Poisson limit.*/
	return 2.0 * (t - (y + th) * nv_log1p((y - mu) / (mu + th)));
}
/*Total log-likelihood of a fitted negative-binomial model (used for the
theta outer-loop convergence check and AIC).*/
static NV nb_loglik(const NV *y, const NV *mu, size_t n, NV th) {
	NV ll = 0.0;
	for (size_t i = 0; i < n; i++) {
		NV yi = y[i], mi = mu[i];
		/*lgamma(th+yi) - lgamma(th): sum logs directly for integer counts to
		avoid catastrophic cancellation when th is large (near-Poisson).*/
		NV lg, k = nv_floor(yi + 0.5);
		if (nv_fabs(yi - k) < 1e-9 && k >= 0.0 && k < 1e6) {
			lg = 0.0;
			for (NV j = 0.0; j < k; j += 1.0) lg += nv_log(th + j);
		} else {
			lg = nv_lgamma(th + yi) - nv_lgamma(th);
		}
		//th*log(th) + yi*log(mu) - (th+yi)*log(th+mu), regrouped for stability
		ll += lg - nv_lgamma(yi + 1.0)
			- th * nv_log1p(mi / th)
			+ (yi > 0.0 ? yi * nv_log(mi / (th + mi)) : 0.0);
	}
	return ll;
}

#ifndef M_SQRT1_2
#define M_SQRT1_2 0.70710678118654752440
#endif

/* WILCOXON EXACT NULL DISTRIBUTIONS

   Every exact p-value wilcox_test() reports comes out of one WilcoxDist.
   There are four ways to build one:

     * no ties, signed rank -- subset sums of {1..n}, R's csignrank();
     * no ties, rank sum    -- Gaussian binomial coefficients, R's cwilcox();
     * ties or zeroes, signed rank -- the Streitberg-Roehmel shift algorithm
       conditioned on the observed ranks, R's dpermdist1();
     * ties, rank sum -- the two-sample shift algorithm, R's dpermdist2().

   The last two are what R 4.6.0 added (NEWS: "wilcox.test() can now perform
   exact (conditional) inference in case of ties", contributed by Torsten
   Hothorn); before that R fell back to the normal approximation and warned,
   which is what this module used to do.

   The table holds *counts*, not probabilities, and `total` holds their sum.
   Normalising only when a tail is asked for is what keeps the far tail
   accurate: computing the upper tail as 1 - CDF(q-1) cancels away every
   significant digit once the true p drops below NV_EPSILON, and silently
   returns a flat 0 -- reachable with nothing more exotic than two separated
   samples of 30 apiece, which is the *default* exact branch.

   d[i] is the number of permutations for which SCALE * STATISTIC == i + base.
   `scale` is 2 exactly when a tie group of odd size gives half-integral
   ranks, so that the support can still be indexed by a whole number. */
typedef struct {
	NV *d;
	NV total;                 /* sum of d[0 .. len-1] */
	size_t len;
	IV base;                  /* scaled statistic that d[0] counts */
	unsigned short int scale; /* 1 for integral ranks, 2 for half-integral */
	bool symmetric;           /* d[i] == d[len-1-i]; see wdist_tail() */
} WilcoxDist;

/* Ceiling on the cells of any one exact table: 16M NVs is 128MB on a double
   perl and 256MB on quadmath. Generous for a table the caller asked for with
   exact => 1, small enough that a mistaken request croaks instead of inviting
   the OOM killer. R has no such guard and simply tries the allocation. */
#define WILCOX_MAX_CELLS ((size_t)16777216)

static void wilcox_too_big(pTHX) __attribute__noreturn__;
static void wilcox_too_big(pTHX) {
	croak("wilcox_test: the exact null distribution would need more than %" UVuf
	      " cells; use exact => 0", (UV)WILCOX_MAX_CELLS);
}

/* a * b, refusing to wrap. Both factors are counts derived from the caller's
   sample sizes, so on a 32-bit size_t the product genuinely can overflow --
   which is how `int max_u = m * n` used to turn two perfectly separated
   samples of 50000 into p = 1. */
static size_t wilcox_cells(pTHX_ size_t a, size_t b) {
	if (a > WILCOX_MAX_CELLS || b > WILCOX_MAX_CELLS) wilcox_too_big(aTHX);
	if (a != 0 && b > WILCOX_MAX_CELLS / a)           wilcox_too_big(aTHX);
	return a * b;
}

/* n * (n + 1) / 2, likewise. The wrap check comes first because on a 32-bit
   size_t the product overflows well before the cell ceiling is reached. */
static size_t wilcox_triangle(pTHX_ size_t n) {
	if (n != 0 && n + 1 > ((size_t)-1) / n) wilcox_too_big(aTHX);
	size_t t = n * (n + 1) / 2;
	if (t > WILCOX_MAX_CELLS) wilcox_too_big(aTHX);
	return t;
}

static void wdist_free(WilcoxDist *D) {
	if (D->d) { Safefree(D->d); D->d = NULL; }
	D->len = 0;
	D->total = 0.0;
}

/* R's dpermdist*() error out rather than hand back a distribution whose
   counts have run past the floating-point range; so do we. */
static void wdist_finish(pTHX_ WilcoxDist *D) {
	NV total = 0.0;
	for (size_t i = 0; i < D->len; i++) {
		if (!nv_isfinite(D->d[i])) {
			wdist_free(D);
			croak("wilcox_test: overflow computing the exact distribution; use exact => 0");
		}
		total += D->d[i];
	}
	if (!nv_isfinite(total) || total <= 0.0) {
		wdist_free(D);
		croak("wilcox_test: overflow computing the exact distribution; use exact => 0");
	}
	D->total = total;
}

/* P(STATISTIC <= q) when `lower`, else P(STATISTIC > q).
   The fuzz matches R: nmath's psignrank()/pwilcox() floor at q + 1e-7 and
   the R-level .psignrank()/.pwilcox() keep support points below q + 1e-8, so
   a support point sitting exactly on q counts as inside the lower tail. */
static NV wdist_tail(const WilcoxDist *D, NV q, bool lower) {
	NV cut = nv_floor(q * (NV)D->scale + 1e-7) - (NV)D->base;
	/* Outside the support the answer is a certainty either way, and saying so
	   here keeps the index arithmetic below inside the array. */
	if (!(cut >= 0.0))            return lower ? 0.0 : 1.0;
	if (cut >= (NV)(D->len - 1))  return lower ? 1.0 : 0.0;
	size_t k = (size_t)cut;       /* last index in the lower tail */
/* When d[i] == d[len-1-i], always sum from the low end. wdist_ranksum() builds
  its table with the subtractive Gaussian-binomial recurrence, so far up the
  support a count of 1 is the difference of numbers around C(m+n, n) and has
  been rounded into noise -- accurate enough to add into a sum of its
  neighbours, useless on its own. Summing the mirrored low end instead touches
  only well-conditioned entries. R does the same thing in pwilcox(), folding q
  about m*n/2 and flipping lower_tail. */
	if (D->symmetric && k >= D->len / 2) {
		size_t k2 = D->len - 2 - k;          /* P(S > q) == P(S <= mirror) */
		NV s = 0.0;
		for (size_t i = 0; i <= k2; i++) s += D->d[i];
		s /= D->total;
		return lower ? 1.0 - s : s;
	}
	NV sum = 0.0;
	if (lower) for (size_t i = 0; i <= k; i++)         sum += D->d[i];
	else       for (size_t i = k + 1; i < D->len; i++) sum += D->d[i];
	return sum / D->total;
}

/* Smallest support point s with P(STATISTIC <= s) >= p, R's qsignrank() and
   qwilcox(), including their 10 * eps slack. Only ever called on the no-ties
   tables the exact confidence interval indexes into, so base is 0 and scale 1. */
static NV wdist_quantile(const WilcoxDist *D, NV p) {
	NV target = (p - 10.0 * NV_EPSILON) * D->total;
	NV cum = 0.0;
	for (size_t i = 0; i < D->len; i++) {
		cum += D->d[i];
		if (cum >= target) return (NV)((IV)i + D->base) / (NV)D->scale;
	}
	return (NV)((IV)(D->len - 1) + D->base) / (NV)D->scale;
}

/* Signed rank, no ties: d[v] = #{S subset of {1..n} : sum(S) == v}. */
static void wdist_signrank(pTHX_ WilcoxDist *restrict D, size_t n) {
	size_t max_v = wilcox_triangle(aTHX_ n);
	D->len   = max_v + 1;
	D->base  = 0;
	D->scale = 1;
	D->symmetric = TRUE;
	Newxz(D->d, D->len, NV);
	D->d[0] = 1.0;
	for (size_t i = 1; i <= n; i++)
		for (size_t j = max_v; j >= i; j--)
			D->d[j] += D->d[j - i];
	wdist_finish(aTHX_ D);
}

/* Rank sum, no ties: the Gaussian binomial coefficient
   prod_{j=1..n} (1 - q^(m+j)) / (1 - q^j), the same generating function R's
   cwilcox() recursion enumerates. d[u] counts the samples with U == u. */
static void wdist_ranksum(pTHX_ WilcoxDist *restrict D, size_t m, size_t n) {
	size_t max_u = wilcox_cells(aTHX_ m, n);
	D->len   = max_u + 1;
	D->base  = 0;
	D->scale = 1;
	D->symmetric = TRUE;
	Newxz(D->d, D->len, NV);
	D->d[0] = 1.0;
	for (size_t j = 1; j <= n; j++) {
		for (size_t i = j; i <= max_u; i++) D->d[i] += D->d[i - j];
		for (size_t i = max_u + 1; i-- > j + m; )  D->d[i] -= D->d[i - j - m];
	}
	wdist_finish(aTHX_ D);
}

/* Signed rank conditional on the observed ranks -- R's dpermdist1(), the
   one-sample Streitberg-Roehmel shift algorithm. z holds the scaled ranks of
   the non-zero observations; zeroes contribute nothing to V and are simply
   left out (see the long comment above .wilcox_test_one_stat_exact in R's
   wilcox.test.R). d[v] then counts the sign-flip vectors giving V == v/scale. */
static void wdist_signrank_perm(pTHX_ WilcoxDist *restrict D,
                                const UV *restrict z, size_t n,
                                unsigned short int scale) {
	size_t sum_a = 0;
	for (size_t i = 0; i < n; i++) {
		if (z[i] > WILCOX_MAX_CELLS - sum_a) wilcox_too_big(aTHX);
		sum_a += (size_t)z[i];
	}
	D->len   = sum_a + 1;
	D->base  = 0;
	D->scale = scale;
	D->symmetric = FALSE;   /* only when every rank is distinct, so never assume it */
	Newxz(D->d, D->len, NV);
	D->d[0] = 1.0;
	size_t s_a = 0;
	for (size_t k = 0; k < n; k++) {
		s_a += (size_t)z[k];
		for (size_t i = s_a + 1; i-- > (size_t)z[k]; )
			D->d[i] += D->d[i - (size_t)z[k]];
	}
	wdist_finish(aTHX_ D);
}

/* Rank sum conditional on the observed ranks -- R's dpermdist2(). z holds the
   scaled ranks of all m + n observations, sorted ascending; the density of
   sum(z[first m]) is built row by row. Streitberg and Roehmel's optimisation
   caps the column index at the largest reachable rank sum, sum_b.

   R returns that density indexed by the rank sum; wilcox_test() reports U, so
   `base` carries the -m(m+1)/2 shift and callers can go on asking about U. */
static void wdist_ranksum_perm(pTHX_ WilcoxDist *restrict D,
                               const UV *restrict z, size_t total_n, size_t m,
                               unsigned short int scale) {
	size_t sum_b = 0;
	for (size_t i = total_n - m; i < total_n; i++) {
		if (z[i] > WILCOX_MAX_CELLS - sum_b) wilcox_too_big(aTHX);
		sum_b += (size_t)z[i];
	}
	size_t sum_bp1 = sum_b + 1;
	size_t cells = wilcox_cells(aTHX_ m + 1, sum_bp1);
	/* No restrict on H or on the row pointers below: `row` and `prev` are two
	   rows of this one allocation, so they are pointers into the same object
	   even though the rows they address never coincide. */
	NV *H;
	Newxz(H, cells, NV);
	H[0] = 1.0;
	size_t s_a = 0, s_b = 0;
	for (size_t k = 0; k < total_n; k++) {
		size_t zk = (size_t)z[k];
		s_a += 1;                       /* the first sample's scores are all 1 */
		s_b += zk;
		size_t min_b = (s_b < sum_b) ? s_b : sum_b;
		size_t top_a = (s_a < m) ? s_a : m;
		if (zk > min_b) continue;
		for (size_t i = top_a; i >= 1; i--) {
			NV *row        = H + i * sum_bp1;
			const NV *prev = H + (i - 1) * sum_bp1;
			for (size_t j = min_b + 1; j-- > zk; )
				row[j] += prev[j - zk];
		}
	}
	/* Row m, columns 1..sum_b: the reachable rank sums. Column 0 is
	   unreachable (every rank is at least 1) and R drops it too. */
	const NV *row_m = H + m * sum_bp1;
	size_t lo = 0, hi = sum_b;                 /* half-open over columns 1..sum_b */
	while (lo < hi && row_m[lo + 1] == 0.0) lo++;
	while (hi > lo && row_m[hi] == 0.0) hi--;
	D->len   = hi - lo;
	D->scale = scale;
	D->symmetric = FALSE;
	/* Column j of row m counts the rank sum j; wilcox_test() reports
	   U = rank sum - m(m+1)/2, so the shift rides in `base`. */
	D->base  = (IV)(lo + 1) - (IV)(scale * m * (m + 1) / 2);
	Newx(D->d, D->len ? D->len : 1, NV);
	for (size_t j = 0; j < D->len; j++) D->d[j] = row_m[lo + 1 + j];
	Safefree(H);
	wdist_finish(aTHX_ D);
}

/* R's signif(x, digits): round to `digits` significant decimal digits.
   Ported from R's fprec() so that digits_rank decides ties exactly as R
   does. rint(), not round(), because R rounds halves to even here. */
static NV nv_signif(NV x, NV digits) {
	if (!nv_isfinite(x) || x == 0.0) return x;
	/* Also catches NaN and +Inf digits: more significant digits than the
	   build carries cannot change the value. */
	if (!(digits <= (NV)NV_DIG)) return x;
	NV sgn = 1.0;
	if (x < 0.0) { sgn = -1.0; x = -x; }
	IV dig = (IV)nv_floor(digits + 0.5);
	if (dig < 1) dig = 1;
	const IV max10e = (IV)NV_MAX_10_EXP;
	NV l10 = nv_log10(x);
	if (nv_fabs(l10) >= (NV)(max10e - 2)) return sgn * x;
	IV e10 = dig - 1 - (IV)nv_floor(l10);
	NV p10 = 1.0;
	if (e10 > max10e) { p10 = nv_pow(10.0, (NV)(e10 - max10e)); e10 = max10e; }
	if (e10 > 0) {
		NV pow10 = nv_pow(10.0, (NV)e10);
		return sgn * (nv_rint((x * pow10) * p10) / pow10) / p10;
	}
	NV pow10 = nv_pow(10.0, (NV)(-e10));
	return sgn * (nv_rint(x / pow10) * pow10);
}

/* Median of an already-sorted array. */
static NV nv_sorted_median(const NV *a, size_t n) {
	if (n == 0) return NV_NAN;
	if (n % 2) return a[(n - 1) / 2];
	return (a[n / 2 - 1] + a[n / 2]) / 2.0;
}

/* ri is ranked in place and every caller reads the ranks back out of the same
   allocation afterwards, so the pointer is not restrict-qualified.
   kruskal_test() used to be one of those callers and is not any more: it wants
   per-group rank sums rather than the ranks themselves, so it fuses the tie
   scan with the aggregation over KWObs and never stores a rank.  See KWObs. */
static NV rank_and_count_ties(RankInfo *ri, size_t n, bool *restrict has_ties) {
	if (n == 0) return 0.0;
	qsort(ri, n, sizeof(RankInfo), cmp_nv3);
	size_t i = 0;
	NV tie_adj = 0.0;
	*has_ties = FALSE;
	while (i < n) {
		size_t j = i + 1;
		while (j < n && ri[j].val == ri[i].val) j++;
		NV r = (NV)(i + 1 + j) / 2.0;
		for (size_t k = i; k < j; k++) ri[k].rank = r;
		size_t t = j - i;
		if (t > 1) { *has_ties = TRUE; tie_adj += ((NV)t * t * t - t); }
		i = j;
	}
	return tie_adj;
}

/* WILCOXON ASYMPTOTIC TAIL AND INTERVAL */

/* The Edgeworth series R 4.6.0 added under its integer `correct` argument:
   pnorm(z) refined by up to three correction terms, `k` of them. Signed rank:
   Fellingham and Stoker (1964), doi:10.1080/01621459.1964.10480738. Rank sum:
   Fix and Hodges (1955), doi:10.1214/aoms/1177728547, in the form Fellingham
   and Stoker give. Both series assume untied ranks, which is why the caller
   drops back to k = 0 the moment any appear.

   Transcribed from the released R 4.6.1, whose coefficients differ from the
   draft in the R-devel sources: released R scales the whole correction by the
   normal density and clamps the result into [0, 1]. */
static NV wilcox_edge_finish(NV y, NV e, NV z, bool lower) {
	/* 0.3989... = 1/sqrt(2*pi), so the factor is dnorm(z). */
	NV p = y + (lower ? -e : e) * (0.39894228040143267794 * nv_exp(-0.5 * z * z));
	if (!(p < 1.0)) p = 1.0;
	if (!(p > 0.0)) p = 0.0;
	return p;
}

static NV wilcox_edge_one(NV z, NV n, unsigned short int k, bool lower) {
	NV y = lower ? approx_pnorm(z) : approx_pnorm(-z);
	if (k < 1) return y;
	NV nn2n = n * (n + 1.0) * (2.0 * n + 1.0);
	NV la4 = -(3.0 * n * n + 3.0 * n - 1.0) / (10.0 * nn2n);
	NV z2 = z * z;
	NV e = la4 * z * (z2 - 3.0);                              /* lambda4/4! H3 */
	if (k > 1) {
		NV la6 = 4.0 * (((3.0 * n + 6.0) * n * n - 3.0) * n + 1.0)
		       / (35.0 * nn2n * nn2n);
		e += la6 * z * ((z2 - 10.0) * z2 + 15.0);             /* lambda6/6! H5 */
	}
	if (k > 2)
		e += la4 * la4 / 2.0 * z                              /* 35 lambda4^2/8! H7 */
		     * (((z2 - 21.0) * z2 + 105.0) * z2 - 105.0);
	return wilcox_edge_finish(y, e, z, lower);
}

static NV wilcox_edge_two(NV z, NV m, NV n, unsigned short int k, bool lower) {
	NV y = lower ? approx_pnorm(z) : approx_pnorm(-z);
	if (k < 1) return y;
	NV mn = m * n, m2 = m * m, n2 = n * n, mpn = m + n, mpn1 = mpn + 1.0;
	NV c3 = -(mpn1 * mpn - mn) / (20.0 * mn * mpn1);
	NV z2 = z * z;
	NV e = c3 * z * (z2 - 3.0);
	if (k > 1) {
		NV n5 = 2.0 * (m2 * m2 + n2 * n2) + 4.0 * mn * (m2 + n2) + 6.0 * m2 * n2
		      + 4.0 * (m2 * m + n2 * n) + (7.0 * mn + mpn - 1.0) * mpn;
		NV c5 = n5 / (210.0 * m2 * n2 * mpn1 * mpn1);
		e += c5 * z * ((z2 - 10.0) * z2 + 15.0);
	}
	if (k > 2)
		e += 0.5 * c3 * c3 * z * (((z2 - 21.0) * z2 + 105.0) * z2 - 105.0);
	return wilcox_edge_finish(y, e, z, lower);
}

/* Everything wilcox_ci_W() needs to re-evaluate the standardised statistic at
   a trial location shift, which is what the asymptotic interval roots on. */
typedef struct {
	const NV *x;
	const NV *y;      /* NULL in the one-sample case */
	RankInfo *scratch;         /* n_x + n_y entries, reranked on every call */
	size_t n_x, n_y;
	NV digits_rank;
	NV zq;                     /* the quantile the root is sought against */
	short int alt;             /* 0 = two.sided, 1 = less, 2 = greater */
	bool correct;
	bool tied;                 /* set once the variance came out zero */
} WilcoxCiCtx;

/* R's W(): the standardised (and optionally continuity-corrected) Wilcoxon
   statistic of the data shifted by d.  Monotone decreasing in d, which is
   what makes rooting it against a normal quantile give a confidence limit. */
static NV wilcox_ci_W(NV d, void *ctx) {
	dTHX;
	/*restrict, and on the local rather than on the struct's own members, which
	is where gcc and clang can act on it: the scans below store into
	C->scratch[] on every element, and without it C->x, C->n_x and
	C->digits_rank have to be re-read from the context each time round.*/
	WilcoxCiCtx *restrict C = (WilcoxCiCtx *)ctx;
	bool finite_digits = nv_isfinite(C->digits_rank);
	NV zd, sigma;
	bool has_ties = FALSE;
	if (C->y) {                                     /* two-sample */
		size_t total_n = C->n_x + C->n_y;
		for (size_t i = 0; i < C->n_x; i++) {
			NV v = C->x[i] - d;
			C->scratch[i].val = finite_digits ? nv_signif(v, C->digits_rank) : v;
			C->scratch[i].idx = 1;
		}
		for (size_t i = 0; i < C->n_y; i++) {
			NV v = C->y[i];
			C->scratch[C->n_x + i].val = finite_digits ? nv_signif(v, C->digits_rank) : v;
			C->scratch[C->n_x + i].idx = 2;
		}
		NV tie_adj = rank_and_count_ties(C->scratch, total_n, &has_ties);
		NV rank_sum = 0.0;
		for (size_t i = 0; i < total_n; i++)
			if (C->scratch[i].idx == 1) rank_sum += C->scratch[i].rank;
		zd = rank_sum - (NV)C->n_x * (C->n_x + 1.0) / 2.0
		     - (NV)C->n_x * (NV)C->n_y / 2.0;
		sigma = nv_sqrt(((NV)C->n_x * (NV)C->n_y / 12.0)
		                * ((NV)total_n + 1.0
		                   - tie_adj / ((NV)total_n * ((NV)total_n - 1.0))));
	} else {                                        /* one-sample / paired */
		size_t nz = 0;
		for (size_t i = 0; i < C->n_x; i++) {
			NV v = C->x[i] - d;
			if (v == 0.0) continue;                 /* R drops the zeroes here */
			C->scratch[nz].val = nv_fabs(finite_digits
			                             ? nv_signif(v, C->digits_rank) : v);
			C->scratch[nz].idx = (v > 0.0);
			nz++;
		}
		if (nz == 0) { C->tied = TRUE; return NV_NAN; }
		NV tie_adj = rank_and_count_ties(C->scratch, nz, &has_ties);
		NV v_stat = 0.0;
		for (size_t i = 0; i < nz; i++) if (C->scratch[i].idx) v_stat += C->scratch[i].rank;
		zd = v_stat - (NV)nz * (nz + 1.0) / 4.0;
		sigma = nv_sqrt((NV)nz * (nz + 1.0) * (2.0 * (NV)nz + 1.0) / 24.0
		                - tie_adj / 48.0);
	}
	if (!(sigma > 0.0)) { C->tied = TRUE; return NV_NAN; }
	NV corr = 0.0;
	if (C->correct)
		corr = (C->alt == 1) ? -0.5 : (C->alt == 2) ? 0.5
		     : (zd > 0.0) ? 0.5 : (zd < 0.0) ? -0.5 : 0.0;
	return (zd - corr) / sigma;
}

static NV wilcox_ci_root_fn(NV d, void *ctx) {
	return wilcox_ci_W(d, ctx) - ((WilcoxCiCtx *)ctx)->zq;
}

/* R's ptail() from the two exact confidence intervals: shift the data by
  `shift`, re-rank, and report the conditional tail probability of the
  statistic that results.  The permutation distribution depends on those
  ranks, so it has to be rebuilt at every candidate shift and is freed again
  before returning rather than piling up on the save stack.

  `D` must be a scratch distribution of the caller's own, never the one the
  p-value was taken from -- that one is owned by SAVEFREEPV.

  R applies no digits.rank rounding inside these scans, and neither do we.
  ri and z are caller-owned scratch, sized n (or n_x + n_y). */
static NV wilcox_one_ptail(pTHX_ WilcoxDist *D, RankInfo *restrict ri,
                           UV *restrict z,
                           const NV *restrict x, size_t n, NV shift, bool lower) {
	for (size_t i = 0; i < n; i++) {
		NV d = x[i] - shift;
		ri[i].val = nv_fabs(d);
		ri[i].idx = (d > 0.0) ? 1 : (d < 0.0) ? 2 : 0;   /* 0 = exact zero */
	}
	bool has_ties = FALSE;
	(void)rank_and_count_ties(ri, n, &has_ties);
	NV v = 0.0;
	unsigned short int scale = 1;
	for (size_t i = 0; i < n; i++) {
		if (ri[i].idx == 1) v += ri[i].rank;
		if (ri[i].rank != nv_floor(ri[i].rank)) scale = 2;
	}
/* Every rank goes in, including that of an observation the shift has driven to
  exactly zero: R's ptail() conditions on rank(abs(x - mu)) entire, where the
  p-value path drops the zeroes' ranks first.  The two agree at any shift that
  does not land on an observation, so the distinction only shows up on tied
  data -- which is the only data that reaches this scan. */
	for (size_t i = 0; i < n; i++) z[i] = (UV)nv_round((NV)scale * ri[i].rank);
	wdist_signrank_perm(aTHX_ D, z, n, scale);
	NV p = wdist_tail(D, v, lower);          /* R passes v to both tails here */
	wdist_free(D);
	return p;
}

static NV wilcox_two_ptail(pTHX_ WilcoxDist *D, RankInfo *restrict ri,
                           UV *restrict z,
                           const NV *restrict x, size_t n_x,
                           const NV *restrict y, size_t n_y,
                           NV shift, bool lower) {
	size_t total_n = n_x + n_y;
	for (size_t i = 0; i < n_x; i++) { ri[i].val = x[i] - shift; ri[i].idx = 1; }
	for (size_t i = 0; i < n_y; i++) { ri[n_x + i].val = y[i];   ri[n_x + i].idx = 2; }
	bool has_ties = FALSE;
	(void)rank_and_count_ties(ri, total_n, &has_ties);
	NV rank_sum = 0.0;
	unsigned short int scale = 1;
	for (size_t i = 0; i < total_n; i++) {
		if (ri[i].idx == 1) rank_sum += ri[i].rank;
		if (ri[i].rank != nv_floor(ri[i].rank)) scale = 2;
	}
	NV w = rank_sum - (NV)n_x * (n_x + 1.0) / 2.0;
	for (size_t i = 0; i < total_n; i++) z[i] = (UV)nv_round((NV)scale * ri[i].rank);
	wdist_ranksum_perm(aTHX_ D, z, total_n, n_x, scale);
	NV p = wdist_tail(D, lower ? w : w - 0.25, lower);
	wdist_free(D);
	return p;
}

/* R's root(): uniroot() over [lo, hi], but returning the endpoint outright
   when the bracket does not actually straddle zero.  R's two-sample interval
   does this explicitly for cases like wilcox.test(1, 2:60, conf.int = TRUE). */
static NV wilcox_ci_root(WilcoxCiCtx *C, NV lo, NV hi, NV f_lo, NV f_hi,
                         NV zq, NV tol) {
	C->zq = zq;
	if (!(f_lo - zq > 0.0)) return lo;
	if (!(f_hi - zq < 0.0)) return hi;
	return ft_zeroin(lo, hi, wilcox_ci_root_fn, C, tol, 1000);
}
// KS-TEST C HELPER SECTION
#ifndef M_PI_2
#define M_PI_2 1.57079632679489661923
#endif
#ifndef M_PI_4
#define M_PI_4 0.78539816339744830962
#endif
#ifndef M_1_SQRT_2PI
#define M_1_SQRT_2PI 0.39894228040143267794
#endif

// Scalar integer power used by K2x
static NV r_pow_di(NV x, unsigned int n) {
	if (n == 0) return 1.0;
	NV val = 1.0;
	for (unsigned int i = 0; i < n; i++) val *= x;
	return val;
}

// Two-sample two-sided asymptotic distribution
static NV K2l(NV x, bool lower, NV tol) {
	NV s, z, p;
	int k;
	if(x <= 0.) {
	  if(lower) p = 0.;
	  else p = 1.;
	} else if(x < 1.) {
	  int k_max = (int) nv_sqrt(2.0 - nv_log(tol));
	  NV w = nv_log(x);
	  z = - (M_PI_2 * M_PI_4) / (x * x);
	  s = 0;
	  for(k = 1; k < k_max; k += 2) {
		   s += nv_exp(k * k * z - w);
	  }
	  p = s / M_1_SQRT_2PI;
	  if(!lower) p = 1.0 - p;
	} else {
	  NV new_val, old_val;
	  z = -2.0 * x * x;
	  s = -1.0;
	  if(lower) {
		   k = 1; old_val = 0.0; new_val = 1.0;
	  } else {
		   k = 2; old_val = 0.0; new_val = 2.0 * nv_exp(z);
	  }
	  while(nv_fabs(old_val - new_val) > tol) {
		   old_val = new_val;
		   new_val += 2.0 * s * nv_exp(z * k * k);
		   s *= -1.0;
		   k++;
	  }
	  p = new_val;
	}
	return p;
}

// Auxiliary routines used by K2x() for matrix operations
static void m_multiply(NV *A, NV *B, NV *C, unsigned int m) {
	for(unsigned int i = 0; i < m; i++) {
	  for(unsigned int j = 0; j < m; j++) {
		   NV s = 0.;
		   for(unsigned int k = 0; k < m; k++) s += A[i * m + k] * B[k * m + j];
		   C[i * m + j] = s;
	  }
	}
}

static void m_power(NV *A, int eA, NV *V, int *eV, int m, int n) {
	if(n == 1) {
	  for(int i = 0; i < m * m; i++) V[i] = A[i];
	  *eV = eA;
	  return;
	}
	m_power(A, eA, V, eV, m, n / 2);
	NV *B = (NV*) safecalloc(m * m, sizeof(NV));
	m_multiply(V, V, B, m);
	int eB = 2 * (*eV);
	if((n % 2) == 0) {
	  for(int i = 0; i < m * m; i++) V[i] = B[i];
	  *eV = eB;
	} else {
	  m_multiply(A, B, V, m);
	  *eV = eA + eB;
	}
	if(V[(m / 2) * m + (m / 2)] > 1e140) {
	  for(int i = 0; i < m * m; i++) V[i] = V[i] * 1e-140;
	  *eV += 140;
	}
	Safefree(B);
}

// One-sample two-sided exact distribution
static NV K2x(int n, NV d) {
	int k = (int) (n * d) + 1;
	int m = 2 * k - 1;
	NV h = k - n * d;
	NV *H = (NV*) safecalloc(m * m, sizeof(NV));
	NV *Q = (NV*) safecalloc(m * m, sizeof(NV));

	for(int i = 0; i < m; i++) {
	  for(int j = 0; j < m; j++) {
		   if(i - j + 1 < 0) H[i * m + j] = 0;
		   else H[i * m + j] = 1;
	  }
	}
	for(int i = 0; i < m; i++) {
	  H[i * m] -= r_pow_di(h, i + 1);
	  H[(m - 1) * m + i] -= r_pow_di(h, (m - i));
	}
	H[(m - 1) * m] += ((2 * h - 1 > 0) ? r_pow_di(2 * h - 1, m) : 0);

	for(int i = 0; i < m; i++) {
	  for(int j = 0; j < m; j++) {
		   if(i - j + 1 > 0) {
			   for(int g = 1; g <= i - j + 1; g++) H[i * m + j] /= g;
		   }
	  }
	}

	int eH = 0, eQ;
	m_power(H, eH, Q, &eQ, m, n);
	NV s = Q[(k - 1) * m + k - 1];

	for(int i = 1; i <= n; i++) {
	  s = s * (NV)i / (NV)n;
	  if(s < 1e-140) {
		   s *= 1e140;
		   eQ -= 140;
	  }
	}
	s *= nv_pow(10.0, eQ);
	Safefree(H);	Safefree(Q);
	return s;
}
/*One comparator, used by every qsort below. Branch form avoids overflow that
a subtraction-based comparator would hit, and is correct for any NV width.*/

/*Largest m*n for which we will run the exact DP even when exact=>1 is forced.
Time is O(m*n); memory is O(min(m,n)). Beyond this we warn and go asymptotic.*/
#define KS_EXACT_MAX_PRODUCT 10000000.0
static void calc_2sample_stats(NV *x, size_t nx, NV *y, size_t ny,
                               NV *d, NV *d_plus, NV *d_minus) {
	qsort(x, nx, sizeof(NV), cmp_nv3);
	qsort(y, ny, sizeof(NV), cmp_nv3);
	NV max_d = 0.0, max_d_plus = 0.0, max_d_minus = 0.0;
	size_t i = 0, j = 0;
	while (i < nx || j < ny) {
		NV val;
		if (i < nx && j < ny) val = (x[i] < y[j]) ? x[i] : y[j];
		else if (i < nx)      val = x[i];
		else                  val = y[j];
		while (i < nx && x[i] <= val) i++;
		while (j < ny && y[j] <= val) j++;
		NV cdf1 = (NV)i / nx;
		NV cdf2 = (NV)j / ny;
		NV diff = cdf1 - cdf2;
		if (diff > max_d_plus)  max_d_plus  = diff;
		if (-diff > max_d_minus) max_d_minus = -diff;
		if (nv_fabs(diff) > max_d)  max_d = nv_fabs(diff);
	}
	*d = max_d; *d_plus = max_d_plus; *d_minus = max_d_minus;
}

static bool psmirnov_exact_test(NV q, NV r, NV s, bool two_sided) {
    if (two_sided) return (nv_fabs(r - s) >= q);
    return ((r - s) >= q);
}

// Evaluate the exact 2-sample probability
static NV psmirnov_exact_uniq_upper(NV q, size_t m, size_t n, bool two_sided) {
	NV md = (NV) m, nd = (NV) n;
	NV *u = (NV *) safemalloc((n + 1) * sizeof(NV)); // malloc + full init below
	u[0] = 0.;
	for (size_t j = 1; j <= n; j++)
	  u[j] = psmirnov_exact_test(q, 0., j / nd, two_sided) ? 1. : u[j - 1];
	for (size_t i = 1; i <= m; i++) {
	  if (psmirnov_exact_test(q, i / md, 0., two_sided)) u[0] = 1.;
	  for (size_t j = 1; j <= n; j++) {
		   if (psmirnov_exact_test(q, i / md, j / nd, two_sided)) u[j] = 1.;
		   else {
		       NV v = (NV)(i) / (NV)(i + j);
		       NV w = (NV)(j) / (NV)(i + j);
		       u[j] = v * u[j] + w * u[j - 1];
		   }
	  }
	}
	NV res = u[n];
	Safefree(u);
	return res;
}

static NV p_body(NV n, NV delta, NV sd, NV sig_level, int tsample, int tside, bool strict) {
	/*R floors n - 1 and only then scales by tsample: pmax(1e-07, n - 1) *
	tsample. Flooring the product instead left the two-sample case with half
	of R's nu whenever the floor bit. power_t_test() refuses n < 2 outright,
	so this is only a backstop now, but it should be R's backstop.*/
	NV nu = ((n - 1.0) > 1e-7 ? (n - 1.0) : 1e-7) * (NV)tsample;

	// Ensure sig_level/tside is not truncated
	NV p_tail = sig_level / (NV)tside;
	NV qu = qt_tail(nu, p_tail); // qt(p, df, lower.tail=FALSE)

	NV ncp = nv_sqrt(n / (NV)tsample) * (delta / sd);

	/*R writes these as 1 - pt(qu, ...) and pt(-qu, ...); taking the upper tail
	straight from exact_pnt() is the same quantity without the subtraction.*/
	if (strict && tside == 2) {
	  return exact_pnt(qu, nu, ncp, TRUE) + exact_pnt(-qu, nu, ncp, FALSE);
	} else {
	  return exact_pnt(qu, nu, ncp, TRUE);
	}
}

/*power_t_test's inverse solvers

Each of n, delta, sd and sig_level is recovered by driving p_body() to the
requested power. The four searches differ only in which argument is free, so
they share one context and one root finder.*/
enum { PTT_N = 0, PTT_DELTA, PTT_SD, PTT_SIG };

typedef struct {
	NV n, delta, sd, sig_level, target;
	int tsample, tside, which;
	bool strict;
} ptt_ctx;

/*p_body() with c->which held free, less the requested power: the function the
solver drives to zero.*/
static NV ptt_f(const ptt_ctx *c, NV x) {
	switch (c->which) {
	  case PTT_N:     return p_body(x, c->delta, c->sd, c->sig_level, c->tsample, c->tside, c->strict) - c->target;
	  case PTT_DELTA: return p_body(c->n, x, c->sd, c->sig_level, c->tsample, c->tside, c->strict) - c->target;
	  case PTT_SD:    return p_body(c->n, c->delta, x, c->sig_level, c->tsample, c->tside, c->strict) - c->target;
	  default:        return p_body(c->n, c->delta, c->sd, x, c->tsample, c->tside, c->strict) - c->target;
	}
}

/*Regula falsi with the Illinois correction. It stays bracketed the way the
plain bisection this replaces did, but converges superlinearly, so it reaches
a far tighter answer in fewer evaluations of p_body() -- around a dozen
against bisection's three dozen.

`tol` is a *relative* tolerance on the step between successive iterates, not
on the width of the bracket. Illinois shrinks one side of the bracket much
faster than the other, so a bracket-width test declares victory while the
iterate is still poor; and R's uniroot() bracket-width default of
.Machine$double.eps^0.25 is why R's own delta and sig.level come back with
only four or five good digits.

Returns NaN when [lo, hi] holds no sign change. Callers croak on that instead
of handing back a bracket endpoint dressed up as an answer, which is how
solving for sd used to report a standard deviation of delta * 1e7.*/
static NV ptt_root(const ptt_ctx *c, NV lo, NV hi, NV tol) {
	if (!(lo < hi)) return NAN;
	NV flo = ptt_f(c, lo), fhi = ptt_f(c, hi);
	if (flo == 0.0) return lo;
	if (fhi == 0.0) return hi;
	if (flo != flo || fhi != fhi) return NAN;
	if ((flo > 0.0) == (fhi > 0.0)) return NAN;
	NV x = 0.5 * (lo + hi), prev = INFINITY;
	/*Which endpoint the previous step replaced: -1 for lo, +1 for hi, 0 for
	neither yet. The Illinois halving below is applied only when the same
	endpoint is replaced twice running, i.e. when the far side really has gone
	stale. Halving it on every step -- the way the correction is usually
	written -- discounts a value that was fresh one iteration ago, and once
	the iterates start straddling the root (which they do here from about the
	fifteenth step) both stored values end up scaled down together and the
	secant degenerates to bisection: |f| then halves exactly, step after step.
	Waiting for the second retention holds the p_body() count near two dozen,
	against roughly fifty for the unconditional halving and sixty for plain
	bisection, and matches what Brent's method needs on the same brackets.*/
	int side = 0;
	for (unsigned short int i = 0; i < 200; i++) {
		x = hi - fhi * (hi - lo) / (fhi - flo);
		/*an interpolation that lands on or outside the bracket (which the
		halved stale value can produce) falls back to the midpoint*/
		if (!(x > lo && x < hi)) x = 0.5 * (lo + hi);
		NV fx = ptt_f(c, x);
		/*x == prev is the machine-precision floor: the step has stopped
		changing the iterate at all, so no tol can ask for more.*/
		if (fx == 0.0 || x == prev || nv_fabs(x - prev) <= tol * nv_fabs(x)) return x;
		prev = x;
		if ((fx > 0.0) == (flo > 0.0)) {
			lo = x; flo = fx;
			if (side == -1) fhi *= 0.5;
			side = -1;
		} else {
			hi = x; fhi = fx;
			if (side == 1) flo *= 0.5;
			side = 1;
		}
	}
	return x;
}

/* Bisection algorithm to find the inverse F-distribution (Quantile function)
 Equivalent to R's qf(p, df1, df2)*/
static NV qf_bisection(NV p, NV df1, NV df2) {
	if (p <= 0.0) return 0.0;
	if (p >= 1.0) return INFINITY;
	NV low = 0.0, high = 1.0;
	// Find upper bound
	while (pf(high, df1, df2) < p) {
	  low = high;
	  high *= 2.0;
	  if (high > 1e100) break; //Fallback limit
	}

	// Bisect to find the root
	for (unsigned short int i = 0; i < 150; i++) {
		NV mid = low + (high - low) / 2.0;
		NV p_mid = pf(mid, df1, df2);

		if (p_mid < p) {
			low = mid;
		} else {
			high = mid;
		}
		if (high - low < 1e-12) break;
	}
	return (low + high) / 2.0;
}

typedef struct {
	NV  statistic;
	NV  num_df;
	NV  denom_df;
	NV  p_value;
	NV  ss_between;  //between-group sum of squares
	NV  ss_within;   //within-group  sum of squares
	NV  ms_between;  //ss_between / num_df
	NV  ms_within;   //ss_within  / denom_df
	int     k;           //number of groups
	IV      n;           //total observations
	bool     var_equal;   //0 = Welch, 1 = classic
} OneWayResult;

static OneWayResult
c_oneway_test(const NV *restrict data, const size_t *restrict sizes,
			  size_t k, bool var_equal)
{
	OneWayResult res;
	res.var_equal = var_equal;
	res.k         = (int)k;

	NV *restrict n_i = (NV *)safemalloc(k * sizeof(NV));
	NV *restrict m_i = (NV *)safemalloc(k * sizeof(NV));
	NV *restrict v_i = (NV *)safemalloc(k * sizeof(NV));
	size_t offset = 0;
	IV total_n = 0;
	for (size_t g = 0; g < k; g++) {
	  size_t ng  = sizes[g];
	  n_i[g]     = (NV)ng;
	  total_n   += (IV)ng;
	  NV sum = 0.0;
	  for (size_t i = 0; i < ng; i++) sum += data[offset + i];
	  NV mean = sum / (NV)ng;
	  m_i[g] = mean;

	  NV ss = 0.0;
	  for (size_t i = 0; i < ng; i++) {
		   NV d = data[offset + i] - mean;
		   ss += d * d;
	  }
	  v_i[g] = ss / (NV)(ng - 1);   //ng >= 2 guaranteed by caller
	  offset += ng;
	}
	res.n = total_n;
	// grand mean (simple average over all obs; used only by classic branch)/
	NV grand_mean = 0.0;
	for (IV i = 0; i < (IV)total_n; i++) grand_mean += data[i];
	grand_mean /= (NV)total_n;

	NV df1 = (NV)(k - 1);

	if (var_equal) {//── Classic one-way ANOVA
	//F = [Σ n_i·(m_i − ȳ)² / (k−1)]  /  [Σ (n_i−1)·v_i / (n−k)]
		NV ssbg = 0.0, sswg = 0.0;
		for (size_t g = 0; g < k; g++) {
			NV dm = m_i[g] - grand_mean;
			ssbg += n_i[g] * dm * dm;
			sswg += (n_i[g] - 1.0) * v_i[g];
		}
		NV df2    = (NV)(total_n - (IV)k);
		res.statistic = (ssbg / df1) / (sswg / df2);
		res.num_df    = df1;
		res.denom_df  = df2;
		res.ss_between = ssbg;
		res.ss_within  = sswg;
		res.ms_between = ssbg / df1;
		res.ms_within  = sswg / df2;
	} else {// ── Welch one-way (heteroscedastic)
		NV *restrict w_i = (NV *)safemalloc(k * sizeof(NV));
		NV sum_w = 0.0;
		for (size_t g = 0; g < k; g++) { w_i[g] = n_i[g] / v_i[g]; sum_w += w_i[g]; }
		NV wgrand = 0.0;
		for (size_t g = 0; g < k; g++) wgrand += w_i[g] * m_i[g];
		wgrand /= sum_w;
		NV tmp = 0.0;
		for (size_t g = 0; g < k; g++) {
			NV t = 1.0 - w_i[g] / sum_w;
			tmp += (t * t) / (n_i[g] - 1.0);
		}
		tmp /= ((NV)k * (NV)k - 1.0);   //k² − 1
		NV num = 0.0;
		for (size_t g = 0; g < k; g++) {
			NV dm = m_i[g] - wgrand;
			num += w_i[g] * dm * dm;
		}
		res.statistic = num / (df1 * (1.0 + 2.0 * (NV)(k - 2) * tmp));
		res.num_df    = df1;
		/*Left unguarded on purpose: a zero-variance group makes w_i infinite,
		hence tmp NaN, and R's oneway.test reports NaN df here too. A magic
		1e300 sentinel instead looked like a real (huge) df.*/
		res.denom_df  = 1.0 / (3.0 * tmp);
		//unweighted SS for the output table
		NV ssbg = 0.0, sswg = 0.0;
		for (size_t g = 0; g < k; g++) {
			NV dm = m_i[g] - grand_mean;
			ssbg += n_i[g] * dm * dm;
			sswg += (n_i[g] - 1.0) * v_i[g];
		}
		res.ss_between = ssbg;
		res.ss_within  = sswg;
		res.ms_between = ssbg / df1;                 //df1 = k-1 >= 1
		res.ms_within  = sswg / res.denom_df;        //NaN if denom_df is NaN
		Safefree(w_i);
	}
	// upper-tail p-value  P(F ≥ statistic), evaluated in the tail itself
	res.p_value = pf_upper(res.statistic, res.num_df, res.denom_df);
	Safefree(n_i);    Safefree(m_i);    Safefree(v_i);
	return res;
}

/*── parse_formula

Splits "response ~ factor" into two NUL-terminated, heap-allocated
strings.  Leading/trailing whitespace is stripped from each side.
Returns 1 on success, 0 on failure (malformed / missing '~').
Caller must Safefree() both *lhs and *rhs on success.*/
static int
parse_formula(const char *formula, char **lhs, char **rhs)
{
	const char *tilde = strchr(formula, '~');
	if (!tilde) return 0;

	// left-hand side: trim trailing whitespace
	const char *l_start = formula;
	const char *l_end   = tilde - 1;
	while (l_end >= l_start && isspace((unsigned char)*l_end)) l_end--;
	if (l_end < l_start) return 0; //empty LHS

	// right-hand side: trim leading whitespace */
	const char *r_start = tilde + 1;
	while (*r_start && isspace((unsigned char)*r_start)) r_start++;
	const char *r_end = r_start + strlen(r_start) - 1;
	while (r_end >= r_start && isspace((unsigned char)*r_end)) r_end--;
	if (r_end < r_start) return 0; //empty RHS

	size_t llen = (size_t)(l_end - l_start + 1);
	size_t rlen = (size_t)(r_end - r_start + 1);

	*lhs = (char *)safemalloc(llen + 1);
	*rhs = (char *)safemalloc(rlen + 1);
	memcpy(*lhs, l_start, llen); (*lhs)[llen] = '\0';
	memcpy(*rhs, r_start, rlen); (*rhs)[rlen] = '\0';
	return 1;
}

/*── build_groups_from_formula ───────────────

Takes parallel response[] and label[] arrays (each length n) and
partitions them into groups, filling:
  out_flat[]  – observations sorted into contiguous group blocks
  out_sizes[] – number of observations per group  (caller allocates n
                slots for both; actual group count returned via *out_k)
  out_names   – if non-NULL, receives a heap-allocated char** of k
                group-name strings (caller must free each and the array)

Group identity is the string representation of each label element
(SvPV_nolen), so integer 0 and string "0" are the same group.
Groups are ordered by first appearance in label[], matching R's
factor level ordering from stack().

Returns 1 on success; 0 if any validation error (sets errbuf).*/
#define OWT_MAX_GROUPS 1024   //sane ceiling; ANOVA with >1024 groups is absurd

static int build_groups_from_formula(pTHX_
	AV *response_av,
	AV *label_av,
	NV *out_flat,
	size_t *out_sizes,
	size_t *out_k,
	char ***out_names,
	char *errbuf,
	size_t errbuf_len)
{
	IV n = av_len(response_av) + 1;
	IV nl = av_len(label_av)   + 1;

	if (n != nl) {
	  snprintf(errbuf, errbuf_len,
		   "formula: response length (%"IVdf") != factor length (%"IVdf")",
		   n, nl);
	  return 0;
	}
	if (n < 2) {
	  snprintf(errbuf, errbuf_len, "formula: need at least 2 observations");
	  return 0;
	}

	//── discover unique group labels in order of first appearance ───

	//We store pointers into a heap-allocated label string table.
	char  **group_names  = (char **)safemalloc(OWT_MAX_GROUPS * sizeof(char *));
	size_t  ngroups      = 0;
	IV     *obs_group    = (IV *)safemalloc((size_t)n * sizeof(IV));
		//maps obs index → group index

	for (IV i = 0; i < n; i++) {
	  SV **lsv = av_fetch(label_av, i, 0);
	  const char *label = (lsv && *lsv) ? SvPV_nolen(*lsv) : "";
	  //linear scan for existing group (k is small, O(n·k) is fine)
	  IV gidx = -1;
	  for (size_t g = 0; g < ngroups; g++) {
		   if (strEQ(group_names[g], label)) { gidx = (IV)g; break; }
	  }
	  if (gidx < 0) {
		   if (ngroups >= OWT_MAX_GROUPS) {
			   snprintf(errbuf, errbuf_len,
				   "formula: too many distinct groups (max %d)", OWT_MAX_GROUPS);
			   Safefree(group_names);
			   Safefree(obs_group);
			   return 0;
		   }
		   //new group: copy the label string
		   size_t lablen = strlen(label);
		   group_names[ngroups] = (char *)safemalloc(lablen + 1);
		   memcpy(group_names[ngroups], label, lablen + 1);
		   gidx = (IV)ngroups++;
	  }
	  obs_group[i] = gidx;
	}

	if (ngroups < 2) {
	  snprintf(errbuf, errbuf_len,
		   "formula: need at least 2 distinct groups, found %zu", ngroups);
	  for (size_t g = 0; g < ngroups; g++) Safefree(group_names[g]);
	  Safefree(group_names);  Safefree(obs_group);
	  return 0;
	}
	//count per-group sizes
	memset(out_sizes, 0, ngroups * sizeof(size_t));
	for (IV i = 0; i < n; i++) out_sizes[obs_group[i]]++;
	//validate: every group needs >= 2 observations
	for (size_t g = 0; g < ngroups; g++) {
		if (out_sizes[g] < 2) {
			snprintf(errbuf, errbuf_len,
				 "formula: group '%s' has only %zu observation(s); need >= 2",
				 group_names[g], out_sizes[g]);
			for (size_t gg = 0; gg < ngroups; gg++) Safefree(group_names[gg]);
			Safefree(group_names);  Safefree(obs_group);
			return 0;
		}
	}
	/*── fill flat output array in group order *
	We compute a running write-offset per group, then scatter*/
	size_t *write_pos = (size_t *)safemalloc(ngroups * sizeof(size_t));
	write_pos[0] = 0;
	for (size_t g = 1; g < ngroups; g++)
	  write_pos[g] = write_pos[g - 1] + out_sizes[g - 1];
	for (IV i = 0; i < n; i++) {
	  SV **rsv = av_fetch(response_av, i, 0);
	  /*Same contract as the hash / array-of-arrays modes: an undef or
	  non-numeric response cell dies rather than being silently read as 0.0*/
	  if (!rsv || !*rsv || !SvOK(*rsv) || !looks_like_number(*rsv)) {
		   snprintf(errbuf, errbuf_len,
			   "formula: response observation %" IVdf " (group '%s') is undefined or non-numeric",
			   i, group_names[obs_group[i]]);
		   for (size_t g = 0; g < ngroups; g++) Safefree(group_names[g]);
		   Safefree(group_names);  Safefree(obs_group);  Safefree(write_pos);
		   return 0;
	  }
	  size_t g   = (size_t)obs_group[i];
	  out_flat[write_pos[g]++] = SvNV(*rsv);
	}
	*out_k = ngroups;
	//── clean up or hand off group names
	Safefree(write_pos);	Safefree(obs_group);
	if (out_names) {
	  *out_names = group_names;   //caller takes ownership
	} else {
	  for (size_t g = 0; g < ngroups; g++) Safefree(group_names[g]);
	  Safefree(group_names);
	}
	return 1;
}
#undef OWT_MAX_GROUPS
// Math Macros
#ifndef M_LN_SQRT_2PI
#define M_LN_SQRT_2PI 0.91893853320467274178
#endif
#ifndef M_LN2
#define M_LN2 0.69314718055994530941
#endif
#ifndef M_1_SQRT_2PI
#define M_1_SQRT_2PI 0.39894228040143267794
#endif

/*c_dnorm: Normal distribution PDF

Mathematically identical to R's dnorm4.
Includes Morten Welinder's precision improvements for extreme tails.*/
static NV c_dnorm(NV x, NV mu, NV sigma, bool give_log) {
	// Propagate NaNs
	if (nv_isnan(x) || nv_isnan(mu) || nv_isnan(sigma)) return x + mu + sigma; 
	if (sigma < 0.0) {
	  warn("dnorm: standard deviation must be non-negative");
	  return NAN;
	}
	if (nv_isinf(sigma)) return 0.0;
	if ((nv_isnan(x) || nv_isinf(x)) && mu == x) return NAN; // x-mu is NaN
	// Dirac delta behavior for zero variance
	if (sigma == 0.0) return (x == mu) ? INFINITY : 0.0;

	// Standardize x
	x = (x - mu) / sigma;
	if (nv_isnan(x) || nv_isinf(x)) return 0.0;
	x = nv_fabs(x);
	// Catch massive limits early to prevent math overflow
	if (x >= 2.0 * nv_sqrt(DBL_MAX)) return 0.0;
	if (give_log) {
		return -(M_LN_SQRT_2PI + 0.5 * x * x + nv_log(sigma));
	}
	// Naive formula for standard bodies
	if (x < 5.0) {
	  return M_1_SQRT_2PI * nv_exp(-0.5 * x * x) / sigma;
	}
	// Underflow boundary check using IEEE float characteristics
	if (x > nv_sqrt(-2.0 * M_LN2 * (DBL_MIN_EXP + 1.0 - DBL_MANT_DIG))) {
	  return 0.0;
	}
	/*Splitting x to dodge floating point inaccuracies in x^2 for large x.
	x = x1 + x2, where |x2| <= 2^-16
	trunc() safely substitutes R_forceint()*/
	NV x1 = nv_ldexp(nv_trunc(nv_ldexp(x, 16)), -16);
	NV x2 = x - x1;
	return (M_1_SQRT_2PI / sigma) * (nv_exp(-0.5 * x1 * x1) * nv_exp((-0.5 * x2 - x1) * x2));
}
/*Helper for prcomp: Jacobi Eigenvalue Algorithm for Symmetric Matrices
Used to compute the eigendecomposition of the X^T X covariance matrix.*/
static void jacobi_eigen(NV *restrict A, size_t n, NV *restrict d, NV *restrict v) {
	for (size_t i = 0; i < n; i++) {
	  for (size_t j = 0; j < n; j++) v[i * n + j] = (i == j) ? 1.0 : 0.0;
	  d[i] = A[i * n + i];
	}
	NV *restrict b = (NV*)safemalloc(n * sizeof(NV));
	NV *restrict z = (NV*)safemalloc(n * sizeof(NV));
	for (size_t i = 0; i < n; i++) { b[i] = d[i]; z[i] = 0.0; }
	for (int iter = 1; iter <= 50; iter++) {
		NV sm = 0.0;
		for (size_t i = 0; i < n - 1; i++) {
			for (size_t j = i + 1; j < n; j++) sm += nv_fabs(A[i * n + j]);
		}
		if (sm == 0.0) break;
		NV tresh = (iter < 4) ? 0.2 * sm / (n * n) : 0.0;
		for (size_t i = 0; i < n - 1; i++) {
			for (size_t j = i + 1; j < n; j++) {
				NV g = 100.0 * nv_fabs(A[i * n + j]);
				if (iter > 4 && nv_fabs(d[i]) + g == nv_fabs(d[i]) && nv_fabs(d[j]) + g == nv_fabs(d[j])) {
					A[i * n + j] = 0.0;
				} else if (nv_fabs(A[i * n + j]) > tresh) {
					NV h = d[j] - d[i];
					NV t;
					if (nv_fabs(h) + g == nv_fabs(h)) {
						t = A[i * n + j] / h;
					} else {
						NV theta = 0.5 * h / A[i * n + j];
						t = 1.0 / (nv_fabs(theta) + nv_sqrt(1.0 + theta * theta));
						if (theta < 0.0) t = -t;
					}
					NV c = 1.0 / nv_sqrt(1.0 + t * t);
					NV s = t * c;
					NV tau = s / (1.0 + c);
					NV h_t = t * A[i * n + j];
					z[i] -= h_t;
					z[j] += h_t;
					d[i] -= h_t;
					d[j] += h_t;
					A[i * n + j] = 0.0;
					for (size_t k = 0; k < i; k++) {
						g = A[k * n + i]; NV h_val = A[k * n + j];
						A[k * n + i] = g - s * (h_val + g * tau);
						A[k * n + j] = h_val + s * (g - h_val * tau);
					}
					for (size_t k = i + 1; k < j; k++) {
						g = A[i * n + k]; NV h_val = A[k * n + j];
						A[i * n + k] = g - s * (h_val + g * tau);
						A[k * n + j] = h_val + s * (g - h_val * tau);
					}
					for (size_t k = j + 1; k < n; k++) {
						g = A[i * n + k]; NV h_val = A[j * n + k];
						A[i * n + k] = g - s * (h_val + g * tau);
						A[j * n + k] = h_val + s * (g - h_val * tau);
					}
					for (size_t k = 0; k < n; k++) {
						g = v[k * n + i]; NV h_val = v[k * n + j];
						v[k * n + i] = g - s * (h_val + g * tau);
						v[k * n + j] = h_val + s * (g - h_val * tau);
					}
				}
			}
		}
		for (size_t i = 0; i < n; i++) {
			b[i] += z[i];
			d[i] = b[i];
			z[i] = 0.0;
		}
	}
	Safefree(b); Safefree(z);
	// Sort eigenvalues and corresponding eigenvectors in descending order
	for (size_t i = 0; i < n - 1; i++) {
		size_t max_k = i;
		NV max_val = d[i];
		for (size_t j = i + 1; j < n; j++) {
			if (d[j] > max_val) {
				 max_val = d[j];
				 max_k = j;
			}
		}
		if (max_k != i) {
			d[max_k] = d[i];
			d[i] = max_val;
			for (size_t k = 0; k < n; k++) {
				 NV tmp = v[k * n + i];
				 v[k * n + i] = v[k * n + max_k];
				 v[k * n + max_k] = tmp;
			}
		}
	}
}

// --- pull a numeric value out of an SV* slot
static int c2c_num(pTHX_ SV **ep, NV *out) {
	if (ep && *ep && SvOK(*ep) && looks_like_number(*ep)) {
		*out = SvNV(*ep);
		return 1;
	}
	return 0;
}

static SV* c2c_call(pTHX_ SV *cv, SV *rv1, SV *rv2) {
	dSP;
	ENTER;
	SAVETMPS;
	PUSHMARK(SP);
	EXTEND(SP, 2);
	PUSHs(rv1);
	PUSHs(rv2);
	PUTBACK;
	unsigned int count = call_sv(cv, G_SCALAR);
	SPAGAIN;
	SV *ret = (count > 0) ? newSVsv(POPs) : newSV(0);
	PUTBACK;
	FREETMPS;
	LEAVE;
	return ret;
}
/* Mark the column whose name equals `want` as an outer column; returns 1 if a
 matching column was found, 0 otherwise. Comparison is via sv_eq so that a
 non-ASCII name (e.g. "ΔG") matches regardless of whether either side carries
 the UTF-8 flag - a plain byte memEQ would miss when the flags differ.*/
static int c2c_mark(pTHX_ SV **col_names, size_t ncols, SV *want, char *is_outer) {
	for (size_t cc = 0; cc < ncols; cc++) {
		if (sv_eq(col_names[cc], want)) { is_outer[cc] = 1; return 1; }
	}
	return 0;
}
/*
 filter() helpers

 Resolve the cell SV for a column in the "current row".
   AoH: current row is row_hv         -> hv_fetch(row_hv, col)
   HoA: current row is index idx      -> hv_fetch(data_hv,col) -> AV -> av_fetch(idx)*/
typedef struct {
	bool is_aoh;
	HV *row_hv;
	HV *data_hv;
	SSize_t idx;
} filt_ctx;

#define FLT_AOH 1
#define FLT_HOA 2
#define FLT_HOH 3

/*Call the predicate coderef with the row as $_ and $_[0], and the row
identifier as $_[1] (the outer key for HoH, the 0-based row index for
AoH/HoA; undef if none). true => keep.*/
static bool filt_call(pTHX_ SV *code, SV *row_rv, SV *id) {
	dSP;
	bool keep;
	ENTER; SAVETMPS;
	SAVE_DEFSV;
	DEFSV_set(row_rv);
	PUSHMARK(SP);
	EXTEND(SP, 2);
	PUSHs(row_rv);
	PUSHs(id ? id : &PL_sv_undef);
	PUTBACK;
	(void)call_sv(code, G_SCALAR);
	SPAGAIN;
	{
		SV *res = POPs;	//POP once; SvTRUE is a multi-eval macro
		keep = SvTRUE(res) ? 1 : 0;
	}
	PUTBACK;
	FREETMPS; LEAVE;
	return keep;
}

/*Perl's own "give me an IV if this value really is one" test, which decides
whether a comparison can be done in integers.  It arrived in 5.13.2 and is
core-only -- ppport lists it Viu and does not backport it -- so the 5.10 and
5.12 builds get the same definition perl uses, verbatim from sv.h.*/
#ifndef SvIV_please_nomg
#  define SvIV_please_nomg(sv) \
	(!(SvFLAGS(sv) & (SVf_IOK|SVp_IOK)) && (SvNOK(sv) || SvPOK(sv)) \
		? (sv_2iv(sv), SvIOK(sv)) : SvIOK(sv))
#endif

/*col() predicates compiled to C
A col() object hands filter() two descriptions of the same test: the {code}
closure, and -- when every part of the expression is something C can
reproduce exactly -- a {plan}, the expression as nested array refs (see
Stats::LikeR::col in LikeR.pm for the layout).  Compiling the plan once per
filter() call replaces, for every row, one hash allocation with a cell per
column plus a call into perl with two or three pointer dereferences and a
comparison.  No plan (a ->match regex, an operand that is a reference) means
the closure path below runs exactly as it always has.*/
#define FLTP_NUM 0
#define FLTP_STR 1
#define FLTP_AND 2
#define FLTP_OR	 3
#define FLTP_NOT 4
/*comparison ids; the numeric (> < >= <= == !=) and string (gt lt ge le eq ne)
tables are in the same order, so one set of names serves both*/
#define FLTC_GT 0
#define FLTC_LT 1
#define FLTC_GE 2
#define FLTC_LE 3
#define FLTC_EQ 4
#define FLTC_NE 5

typedef struct flt_node {
	U8 kind;			// FLTP_* 
	U8 op;			// FLTC_*, leaves only
	U8 swap;			// literal was on the left: 3 > col('x')
	bool is_iv;		// numeric literal fits an IV, so compare as integers
	int slot;		// which column, leaves only
	SV *val;	// the literal; borrowed from the plan, which the caller holds
	NV nv;				// its numeric value ...
	IV iv;				// ... and its integer value when is_iv
	struct flt_node *l, *r;
} flt_node;

typedef struct {
	flt_node *nodes; // every node of the tree; the root is nodes[0]
	int used;
	SV **names;	// one shared-hash-key SV per distinct column
	AV **cav;	// HoA only: that column's array, or NULL when absent
	SV **cells;	// scratch: the current row's cell for each column
	int nslots;
} flt_prog;

static SV *flt_pe(pTHX_ AV *a, SSize_t i) {	//plan element or NULL
	SV **p = av_fetch(a, i, 0);
	return (p && *p) ? *p : NULL;
}

/*Node count of a well-formed plan, or -1 if it is not one.  Anything odd here
(a hand-built object, a plan from a newer LikeR.pm) just falls back to the
closure, so this validates rather than croaks.*/
static int flt_plan_size(pTHX_ SV *p) {
	if (!p || !SvROK(p) || SvTYPE(SvRV(p)) != SVt_PVAV) return -1;
	AV *a = (AV *)SvRV(p);
	SV *k = flt_pe(aTHX_ a, 0);
	if (!k || !SvIOK(k)) return -1;
	switch (SvIVX(k)) {
		case FLTP_NUM: case FLTP_STR: {
			SV *op = flt_pe(aTHX_ a, 1);
			SV *nm = flt_pe(aTHX_ a, 2);
			SV *vl = flt_pe(aTHX_ a, 3);
			if (av_len(a) != 4 || !op || !SvIOK(op) || SvIVX(op) < 0 || SvIVX(op) > FLTC_NE)
				return -1;
			if (!nm || !SvOK(nm) || SvROK(nm)) return -1;
			if (!vl || !SvOK(vl) || SvROK(vl)) return -1;
			return 1;
		}
		case FLTP_AND: case FLTP_OR: {
			if (av_len(a) != 2) return -1;
			int l = flt_plan_size(aTHX_ flt_pe(aTHX_ a, 1));
			if (l < 0) return -1;
			int r = flt_plan_size(aTHX_ flt_pe(aTHX_ a, 2));
			return (r < 0) ? -1 : 1 + l + r;
		}
		case FLTP_NOT: {
			if (av_len(a) != 1) return -1;
			int c = flt_plan_size(aTHX_ flt_pe(aTHX_ a, 1));
			return (c < 0) ? -1 : 1 + c;
		}
	}
	return -1;
}

/*Intern a column name: same name -> same slot, so col('x') > 0 & col('x') < 9
looks the column up once per row.  The name is kept as a shared-hash-key SV,
which carries its hash with it and makes hv_fetch_ent cheap.*/
static int flt_slot(pTHX_ flt_prog *pg, SV *name) {
	STRLEN l;
	const char *s = SvPV_const(name, l);
	const bool u = cBOOL(SvUTF8(name));
	for (int i = 0; i < pg->nslots; i++) {
		STRLEN l2;
		const char *s2 = SvPV_const(pg->names[i], l2);
		if (l == l2 && cBOOL(SvUTF8(pg->names[i])) == u && memEQ(s, s2, l)) return i;
	}
	pg->names[pg->nslots] = sv_2mortal(newSVpvn_share(s, u ? -(I32)l : (I32)l, 0));
	return pg->nslots++;
}

static flt_node *flt_build(pTHX_ flt_prog *pg, SV *p) {
	AV *a  = (AV *)SvRV(p);
	flt_node *nd = &pg->nodes[pg->used++];
	Zero(nd, 1, flt_node);
	nd->kind = (U8)SvIVX(flt_pe(aTHX_ a, 0));
	switch (nd->kind) {
		case FLTP_NUM: case FLTP_STR: {
			SV *sw = flt_pe(aTHX_ a, 4);
			nd->op	 = (U8)SvIVX(flt_pe(aTHX_ a, 1));
			nd->slot = flt_slot(aTHX_ pg, flt_pe(aTHX_ a, 2));
			nd->val	 = flt_pe(aTHX_ a, 3);
			nd->swap = (sw && SvTRUE(sw)) ? 1 : 0;
			if (nd->kind == FLTP_NUM) {
				/*the perl side only plans a literal that looks like a number,
				so numifying it here cannot warn*/
				SvIV_please_nomg(nd->val);
				nd->is_iv = cBOOL(SvIOK(nd->val) && !SvIsUV(nd->val));
				nd->iv	  = nd->is_iv ? SvIVX(nd->val) : 0;
				nd->nv	  = SvNV(nd->val);
			}
			break;
		}
		case FLTP_AND: case FLTP_OR:
			nd->l = flt_build(aTHX_ pg, flt_pe(aTHX_ a, 1));
			nd->r = flt_build(aTHX_ pg, flt_pe(aTHX_ a, 2));
			break;
		default:	//FLTP_NOT
			nd->l = flt_build(aTHX_ pg, flt_pe(aTHX_ a, 1));
			break;
	}
	return nd;
}

/*Compile {plan} into PG, or return false to leave the caller on the closure
path.  Everything allocated here is freed by the caller's scope exit (so a
croak from a later row cannot leak it).*/
static bool flt_compile(pTHX_ flt_prog *pg, SV *plan) {
	int n = flt_plan_size(aTHX_ plan);
	if (n < 1) return FALSE;
	Zero(pg, 1, flt_prog);
	pg->nodes = (flt_node *)safemalloc(n * sizeof(flt_node));
	SAVEFREEPV(pg->nodes);
	pg->names = (SV **)safemalloc(n * sizeof(SV *));		//<= n leaves
	SAVEFREEPV(pg->names);
	pg->cav	  = (AV **)safemalloc(n * sizeof(AV *));
	SAVEFREEPV(pg->cav);
	pg->cells = (SV **)safemalloc(n * sizeof(SV *));
	SAVEFREEPV(pg->cells);
	(void)flt_build(aTHX_ pg, plan);
	return TRUE;
}

/*One numeric comparison.  Same rules as the perl closure: a missing, undef or
non-numeric cell never matches, and the comparison itself is perl's (integer
when both sides are integers, otherwise floating point).*/
static bool flt_num(pTHX_ SV *cell, const flt_node *nd) {
	if (!cell) return FALSE;
	/*Read the cell where it can be read, and only convert it where it must
	be.  A cell that is already a number answers from SvNVX/SvIVX; caching a
	conversion into it instead would write to the caller's frame, and on a
	numeric column that is a dirtied page per few dozen rows for nothing.
	Only a string cell is numified, which is what perl's own `>` does too.

	It also skips both calls below.  A bare IOK/NOK scalar has no get magic
	to run, and looks_like_number() -- which is out of line, and was 2.6% of
	filter() on the 300,000-row frame in scale.pl -- cannot answer anything
	but yes for one.  A numeric column is nothing but these.*/
	const U32 f = SvFLAGS(cell);
	if ((f & (SVs_GMG|SVf_ROK|SVf_POK)) || !(f & (SVf_IOK|SVf_NOK))) {
		SvGETMAGIC(cell);
		if (!SvOK(cell) || !looks_like_number(cell)) return FALSE;
		if (!SvIOK(cell) && !SvNOK(cell)) SvIV_please_nomg(cell);
	}
	int c;
	if (nd->is_iv && SvIOK(cell) && !SvIsUV(cell)) {
		const IV a = SvIVX(cell), b = nd->iv;
		c = (a < b) ? -1 : (a > b) ? 1 : 0;
	} else {
		const NV a = SvNOK(cell)  ? SvNVX(cell)
		          : !SvIOK(cell)  ? SvNV_nomg(cell)
		          : SvIsUV(cell)  ? (NV)SvUVX(cell) : (NV)SvIVX(cell);
		const NV b = nd->nv;
		if	(a < b) c = -1;
		else if (a > b) c =  1;
		else if (a == b) c = 0;
		else return nd->op == FLTC_NE;	//NaN: unequal to everything, ordered by nothing
	}
	if (nd->swap) c = -c;
	switch (nd->op) {
		case FLTC_GT: return c >  0;
		case FLTC_LT: return c <  0;
		case FLTC_GE: return c >= 0;
		case FLTC_LE: return c <= 0;
		case FLTC_EQ: return c == 0;
		default:	  return c != 0;	//FLTC_NE
	}
}

//One string comparison; an undef or missing cell never matches.
static bool flt_str(pTHX_ SV *cell, const flt_node *nd) {
	if (!cell) return FALSE;
	SvGETMAGIC(cell);
	if (!SvOK(cell)) return FALSE;
	if (nd->op == FLTC_EQ || nd->op == FLTC_NE) {
		const bool e = cBOOL(sv_eq(cell, nd->val));
		return (nd->op == FLTC_EQ) ? e : !e;
	}
	int c = sv_cmp(cell, nd->val);
	if (nd->swap) c = -c;
	switch (nd->op) {
		case FLTC_GT: return c >  0;
		case FLTC_LT: return c <  0;
		case FLTC_GE: return c >= 0;
		default:	  return c <= 0;	//FLTC_LE
	}
}

static bool flt_eval(pTHX_ const flt_prog *pg, const flt_node *nd) {
	switch (nd->kind) {
		case FLTP_AND: return flt_eval(aTHX_ pg, nd->l) && flt_eval(aTHX_ pg, nd->r);
		case FLTP_OR:  return flt_eval(aTHX_ pg, nd->l) || flt_eval(aTHX_ pg, nd->r);
		case FLTP_NOT: return !flt_eval(aTHX_ pg, nd->l);
		case FLTP_NUM: return flt_num(aTHX_ pg->cells[nd->slot], nd);
		default:	   return flt_str(aTHX_ pg->cells[nd->slot], nd);
	}
}

//Test one row given as a hash (AoH, HoH).
static bool flt_row_hv(pTHX_ flt_prog *pg, HV *row) {
	for (int s = 0; s < pg->nslots; s++) {
		HE *e = hv_fetch_ent(row, pg->names[s], 0, 0);
		pg->cells[s] = e ? HeVAL(e) : NULL;
	}
	return flt_eval(aTHX_ pg, &pg->nodes[0]);
}

/*Test row I of a HoA, whose columns were bound once by flt_bind_hoa.

A tied column has to go through av_fetch: its cells do not exist until FETCH
has run, and AvARRAY() on one reads the wrong block entirely -- which up to
0.301 made filter() on a tied HoA column return an empty frame rather than
say anything.  nslots is the number of distinct columns the predicate names,
so the test costs one perfectly-predicted branch per predicate per row.*/
static bool flt_row_hoa(pTHX_ flt_prog *pg, SSize_t i) {
	for (int s = 0; s < pg->nslots; s++) {
		AV *av = pg->cav[s];
		if (av && SvRMAGICAL(av)) {
			SV **p = av_fetch(av, i, 0);
			pg->cells[s] = (p && *p) ? *p : NULL;
		} else {
			pg->cells[s] = (av && i <= AvFILLp(av)) ? AvARRAY(av)[i] : NULL;
		}
	}
	return flt_eval(aTHX_ pg, &pg->nodes[0]);
}

//Resolve every column the predicate names against a HoA frame, once.
static void flt_bind_hoa(pTHX_ flt_prog *pg, HV *data) {
	for (int s = 0; s < pg->nslots; s++) {
		HE *e = hv_fetch_ent(data, pg->names[s], 0, 0);
		SV *v = e ? HeVAL(e) : NULL;
		pg->cav[s] = (v && SvROK(v) && SvTYPE(SvRV(v)) == SVt_PVAV) ? (AV *)SvRV(v) : NULL;
	}
}

/*Hand back an exactly-sized array: filter() knows how many rows it kept
before it fills anything, so no output array is ever grown, over-allocated
or copied.  Fill AvARRAY[0 .. n-1] and call this.*/
#define FLT_AV_FILLED(av, n) (AvFILLp(av) = (SSize_t)(n) - 1)

/*One output cell: newSVsv, with the two shapes a numeric data frame is almost
entirely made of taken directly.  sv_setsv has to look for get-magic, decide
between stealing, copy-on-write and a plain copy, and dispatch on both source
and destination type before it can move an NV; when the source is a bare
number none of that can apply.  NULL (a hole, or a column that stops short of
the frame) becomes undef, as it did when this was newSVsv(&PL_sv_undef).
Anything else -- strings, refs, objects, magic, undef -- falls through to
newSVsv unchanged, so nothing about the copy's semantics moves.

A string cell is where most of a mixed frame's copying time goes -- a malloc
and a memcpy for the buffer -- and copy-on-write is the obvious way out, but
it is not available and would not pay if it were.  newSVsv is
newSVsv_flags(sv, SV_GMAGIC|SV_NOSTEAL), which does not pass
SV_COW_SHARED_HASH_KEYS, so its string copies are never copy-on-write; and
SV_DO_COW_SVSETSV, the flag pair a plain `my $b = $a` gets, is defined as 0
unless PERL_CORE is set -- perl's own sv.h says "the core is safe for this COW
optimisation, XS code on CPAN may not be".  Reaching past that with
SV_COW_SHARED_HASH_KEYS by hand, or copying through sv_setsv_nomg, was
measured on the 300,000-row frame in scale.pl (two one-character string
columns) and is slower either way: filter() 23.0 ms -> 28.3 ms, merge()
103 ms -> 126 ms.  For a string this short -- and a data frame's string cells
usually are this short -- the malloc costs less than the bookkeeping COW puts
in its place: an out-of-line sv_setsv, the CowREFCNT increment, and the
read-only flip on the source.*/

/*The kept row positions, from the flags the predicate pass set.  A materialise
loop that walks these is `kept` trips of straight-line copying; one that walks
the flags is `n` trips around a branch no CPU can predict at any interesting
selectivity.  Worth its 8 bytes per KEPT row only where a frame is rebuilt
column by column -- ncol passes over the same rows -- so that is the only
place it is built; a single-pass rebuild reads the flags directly.*/
PERL_STATIC_INLINE SSize_t *flt_kept_index(pTHX_ const char *keep,
                                           SSize_t n, SSize_t kept) {
	SSize_t *idx = (SSize_t*)safemalloc((kept ? (size_t)kept : 1) * sizeof(SSize_t));
	SAVEFREEPV(idx);
	SSize_t t = 0;
	for (SSize_t i = 0; i < n && t < kept; i++) if (keep[i]) idx[t++] = i;
	return idx;
}

PERL_STATIC_INLINE SV *flt_cell_copy(pTHX_ SV *s) {
	/*SVt_PVNV is the last body type that can hold a bare number; PVMG and
	above bring a stash, magic or an lvalue behind them and are left to
	newSVsv along with anything flagged below.*/
	if (s && SvTYPE(s) <= SVt_PVNV) {
		const U32 f = SvFLAGS(s);
		if (!(f & (SVs_GMG|SVs_SMG|SVs_RMG|SVs_OBJECT|SVf_ROK|SVf_POK|SVf_UTF8))) {
			if ((f & (SVf_NOK|SVf_IOK)) == SVf_NOK) return newSVnv(SvNVX(s));
			if ((f & (SVf_NOK|SVf_IOK|SVf_IVisUV)) == SVf_IOK) return newSViv(SvIVX(s));
		}
	}
	return newSVsv(s ? s : &PL_sv_undef);
}

/*the row a closure predicate sees, over a HoA frame
A HoA has no row hashes, so one has to be built for the predicate.  Building
a fresh one per row costs a hash, a hash entry and a scalar per column per
row, nearly all of it thrown away again; instead one hash is built and its
cells are overwritten as the scan moves down the frame.

That is only safe while the predicate treats the row as read-only and lets
go of it, which is the normal case and is checked rather than assumed: if
anything still holds the hash, its reference or any of its cells when the
predicate returns, or if the predicate added or removed a key, the buffer is
abandoned (whoever kept it keeps a hash nobody else will touch) and the next
row gets a fresh one.  So the old one-hash-per-row behaviour is still there
for predicates that need it, and only they pay for it.*/
typedef struct {
	HV *hv;
	SV *rv;    // our reference to hv; NULL once handed away
	SV **slot; // the cell SV of each column, in `names` order
	U32 n;
	char **names;
	STRLEN *nlens;
} flt_rowbuf;

static void flt_rb_new(pTHX_ flt_rowbuf *rb) {
	rb->hv = newHV();
	hv_ksplit(rb->hv, rb->n ? rb->n : 1);
	rb->rv = newRV_noinc((SV *)rb->hv);
	for (U32 c = 0; c < rb->n; c++) {
		SV **sp = hv_store(rb->hv, rb->names[c], rb->nlens[c], newSV(0), 0);
		rb->slot[c] = *sp;
	}
}

static bool flt_rb_reusable(pTHX_ const flt_rowbuf *rb) {
	PERL_UNUSED_CONTEXT;
	if (SvREFCNT(rb->rv) > 1 || SvREFCNT((SV *)rb->hv) > 1) return FALSE;
	if ((U32)HvUSEDKEYS(rb->hv) != rb->n) return FALSE;
	for (U32 c = 0; c < rb->n; c++)
		if (SvREFCNT(rb->slot[c]) > 1) return FALSE;
	return TRUE;
}

/*Registered on the save stack, so a croaking predicate frees the row buffer
on its way out instead of leaking it.*/
static void flt_rb_free(pTHX_ void *p) {
	flt_rowbuf *rb = (flt_rowbuf *)p;
	if (rb->rv) { SvREFCNT_dec(rb->rv); rb->rv = NULL; }
}

/*register column NAME in (reg,order) the first time it is seen, creating its
output array in OUT; used to build HoA output from AoH/HoH input.*/
static void
flt_reg_col(pTHX_ HV *reg, AV *order, HV *out, const char *name, STRLEN nlen){
	if (!hv_exists(reg, name, nlen)) {
		hv_store(reg, name, nlen, newSViv(1), 0);
		hv_store(out, name, nlen, newRV_noinc((SV*)newAV()), 0);
		av_push(order, newSVpvn(name, nlen));
	}
}

static int h2h_keycmp(const void *pa, const void *pb) {
	dTHX;
	SV *const *a = (SV * const *)pa;
	SV *const *b = (SV * const *)pb;
	return sv_cmp(*a, *b);
}
/* Call a column predicate as $cv->($col_values, $col_name) and return its truth.
 $col_values is an array ref of the column's DEFINED cells; $col_name is the
 column key. Used so a block like sub { sd($_[0]) == 0 } can pick columns out.*/
static bool cf_pred(pTHX_ SV *cv_sv, AV *a_av, AV *b_av, SV *name_sv) {
	dSP;
	bool truth = FALSE;
	unsigned int count;
	ENTER;
	SAVETMPS;
	PUSHMARK(SP);
	XPUSHs(sv_2mortal(newRV_inc((SV*)a_av)));
	if (b_av) XPUSHs(sv_2mortal(newRV_inc((SV*)b_av)));
	XPUSHs(sv_2mortal(newSVsv(name_sv)));
	PUTBACK;
	count = call_sv(cv_sv, G_SCALAR);
	SPAGAIN;
	if (count > 0) {
		SV *ret = POPs;        // POPs has a side effect: pop exactly once,
		truth = cBOOL(SvTRUE(ret));     // because SvTRUE() may evaluate its arg twice.
	}
	PUTBACK;
	FREETMPS;
	LEAVE;
	return truth;
}
/* Helpers for _parse_csv_file
save-stack destructor: closes the input handle on ANY exit, including a
croak thrown inside the row callback*/
static void S_pclose(pTHX_ void *p) {
	PerlIO_close((PerlIO*)p);
}

/*Finish the current record: push the pending field, hand the row to the
callback (streaming) or to @$data (slurp), and start a fresh row.

Ownership: the row AV's single reference is transferred to a MORTAL RV
(newRV_noinc + sv_2mortal). On the normal path the inner FREETMPS releases
it; if the callback dies, the unwind's FREETMPS releases it just the same.
If the callback kept a copy of the ref, that copy bumped the refcount and
the row survives for the caller -- exactly the old semantics, minus the
leak and minus one SvREFCNT_dec per row.*/
static void S_emit_row(pTHX_ AV **rowp, SV *field, bool use_cb, SV *callback, AV *data)
{
	av_push(*rowp, newSVsv(field));
	sv_setpvs(field, "");
	if (use_cb) {
		AV *row = *rowp;
		*rowp = NULL;	//ownership leaves this function NOW
		dSP;
		ENTER;
		SAVETMPS;
		PUSHMARK(SP);
		XPUSHs(sv_2mortal(newRV_noinc((SV*)row)));
		PUTBACK;
		call_sv(callback, G_DISCARD);	//may die: nothing left to leak
		FREETMPS;
		LEAVE;
	} else {
		av_push(data, newRV_noinc((SV*)*rowp));
		*rowp = NULL;
	}
	*rowp = newAV();
}

static void lm_append(pTHX_ char **bufp, size_t *lenp, size_t *capp, const char *s){
	size_t slen = strlen(s);
	size_t sep  = (*lenp > 0) ? 1 : 0;
	size_t need = *lenp + sep + slen + 1; //+ NUL
	if (need > *capp) {
		size_t nc = (*capp > 0) ? *capp : 64;
		while (nc < need) nc *= 2;
		Renew(*bufp, nc, char);
		*capp = nc;
	}
	char *dst = *bufp + *lenp;
	if (sep) *dst++ = '+';
	memcpy(dst, s, slen);
	dst[slen] = '\0';
	*lenp += sep + slen;
}

/*
Formula and data-shape handling shared by lm() and glm().

The two functions differ only in what they do with the design matrix once it
exists, so everything up to that point is here: how a data argument is read,
how its rows are named, and how a formula string becomes a term list. Keeping
one copy is what makes a fit's fitted.values, residuals and deviance.resid
key on the same names whichever function produced them.
*/

/*Column names that label an observation rather than measure it. A HoA with one
of these among its keys -- or an AoH whose rows carry one -- names its rows
with that column instead of 1..n, and '.' leaves the column out of the
predictors, since a row label is not a variable.*/
static const char *const lm_row_name_keys[] =
	{ "row.names", "_row", "rownames", ".rownames" };
#define LM_N_ROW_NAME_KEYS (sizeof lm_row_name_keys / sizeof lm_row_name_keys[0])

static bool lm_is_row_name_key(const char *k, STRLEN len) {
	for (size_t i = 0; i < LM_N_ROW_NAME_KEYS; i++)
		if (strlen(lm_row_name_keys[i]) == len
		    && memcmp(k, lm_row_name_keys[i], len) == 0) return TRUE;
	return FALSE;
}

/*Work out whether the data argument is a hash of columns (HoA), a hash of rows
(HoH) or an array of rows (AoH), label every observation, and hand back the
two views the design-matrix helpers accept: *data_hoa_out for a HoA,
*row_hashes_out otherwise (exactly one of the two is non-NULL).

Returns the observation count. *row_names_out is a Newx array of savepv'd
names; the caller frees each name and then the array. Croaks -- with fname as
the message prefix, and after freeing whatever it had allocated -- on a shape
neither function can read. Callers run lm_formula_split() first and pass its
buffer as fbuf so that those croaks release it too.*/
static size_t lm_read_rows(pTHX_ SV *data_sv, const char *fname,
                           char *fbuf,
                           HV  **data_hoa_out,
                           HV ***row_hashes_out,
                           char ***row_names_out) {
	SV  *ref        = SvRV(data_sv);
	HV  *data_hoa   = NULL;
	HV **row_hashes = NULL;
	char **row_names = NULL;
	size_t n = 0, i, k;
	HE *entry;

	*data_hoa_out = NULL; *row_hashes_out = NULL; *row_names_out = NULL;

	if (SvTYPE(ref) == SVt_PVHV) {
		HV *hv = (HV*)ref;
		SV *val;
		if (hv_iterinit(hv) == 0) { Safefree(fbuf); croak("%s: Data hash is empty", fname); }
		entry = hv_iternext(hv);
		if (!entry) return 0;
		val = hv_iterval(hv, entry);
		if (SvROK(val) && SvTYPE(SvRV(val)) == SVt_PVAV) {
			AV *rn_av = NULL;
			data_hoa = hv;
			n = (size_t)(av_len((AV*)SvRV(val)) + 1);
			for (k = 0; k < LM_N_ROW_NAME_KEYS; k++) {
				SV **rn = hv_fetch(hv, lm_row_name_keys[k],
				                            (I32)strlen(lm_row_name_keys[k]), 0);
				if (rn && *rn && SvROK(*rn) && SvTYPE(SvRV(*rn)) == SVt_PVAV) {
					rn_av = (AV*)SvRV(*rn);
					break;
				}
			}
			Newx(row_names, n ? n : 1, char*);
			for (i = 0; i < n; i++) {
				SV **nm = rn_av ? av_fetch(rn_av, (SSize_t)i, 0) : NULL;
				if (nm && *nm && SvOK(*nm)) {
					STRLEN l; const char *s = SvPV(*nm, l);
					row_names[i] = savepvn(s, l);
				} else {
					char buf[32];
					snprintf(buf, sizeof buf, "%lu", (unsigned long)(i + 1));
					row_names[i] = savepv(buf);
				}
			}
		} else if (SvROK(val) && SvTYPE(SvRV(val)) == SVt_PVHV) {
			//HoH: the outer keys already name the rows.
			n = (size_t)HvUSEDKEYS(hv);
			Newx(row_names, n ? n : 1, char*);
			Newx(row_hashes, n ? n : 1, HV*);
			hv_iterinit(hv);
			i = 0;
			while ((entry = hv_iternext(hv))) {
				SV *rval = hv_iterval(hv, entry);
				I32 klen;
				if (!SvROK(rval) || SvTYPE(SvRV(rval)) != SVt_PVHV) {
					for (k = 0; k < i; k++) Safefree(row_names[k]);
					Safefree(row_names); Safefree(row_hashes); Safefree(fbuf);
					croak("%s: Hash values must all be HashRefs (HoH)", fname);
				}
				row_names[i]  = savepv(hv_iterkey(entry, &klen));
				row_hashes[i] = (HV*)SvRV(rval);
				i++;
			}
		} else { Safefree(fbuf); croak("%s: Hash values must be ArrayRefs (HoA) or HashRefs (HoH)", fname); }
	} else if (SvTYPE(ref) == SVt_PVAV) {
		AV *av = (AV*)ref;
		n = (size_t)(av_len(av) + 1);
		Newx(row_names, n ? n : 1, char*);
		Newx(row_hashes, n ? n : 1, HV*);
		for (i = 0; i < n; i++) {
			SV **val = av_fetch(av, (SSize_t)i, 0);
			HV  *rh;
			SV **nm = NULL;
			if (!val || !SvROK(*val) || SvTYPE(SvRV(*val)) != SVt_PVHV) {
				for (k = 0; k < i; k++) Safefree(row_names[k]);
				Safefree(row_names); Safefree(row_hashes); Safefree(fbuf);
				croak("%s: Array values must be HashRefs (AoH)", fname);
			}
			rh = (HV*)SvRV(*val);
			row_hashes[i] = rh;
			for (k = 0; k < LM_N_ROW_NAME_KEYS; k++) {
				nm = hv_fetch(rh, lm_row_name_keys[k],
				              (I32)strlen(lm_row_name_keys[k]), 0);
				if (nm && *nm && SvOK(*nm)) break;
				nm = NULL;
			}
			if (nm && *nm && SvOK(*nm)) {
				STRLEN l; const char *s = SvPV(*nm, l);
				row_names[i] = savepvn(s, l);
			} else {
				char buf[32];
				snprintf(buf, sizeof buf, "%lu", (unsigned long)(i + 1));
				row_names[i] = savepv(buf);
			}
		}
	} else { Safefree(fbuf); croak("%s: Data must be an Array or Hash reference", fname); }

	*data_hoa_out   = data_hoa;
	*row_hashes_out = row_hashes;
	*row_names_out  = row_names;
	return n;
}

/*Stage 1 of formula handling: copy the formula with whitespace removed, split
it at '~', and take the intercept markers out of the right-hand side.

R accepts several spellings of "no intercept" -- a trailing `- 1`, `+ 0`, or a
leading `0 +` -- as well as `+ 1` and a leading `1 +` for the intercept that
would be there anyway; all of them are recognised. The scan steps over
`I(...)` so the `-1` inside `I(x-1)` stays where it is instead of being read
as intercept suppression, and the buffer grows with the formula rather than
being a fixed size a long model can overrun.

Returns a Newx buffer the caller must Safefree; *lhs_out and *rhs_out point
into it, so it has to outlive the last use of the response name. Runs before
any data is read, so a croak here has nothing to clean up but its own copy.*/
static char *lm_formula_split(pTHX_ const char *formula,
                              const char *fname,
                              char **lhs_out,
                              char **rhs_out,
                              bool *has_intercept) {
	char *f_cpy = NULL;
	char *src, *dst, *tilde, *rhs, *p_idx;

	Newx(f_cpy, strlen(formula) + 1, char);
	src = (char*)formula; dst = f_cpy;
	while (*src) { if (!isspace((unsigned char)*src)) *dst++ = *src; src++; }
	*dst = '\0';

	tilde = strchr(f_cpy, '~');
	if (!tilde) {
		Safefree(f_cpy);
		croak("%s: invalid formula, missing '~'", fname);
	}
	*tilde = '\0';
	rhs = tilde + 1;
	*lhs_out = f_cpy;
	*rhs_out = rhs;
	*has_intercept = TRUE;

	p_idx = rhs;
	while (*p_idx) {
		if (p_idx[0] == 'I' && p_idx[1] == '(') {
			int depth = 0;
			while (*p_idx) { if (*p_idx == '(') depth++; else if (*p_idx == ')') { depth--; if (depth == 0) { p_idx++; break; } } p_idx++; }
			continue;
		}
		if (p_idx[0] == '-' && p_idx[1] == '1' &&
			(p_idx[2] == '\0' || p_idx[2] == '+' || p_idx[2] == '-')) {
			*has_intercept = FALSE;
			memmove(p_idx, p_idx + 2, strlen(p_idx + 2) + 1);
			continue;
		}
		if (p_idx[0] == '+' && p_idx[1] == '0' &&
			(p_idx[2] == '\0' || p_idx[2] == '+' || p_idx[2] == '-')) {
			*has_intercept = FALSE;
			memmove(p_idx, p_idx + 2, strlen(p_idx + 2) + 1);
			continue;
		}
		if (p_idx == rhs && p_idx[0] == '0' && p_idx[1] == '+') {
			*has_intercept = FALSE;
			memmove(p_idx, p_idx + 2, strlen(p_idx + 2) + 1);
			continue;
		}
		if (p_idx == rhs && p_idx[0] == '0' && p_idx[1] == '\0') {
			*has_intercept = FALSE; p_idx[0] = '\0'; break;
		}
		if (p_idx[0] == '+' && p_idx[1] == '1' &&
			(p_idx[2] == '\0' || p_idx[2] == '+' || p_idx[2] == '-')) {
			memmove(p_idx, p_idx + 2, strlen(p_idx + 2) + 1);
			continue;
		}
		if (p_idx == rhs) {
			if (p_idx[0] == '1' && p_idx[1] == '\0') { p_idx[0] = '\0'; break; }
			if (p_idx[0] == '1' && p_idx[1] == '+') { memmove(p_idx, p_idx + 2, strlen(p_idx + 2) + 1); continue; }
		}
		p_idx++;
	}

	//Removing a marker can leave the '+' that joined it behind.
	while ((p_idx = strstr(rhs, "++")) != NULL)
		memmove(p_idx, p_idx + 1, strlen(p_idx + 1) + 1);
	if (rhs[0] == '+') memmove(rhs, rhs + 1, strlen(rhs + 1) + 1);
	{
		size_t len_rhs = strlen(rhs);
		if (len_rhs > 0 && rhs[len_rhs - 1] == '+') rhs[len_rhs - 1] = '\0';
	}
	return f_cpy;
}

/*Stage two: turn the cleaned right-hand side into the term list the design
matrix is built from. '.' expands to every column except the response and any
row-name column; `a*b` expands to its main effects and interactions; repeated
terms are dropped, as R's formula parser drops them.

Needs the data, hence the split from lm_formula_split(): '.' cannot be
expanded until the columns are known. rhs is consumed in place (strtok).
*terms_out and *uniq_out come back as Newx arrays of savepv'd strings; the
caller frees the strings and then the arrays.*/
static void lm_formula_terms(pTHX_ char *rhs, const char *lhs,
   HV *data_hoa, HV **row_hashes, size_t n, bool has_intercept,
   const char *fname, char ***terms_out,
   unsigned int *num_terms_out, char ***uniq_out,
   unsigned int *num_uniq_out) {
	char **terms = NULL, **uniq_terms = NULL;
	unsigned int term_cap = 64, num_terms = 0, num_uniq = 0, i, j;
	char *rhs_expanded = NULL;
	char *chunk;
	size_t rhs_len = 0, rhs_cap = 1;

	Newxz(rhs_expanded, 1, char);
	chunk = strtok(rhs, "+");
	while (chunk != NULL) {
		if (strcmp(chunk, ".") == 0) {
			AV *cols = get_all_columns(aTHX_ data_hoa, row_hashes, n);
			for (SSize_t c = 0; c <= av_len(cols); c++) {
				SV **col_sv = av_fetch(cols, c, 0);
				if (col_sv && *col_sv && SvOK(*col_sv)) {
					STRLEN cl;
					const char *col_name = SvPV(*col_sv, cl);
					if (strcmp(col_name, lhs) != 0 && !lm_is_row_name_key(col_name, cl))
						lm_append(aTHX_ &rhs_expanded, &rhs_len, &rhs_cap, col_name);
				}
			}
			SvREFCNT_dec(cols);
		} else {
			lm_append(aTHX_ &rhs_expanded, &rhs_len, &rhs_cap, chunk);
		}
		chunk = strtok(NULL, "+");
	}

	Newx(terms, term_cap, char*); Newx(uniq_terms, term_cap, char*);
	if (has_intercept) terms[num_terms++] = savepv("Intercept");

	if (rhs_len > 0) {
		chunk = strtok(rhs_expanded, "+");
		while (chunk != NULL) {
			if (num_terms >= term_cap - 3) {
				term_cap *= 2;
				Renew(terms, term_cap, char*); Renew(uniq_terms, term_cap, char*);
			}
			lm_expand_cross(aTHX_ chunk, fname, &terms, &num_terms, &term_cap);
			chunk = strtok(NULL, "+");
		}
	}
	Safefree(rhs_expanded);

	for (i = 0; i < num_terms; i++) {
		bool found = FALSE;
		for (j = 0; j < num_uniq; j++)
			if (strcmp(terms[i], uniq_terms[j]) == 0) { found = TRUE; break; }
		if (!found) uniq_terms[num_uniq++] = savepv(terms[i]);
	}

	*terms_out    = terms;      *num_terms_out = num_terms;
	*uniq_out     = uniq_terms; *num_uniq_out  = num_uniq;
}

typedef int (*cs_cmp_fn)(pTHX_ void *ctx, size_t i, size_t j);

//Sort by a named column: pre-fetched cell SVs plus a numeric/string flag.
typedef struct {
	SV **vals;	//borrowed cell SV* per row (NULL == missing)
	unsigned short numeric;	//1 => compare with SvNV, 0 => compare with sv_cmp
} cs_col_ctx;

//Sort by a user comparator: per-row refs handed to $a/$b before each call.
typedef struct {
	SV **rows;	// row ref per index (RV to HV)
	CV  *cv;	// the comparator
	SV  *a_sv;		// scalar currently aliased to package $a
	SV  *b_sv;		// scalar currently aliased to package $b
} cs_code_ctx;

static int cs_col_cmp(pTHX_ void *vctx, size_t i, size_t j) {
	cs_col_ctx *c = (cs_col_ctx *)vctx;
	SV *av = c->vals[i];
	SV *bv = c->vals[j];
	int a_ok = (av && SvOK(av));
	int b_ok = (bv && SvOK(bv));
	if (!a_ok || !b_ok) { // undef/missing always sorts last
		if (!a_ok && !b_ok) return 0;
		return a_ok ? -1 : 1;
	}
	if (c->numeric) {
		NV x = SvNV(av), y = SvNV(bv);
		return (x > y) - (x < y);
	}
	return sv_cmp(av, bv);		//Perl's `cmp` semantics
}

static int cs_code_cmp(pTHX_ void *vctx, size_t i, size_t j) {
	cs_code_ctx *c = (cs_code_ctx *)vctx;
	dSP;
	size_t count;
	NV r;
	// alias the two rows into the comparator's $a / $b
	sv_setsv(c->a_sv, c->rows[i]);
	sv_setsv(c->b_sv, c->rows[j]);
	ENTER;
	SAVETMPS;
	PUSHMARK(SP);
	// sort comparators read $a/$b, not @_, so we push no arguments
	PUTBACK;
	count = call_sv((SV *)c->cv, G_SCALAR);
	SPAGAIN;
	if (count > 0) {
		/*POPs has a side effect (sp--) and SvNV is a macro that may
		evaluate its argument more than once on older perls (5.10),
		so capture the SV first rather than writing SvNV(POPs).*/
		SV *res = POPs;
		r = SvNV(res);
	} else {
		r = 0.0;
	}
	PUTBACK;
	FREETMPS;
	LEAVE;
	return (r > 0) - (r < 0);
}

//Stable bottom merge for the index permutation.
static void cs_merge(pTHX_ size_t *restrict idx, size_t *restrict tmp,
					 size_t lo, size_t mid, size_t hi,
					 cs_cmp_fn cmp, void *ctx) {
	size_t i = lo, j = mid, k = lo;
	while (i < mid && j < hi) {
		//`<= 0` keeps equal elements in original order => stable
		if (cmp(aTHX_ ctx, idx[i], idx[j]) <= 0) tmp[k++] = idx[i++];
		else                                     tmp[k++] = idx[j++];
	}
	while (i < mid) tmp[k++] = idx[i++];
	while (j < hi)  tmp[k++] = idx[j++];
	for (size_t t = lo; t < hi; t++) idx[t] = tmp[t];
}

static void cs_msort(pTHX_ size_t *restrict idx, size_t *restrict tmp,
					 size_t lo, size_t hi, cs_cmp_fn cmp, void *ctx) {
	if (hi - lo < 2) return;
	size_t mid = lo + (hi - lo) / 2;
	cs_msort(aTHX_ idx, tmp, lo, mid, cmp, ctx);
	cs_msort(aTHX_ idx, tmp, mid, hi, cmp, ctx);
	// skip the merge when the halves are already in order
	if (cmp(aTHX_ ctx, idx[mid - 1], idx[mid]) <= 0) return;
	cs_merge(aTHX_ idx, tmp, lo, mid, hi, cmp, ctx);
}

/*Resolve $a / $b in the package where the comparator was compiled, localize
them for the duration of the sort, and point them at two fresh scalars.
Mirrors what Perl's own sort does. The save stack (ENTER must already be in
effect) restores the caller's $a/$b on scope exit, including via croak.*/
static void cs_bind_ab(pTHX_ CV *cv, SV **a_out, SV **b_out) {
	HV *stash = CvSTASH(cv);
	if (!stash) stash = PL_curstash;
	const char *pkg = stash ? HvNAME(stash) : NULL;
	if (!pkg) pkg = "main";
	STRLEN plen = strlen(pkg);

	//build "<pkg>::a" / "<pkg>::b" so the GVs land in the right stash
	char *buf;
	Newx(buf, plen + 4, char);
	SAVEFREEPV(buf);
	memcpy(buf, pkg, plen);
	buf[plen] = ':'; buf[plen + 1] = ':'; buf[plen + 3] = '\0';

	buf[plen + 2] = 'a';
	GV *agv = gv_fetchpv(buf, GV_ADD, SVt_PV);
	buf[plen + 2] = 'b';
	GV *bgv = gv_fetchpv(buf, GV_ADD, SVt_PV);

	SAVESPTR(GvSV(agv));
	SAVESPTR(GvSV(bgv));
	SV *a_sv = sv_newmortal();
	SV *b_sv = sv_newmortal();
	GvSV(agv) = a_sv;
	GvSV(bgv) = b_sv;
	*a_out = a_sv;
	*b_out = b_sv;
}

// 1. shape tag for input/output (put beside the ctx structs)
typedef enum { CS_AOH = 0, CS_HOA = 1, CS_AOA = 2 } cs_shape;

// 2. comparator undef-probe (put right after cs_code_cmp)

/* undef-last for comparator mode:
A comparator is opaque: csort can't see which column it keys on, so it
can't read undef-ness off the data the way column mode does.  Instead we
probe each row once, comparing it against itself; a comparator that reads
an undef value raises an "uninitialized" warning (or dies, under fatal
warnings).  We trap that here.  Rows that trip it are moved to the end (in
stable order); the rest are sorted normally and never see an undef, so the
user's comparator runs cleanly even under `use warnings FATAL => 'all'`.

__cs_uninit_catcher is installed as $SIG{__WARN__} for the probe only; it
flags $Stats::LikeR::_cs_uninit on an uninitialized warning and passes any
other warning through.  (Both the flag and catcher are interpreter-local.)*/
XS(cs_uninit_catcher);
XS(cs_uninit_catcher) {
	dXSARGS;
	if (items >= 1) {
		STRLEN l;
		const char *m = SvPV(ST(0), l);
		if (strstr(m, "uninitialized"))
			sv_setiv(get_sv("Stats::LikeR::_cs_uninit", GV_ADD), 1);
		else
			warn("%s", m);		//pass unrelated warnings through
	}
	XSRETURN_EMPTY;
}

static bool cs_row_touches_undef(pTHX_ cs_code_ctx *c, size_t i) {
	sv_setsv(c->a_sv, c->rows[i]);
	sv_setsv(c->b_sv, c->rows[i]);

	SV *flag = get_sv("Stats::LikeR::_cs_uninit", GV_ADD);
	sv_setiv(flag, 0);
	CV *catcher = get_cv("Stats::LikeR::__cs_uninit_catcher", 0);

	dSP;
	ENTER;
	SAVETMPS;
	if (catcher) {
		/*install our $SIG{__WARN__} for the probe; the save stack restores
		the previous hook (and frees ours) on LEAVE *and* on croak-unwind*/
		SAVESPTR(PL_warnhook);
		PL_warnhook = newRV_inc((SV *)catcher);
		SAVEFREESV(PL_warnhook);
	}
	PUSHMARK(SP);
	int count = call_sv((SV *)c->cv, G_SCALAR | G_NOARGS | G_EVAL);
	SPAGAIN;
	if (count) (void)POPs;
	PUTBACK;

	bool undef = SvTRUE(flag) ? 1 : 0;
	if (SvTRUE(ERRSV)) {
		STRLEN el;
		const char *em = SvPV(ERRSV, el);
		if (strstr(em, "uninitialized")) {
			undef = 1;
			sv_setsv(ERRSV, &PL_sv_no);	//clear $@
		} else {/*a genuine error from the comparator: propagate it verbatim.
			croak reads the string now; the die unwinds the save stack,
			which restores PL_warnhook for us.*/
			croak("%s", em);
		}
	}
	FREETMPS;
	LEAVE;
	return undef;
}

static SV *cs_materialize(pTHX_ cs_shape out_shape, cs_shape in_shape,
                          AV *src_av,
                          SV **colkeys, AV **colavs,
                          size_t ncols, size_t *idx, size_t n) {
	if (out_shape == CS_AOA) {//output: AoA
		AV *out = newAV();
		if (n) av_extend(out, (SSize_t)n - 1);
		if (in_shape == CS_AOA) {
			//AoA -> AoA: reorder, sharing the original row arrayrefs
			for (size_t k = 0; k < n; k++) {
				SV **rp = av_fetch(src_av, (SSize_t)idx[k], 0);
				SV *row = (rp && *rp) ? *rp : &PL_sv_undef;
				av_push(out, SvREFCNT_inc_simple_NN(row));
			}
			return newRV_noinc((SV *)out);
		}
		if (in_shape == CS_HOA) {
			/*HoA -> AoA: positional rows ordered by sorted column-key name
			(hash iteration order is randomized, so sort for determinism)*/
			size_t *ord;
			Newx(ord, ncols ? ncols : 1, size_t);
			SAVEFREEPV(ord);
			for (size_t c = 0; c < ncols; c++) ord[c] = c;
			for (size_t a = 1; a < ncols; a++) {
				size_t o = ord[a];
				STRLEN al; const char *ap = SvPV_const(colkeys[o], al);
				SSize_t b = (SSize_t)a - 1;
				while (b >= 0) {
					STRLEN bl;
					const char *bp = SvPV_const(colkeys[ord[b]], bl);
					int cmp = memcmp(bp, ap, bl < al ? bl : al);
					if (cmp == 0) cmp = (bl > al) - (bl < al);
					if (cmp <= 0) break;
					ord[b + 1] = ord[b];
					b--;
				}
				ord[b + 1] = o;
			}
			for (size_t k = 0; k < n; k++) {
				AV *row = newAV();
				if (ncols) av_extend(row, (SSize_t)ncols - 1);
				for (size_t c = 0; c < ncols; c++) {
					SV **cp =
					        av_fetch(colavs[ord[c]], (SSize_t)idx[k], 0);
					av_push(row, (cp && *cp) ? newSVsv(*cp) : newSV(0));
				}
				av_push(out, newRV_noinc((SV *)row));
			}
			return newRV_noinc((SV *)out);
		}
		// AoH -> AoA: union of keys (first appearance) -> positional rows
		AV *keylist = (AV *)sv_2mortal((SV *)newAV());
		HV *seen    = (HV *)sv_2mortal((SV *)newHV());
		for (size_t i = 0; i < n; i++) {
			SV **rp = av_fetch(src_av, (SSize_t)i, 0);
			if (!(rp && *rp && SvROK(*rp) && SvTYPE(SvRV(*rp)) == SVt_PVHV))
				continue;
			HV *rh = (HV *)SvRV(*rp);
			HE *he;
			hv_iterinit(rh);
			while ((he = hv_iternext(rh))) {
				SV *ksv = hv_iterkeysv(he);
				if (!hv_exists_ent(seen, ksv, 0)) {
					(void)hv_store_ent(seen, ksv, newSViv(1), 0);
					av_push(keylist, newSVsv(ksv));
				}
			}
		}
		SSize_t nk = av_len(keylist) + 1;
		/*positional columns need a deterministic order: sort the union of
		keys by name (the keylist AV keeps them alive; korder just points)*/
		SV **korder;
		Newx(korder, (size_t)(nk > 0 ? nk : 1), SV *);
		SAVEFREEPV(korder);
		for (SSize_t c = 0; c < nk; c++) korder[c] = *av_fetch(keylist, c, 0);
		for (SSize_t a = 1; a < nk; a++) {
			SV *key = korder[a];
			STRLEN al; const char *ap = SvPV_const(key, al);
			SSize_t b = a - 1;
			while (b >= 0) {
				STRLEN bl; const char *bp = SvPV_const(korder[b], bl);
				int cmp = memcmp(bp, ap, bl < al ? bl : al);
				if (cmp == 0) cmp = (bl > al) - (bl < al);
				if (cmp <= 0) break;
				korder[b + 1] = korder[b];
				b--;
			}
			korder[b + 1] = key;
		}
		for (size_t k = 0; k < n; k++) {
			AV *row = newAV();
			if (nk > 0) av_extend(row, nk - 1);
			SV **rp = av_fetch(src_av, (SSize_t)idx[k], 0);
			HV *rh = (rp && *rp && SvROK(*rp)
			        && SvTYPE(SvRV(*rp)) == SVt_PVHV) ? (HV *)SvRV(*rp) : NULL;
			for (SSize_t c = 0; c < nk; c++) {
				SV *cell = NULL;
				if (rh) {
					HE *he = hv_fetch_ent(rh, korder[c], 0, 0);
					if (he) cell = HeVAL(he);
				}
				av_push(row, cell ? newSVsv(cell) : newSV(0));
			}
			av_push(out, newRV_noinc((SV *)row));
		}
		return newRV_noinc((SV *)out);
	}
	if (out_shape == CS_AOH) {//output: AoH
		AV *out = newAV();
		if (n) av_extend(out, (SSize_t)n - 1);

		if (in_shape == CS_AOH) {// AoH -> AoH: reorder, sharing the original row hashrefs */
			for (size_t k = 0; k < n; k++) {
				SV **rp = av_fetch(src_av, (SSize_t)idx[k], 0);
				SV *row = (rp && *rp) ? *rp : &PL_sv_undef;
				av_push(out, SvREFCNT_inc_simple_NN(row));
			}
			return newRV_noinc((SV *)out);
		}
		if (in_shape == CS_HOA) {
			//HoA -> AoH: synthesize one hashref per row (copied cells)
			for (size_t k = 0; k < n; k++) {
				HV *rh = newHV();
				for (size_t c = 0; c < ncols; c++) {
					SV **cp = av_fetch(colavs[c], (SSize_t)idx[k], 0);
					hv_store_ent(rh, colkeys[c],
					             (cp && *cp) ? newSVsv(*cp) : newSV(0), 0);
				}
				av_push(out, newRV_noinc((SV *)rh));
			}
			return newRV_noinc((SV *)out);
		}
		//AoA -> AoH: keys are the integer indices "0".."ncols-1"
		for (size_t k = 0; k < n; k++) {
			HV *rh = newHV();
			SV **rp = av_fetch(src_av, (SSize_t)idx[k], 0);
			AV *row = (rp && *rp && SvROK(*rp)
			        && SvTYPE(SvRV(*rp)) == SVt_PVAV) ? (AV *)SvRV(*rp) : NULL;
			for (size_t c = 0; c < ncols; c++) {
				SV **cp = row ? av_fetch(row, (SSize_t)c, 0) : NULL;
				char kb[24];
				int kl = snprintf(kb, sizeof kb, "%zu", c);
				(void)hv_store(rh, kb, (I32)kl,
				               (cp && *cp) ? newSVsv(*cp) : newSV(0), 0);
			}
			av_push(out, newRV_noinc((SV *)rh));
		}
		return newRV_noinc((SV *)out);
	}
	// output: HoA
	HV *out = newHV();
	if (in_shape == CS_HOA) {// HoA -> HoA: permute every column in lockstep (copied cells)
		for (size_t c = 0; c < ncols; c++) {
			AV *ncol = newAV();
			if (n) av_extend(ncol, (SSize_t)n - 1);
			for (size_t k = 0; k < n; k++) {
				SV **cp = av_fetch(colavs[c], (SSize_t)idx[k], 0);
				av_push(ncol, (cp && *cp) ? newSVsv(*cp) : newSV(0));
			}
			hv_store_ent(out, colkeys[c], newRV_noinc((SV *)ncol), 0);
		}
		return newRV_noinc((SV *)out);
	}
	if (in_shape == CS_AOA) {// AoA -> HoA: keys "0".."ncols-1", columns permuted (copied cells)
		for (size_t c = 0; c < ncols; c++) {
			AV *ncol = newAV();
			if (n) av_extend(ncol, (SSize_t)n - 1);
			for (size_t k = 0; k < n; k++) {
				SV **rp = av_fetch(src_av, (SSize_t)idx[k], 0);
				SV *cell = NULL;
				if (rp && *rp && SvROK(*rp)
				        && SvTYPE(SvRV(*rp)) == SVt_PVAV) {
					SV **cp = av_fetch((AV *)SvRV(*rp), (SSize_t)c, 0);
					if (cp && *cp) cell = *cp;
				}
				av_push(ncol, cell ? newSVsv(cell) : newSV(0));
			}
			char kb[24];
			int kl = snprintf(kb, sizeof kb, "%zu", c);
			(void)hv_store(out, kb, (I32)kl, newRV_noinc((SV *)ncol), 0);
		}
		return newRV_noinc((SV *)out);
	}
	/*AoH -> HoA: column set is the union of the rows' keys, ordered by
	first appearance; absent cells become undef.*/
	AV *keylist = (AV *)sv_2mortal((SV *)newAV());
	HV *seen    = (HV *)sv_2mortal((SV *)newHV());
	for (size_t i = 0; i < n; i++) {
		SV **rp = av_fetch(src_av, (SSize_t)i, 0);
		if (!(rp && *rp && SvROK(*rp) && SvTYPE(SvRV(*rp)) == SVt_PVHV))
			continue;
		HV *rh = (HV *)SvRV(*rp);
		HE *he;
		hv_iterinit(rh);
		while ((he = hv_iternext(rh))) {
			SV *ksv = hv_iterkeysv(he);
			if (!hv_exists_ent(seen, ksv, 0)) {
				(void)hv_store_ent(seen, ksv, newSViv(1), 0);
				av_push(keylist, newSVsv(ksv));
			}
		}
	}
	SSize_t nk = av_len(keylist) + 1;
	for (SSize_t c = 0; c < nk; c++) {
		SV *ksv = *av_fetch(keylist, c, 0);
		AV *ncol = newAV();
		if (n) av_extend(ncol, (SSize_t)n - 1);
		for (size_t k = 0; k < n; k++) {
			SV **rp = av_fetch(src_av, (SSize_t)idx[k], 0);
			SV *cell = NULL;
			if (rp && *rp && SvROK(*rp) && SvTYPE(SvRV(*rp)) == SVt_PVHV) {
				HE *he = hv_fetch_ent((HV *)SvRV(*rp), ksv, 0, 0);
				if (he) cell = HeVAL(he);
			}
			av_push(ncol, cell ? newSVsv(cell) : newSV(0));
		}
		hv_store_ent(out, ksv, newRV_noinc((SV *)ncol), 0);
	}
	return newRV_noinc((SV *)out);
}

#ifndef M_LN_SQRT_2PI
#define M_LN_SQRT_2PI 0.918938533204672741780329736406  //log(sqrt(2*pi))
#endif
#ifndef M_LN_2PI
#define M_LN_2PI      1.837877066409345483560659472811  //log(2*pi)
#endif
#ifndef DBL_MIN
#define DBL_MIN 2.2250738585072014e-308
#endif

/*Stirling's error  stirlerr(n) = log(n!) - log( sqrt(2*pi*n) * (n/e)^n )
(Catherine Loader 2000; same table + series R uses)*/
static NV bt_stirlerr(NV n) {
	static const NV S0 = 0.083333333333333333333;        //1/12
	static const NV S1 = 0.00277777777777777777778;      //1/360
	static const NV S2 = 0.00079365079365079365079365;   //1/1260
	static const NV S3 = 0.000595238095238095238095238;  //1/1680
	static const NV S4 = 0.0008417508417508417508417508; //1/1188
	static const NV halves[31] = {
		0.0, //0.0 (placeholder; unreachable here)
		0.1534264097200273452913848,  // 0.5
		0.0810614667953272582196702,  // 1.0
		0.0548141210519176538961390,  // 1.5
		0.0413406959554092940938221,  // 2.0
		0.03316287351993628748511048, // 2.5
		0.02767792568499833914878929, // 3.0
		0.02374616365629749597132920, // 3.5
		0.02079067210376509311152277, // 4.0
		0.01848845053267318523077934, // 4.5
		0.01664469118982119216319487, //5.0
		0.01513497322191737887351255, //5.5
		0.01387612882307074799874573, //6.0
		0.01281046524292022692424986, //6.5
		0.01189670994589177009505572, //7.0
		0.01110455975820691732662991, //7.5
		0.010411265261972096497478567, //8.0
		0.009799416126158803298389475, //8.5
		0.009255462182712732917728637, //9.0
		0.008768700134139385462952823, //9.5
		0.008330563433362871256469318, //10.0
		0.007934114564314020547248100, //10.5
		0.007573675487951840794972024, //11.0
		0.007244554301320383179543912, //11.5
		0.006942840107209529865664152, //12.0
		0.006665247032707682442354394, //12.5
		0.006408994188004207068439631, //13.0
		0.006171712263039457647532867, //13.5
		0.005951370112758847735624416, //14.0
		0.005746216513010115682023589, //14.5
		0.005554733551962801371038690  //15.0
	};
	NV nn;
	if (n <= 15.0) {
		nn = n + n;
		if (nn == nv_floor(nn)) return halves[(int)nn];
		return nv_lgamma(n + 1.0) - (n + 0.5) * nv_log(n) + n - M_LN_SQRT_2PI;
	}
	nn = n * n;
	if (n > 500.0) return (S0 - S1 / nn) / n;
	if (n >  80.0) return (S0 - (S1 - S2 / nn) / nn) / n;
	if (n >  35.0) return (S0 - (S1 - (S2 - S3 / nn) / nn) / nn) / n;
	return (S0 - (S1 - (S2 - (S3 - S4 / nn) / nn) / nn) / nn) / n;
}

/*Deviance term  bd0(x, np) = x*log(x/np) + np - x, summed as a Taylor series
when x is close to np to avoid catastrophic cancellation.*/
static NV bt_bd0(NV x, NV np) {
	if (np == 0.0) return 0.0; //unreachable: callers guarantee np > 0
	if (nv_fabs(x - np) < 0.1 * (x + np)) {
		NV v = (x - np) / (x + np);
		NV s = (x - np) * v;
		if (nv_fabs(s) < DBL_MIN) return s;
		NV ej = 2.0 * x * v;
		v *= v;
		for (int j = 1; ; j++) { //|v| < 0.1, so this converges quickly
			ej *= v;
			NV s1 = s + ej / (NV)(2 * j + 1);
			if (s1 == s) return s1;
			s = s1;
		}
	}
	return x * nv_log(x / np) + np - x;
}

/*Binomial PMF via R's dbinom_raw (q = 1 - p), in log form.  The plain form
below is exp() of this, so the two cannot drift apart; the log form is what
the hypergeometric density wants, since a term there can be 1e-178.*/
static NV bt_dbinom_raw_log(NV x, NV n, NV p, NV q) {
	if (p == 0.0) return (x == 0.0) ? 0.0 : -INFINITY;
	if (q == 0.0) return (x == n)   ? 0.0 : -INFINITY;
	if (x == 0.0) {
		if (n == 0.0) return 0.0;
		return (p < 0.1) ? -bt_bd0(n, n * q) - n * p : n * nv_log(q);
	}
	if (x == n) return (q < 0.1) ? -bt_bd0(n, n * p) - n * q : n * nv_log(p);
	if (x < 0.0 || x > n) return -INFINITY;
	NV lc = bt_stirlerr(n) - bt_stirlerr(x) - bt_stirlerr(n - x)
	      - bt_bd0(x, n * p) - bt_bd0(n - x, n * q);
	NV lf = M_LN_2PI + nv_log(x) + nv_log1p(-x / n); // better than log(n-x)-log(n) for x<<n
	return lc - 0.5 * lf;
}

static NV bt_dbinom_raw(NV x, NV n, NV p, NV q) {
	return nv_exp(bt_dbinom_raw_log(x, n, p, q));
}

static NV bt_dbinom(long x, long n, NV p) {
	if (x < 0 || x > n) return 0.0;
	return bt_dbinom_raw((NV)x, (NV)n, p, 1.0 - p);
}

//Lower tail P(X <= k) = I_{1-p}(n-k, k+1); upper P(X > k) = I_p(k+1, n-k)
static NV bt_pbinom_lower(long k, long n, NV p) {
	if (k < 0)  return 0.0;
	if (k >= n) return 1.0;
	return incbeta((NV)(n - k), (NV)(k + 1), 1.0 - p);
}
static NV bt_pbinom_upper(long k, long n, NV p) {
	if (k < 0)  return 1.0;
	if (k >= n) return 0.0;
	return incbeta((NV)(k + 1), (NV)(n - k), p);
}

/*Inverse regularized incomplete beta (R's qbeta): incbeta is monotone in x,
so safeguarded bisection converges to full double precision.

The stopping rule has to be relative, not absolute.  A Clopper-Pearson bound
is routinely far below 1 -- x = 1 success in n = 1e9 trials puts the lower
bound at 1e-12 -- and halting at an absolute width of 1e-15 leaves such a
bound with only four or five correct digits.  So bisect until the bracket is
narrow *relative* to where it sits, and stop early if the two ends become
adjacent doubles (the guard also terminates the walk down to a denormal
root, which no fixed iteration count would reach).  While lo is still 0 the
bracket halves geometrically, so a root k orders of magnitude below 1 is
reached in ~3.3k steps and then refined in ~53 more.*/
static NV bt_qbeta(NV alpha, NV a, NV b) {
	if (alpha <= 0.0) return 0.0;
	if (alpha >= 1.0) return 1.0;
	NV lo = 0.0, hi = 1.0, mid;
	for (unsigned short int i = 0; i < 1200; i++) {
		mid = 0.5 * (lo + hi);
		if (!(mid > lo && mid < hi)) break;	//lo and hi are neighbours
		if (incbeta(a, b, mid) < alpha) lo = mid; else hi = mid;
		if (hi - lo <= 1e-16 * hi) break;
	}
	return 0.5 * (lo + hi);
}

//Clopper-Pearson endpoints (R's p.L / p.U)
static NV bt_pL(NV alpha, long x, long n) {
	if (x == 0) return 0.0;
	return bt_qbeta(alpha, (NV)x, (NV)(n - x + 1));
}
static NV bt_pU(NV alpha, long x, long n) {
	if (x == n) return 1.0;
	return bt_qbeta(1.0 - alpha, (NV)(x + 1), (NV)(n - x));
}

// Validate one count argument: a nonnegative integer
static long bt_check_count(pTHX_ SV *sv, const char *what) {
	if (!sv || !SvOK(sv)) croak("binom_test: %s is undef", what);
	if (!looks_like_number(sv)) croak("binom_test: %s is not a number", what);
	NV v = SvNV(sv);
	NV r = nv_floor(v + 0.5);
	if (v < 0 || nv_fabs(v - r) > 1e-7)
		croak("binom_test: %s must be a nonnegative integer", what);
	return (long)r;
}
/*  Studentized range distribution (Tukey's) -- ptukey() / qtukey().

Faithful C port of R's src/nmath/{ptukey,qtukey}.c (Copenhaver &
Holland 1988), the exact algorithm underlying R's TukeyHSD.  The only
substitutions are approx_pnorm() for pnorm() (both are 0.5*erfc based,
so identical to machine precision) and the libc lgamma() for
lgammafn().  Internals are kept in plain double / long double exactly
as upstream so results are bit-faithful regardless of Perl's NV width.

  st_wprob(w, rr, cc)          integral of Hartley's range over (0,w)
  st_ptukey(q, rr, cc, df)     lower-tail P(range < q)
  st_qinv(p, c, v)             AS 70 initial estimate for the secant
  st_qtukey(p, rr, cc, df)     inverse of st_ptukey via secant method

rr = number of groups/ranges (1 for a single ANOVA factor),
cc = number of means, df = residual degrees of freedom.*/
static NV st_wprob(NV w, NV rr, NV cc)
{
#define TK_NLEG  12
#define TK_IHALF 6
	const double C1 = -30.0, C2 = -50.0, C3 = 60.0;
	const double bb = 8.0, wlar = 3.0, wincr1 = 2.0, wincr2 = 3.0;
	static const double xleg[TK_IHALF] = {
		0.981560634246719250690549090149,	0.904117256370474856678465866119,
		0.769902674194304687036893833213,	0.587317954286617447296702418941,
		0.367831498998180193752691536644,	0.125233408511468915472441369464
	};
	static const double aleg[TK_IHALF] = {
		0.047175336386511827194615961485,	0.106939325995318430960254718194,
		0.160078328543346226334652529543,	0.203167426723065921749064455810,
		0.233492536538354808760849898925,	0.249147045813402785000562436043
	};
	double a, ac, pr_w, b, binc, c, cc1,
		pminus, pplus, qexpo, qsqz, rinsum, wi, wincr, xx;
	long double blb, bub, einsum, elsum;
	int j, jj;

	qsqz = w * 0.5;
	if (qsqz >= bb) return 1.0;

	pr_w = 2.0 * approx_pnorm(qsqz) - 1.0;
	if (pr_w >= nv_exp(C2 / cc)) pr_w = nv_pow(pr_w, cc);
	else                      pr_w = 0.0;

	if (w > wlar) wincr = wincr1;
	else          wincr = wincr2;

	blb = qsqz;
	binc = (bb - qsqz) / wincr;
	bub = blb + binc;
	einsum = 0.0;
	cc1 = cc - 1.0;

	for (wi = 1; wi <= wincr; wi++) {
		elsum = 0.0;
		a = (double)(0.5 * (bub + blb));
		b = (double)(0.5 * (bub - blb));
		for (jj = 1; jj <= TK_NLEG; jj++) {
			if (TK_IHALF < jj) { j = (TK_NLEG - jj) + 1; xx = xleg[j - 1]; }
			else               { j = jj;                 xx = -xleg[j - 1]; }
			c = b * xx;
			ac = a + c;
			qexpo = ac * ac;
			if (qexpo > C3) break;
			pplus  = 2.0 * approx_pnorm(ac);
			pminus = 2.0 * approx_pnorm(ac - w);
			rinsum = (pplus * 0.5) - (pminus * 0.5);
			if (rinsum >= nv_exp(C1 / cc1)) {
				rinsum = (aleg[j - 1] * nv_exp(-(0.5 * qexpo))) * nv_pow(rinsum, cc1);
				elsum += rinsum;
			}
		}
		elsum *= (((2.0 * b) * cc) * M_1_SQRT_2PI);
		einsum += elsum;
		blb = bub;
		bub += binc;
	}
	pr_w += (double) einsum;
	if (pr_w <= nv_exp(C1 / rr)) return 0.0;
	pr_w = nv_pow(pr_w, rr);
	if (pr_w >= 1.0) return 1.0;
	return pr_w;
#undef TK_NLEG
#undef TK_IHALF
}

static NV st_ptukey(NV q, NV rr, NV cc, NV df){
#define TK_NLEGQ  16
#define TK_IHALFQ 8
	const double eps1 = -30.0, eps2 = 1.0e-14;
	const double dhaf = 100.0, dquar = 800.0, deigh = 5000.0, dlarg = 25000.0;
	const double ulen1 = 1.0, ulen2 = 0.5, ulen3 = 0.25, ulen4 = 0.125;
	static const double xlegq[TK_IHALFQ] = {
		0.989400934991649932596154173450,	0.944575023073232576077988415535,
		0.865631202387831743880467897712,	0.755404408355003033895101194847,
		0.617876244402643748446671764049,	0.458016777657227386342419442984,
		0.281603550779258913230460501460,	0.950125098376374401853193354250e-1
	};
	static const double alegq[TK_IHALFQ] = {
		0.271524594117540948517805724560e-1,	0.622535239386478928628438369944e-1,
		0.951585116824927848099251076022e-1,	0.124628971255533872052476282192,
		0.149595988816576732081501730547,	0.169156519395002538189312079030,
		0.182603415044923588866763667969,	0.189450610455068496285396723208
	};

	if (q <= 0.0) return 0.0;
	if (df < 2.0 || rr < 1.0 || cc < 2.0) return NAN;
	if (!nv_isfinite(q)) return 1.0;
	if (df > dlarg) return st_wprob(q, rr, cc);

	double ans, f2, f21, f2lf, ff4, otsum, qsqz, rotsum, t1, twa1, ulen, wprb;
	int i, j, jj;
	f2 = df * 0.5;
	f2lf = ((f2 * nv_log(df)) - (df * M_LN2)) - nv_lgamma(f2);
	f21 = f2 - 1.0;
	ff4 = df * 0.25;
	if      (df <= dhaf)  ulen = ulen1;
	else if (df <= dquar) ulen = ulen2;
	else if (df <= deigh) ulen = ulen3;
	else                  ulen = ulen4;
	f2lf += nv_log(ulen);
	ans = 0.0;

	for (i = 1; i <= 50; i++) {
		otsum = 0.0;
		twa1 = (2 * i - 1) * ulen;
		for (jj = 1; jj <= TK_NLEGQ; jj++) {
			if (TK_IHALFQ < jj) {
				j = jj - TK_IHALFQ - 1;
				t1 = (f2lf + (f21 * nv_log(twa1 + (xlegq[j] * ulen))))
					- (((xlegq[j] * ulen) + twa1) * ff4);
			} else {
				j = jj - 1;
				t1 = (f2lf + (f21 * nv_log(twa1 - (xlegq[j] * ulen))))
					+ (((xlegq[j] * ulen) - twa1) * ff4);
			}
			if (t1 >= eps1) {
				if (TK_IHALFQ < jj)
					qsqz = q * nv_sqrt(((xlegq[j] * ulen) + twa1) * 0.5);
				else
					qsqz = q * nv_sqrt(((-(xlegq[j] * ulen)) + twa1) * 0.5);
				wprb = st_wprob(qsqz, rr, cc);
				rotsum = (wprb * alegq[j]) * nv_exp(t1);
				otsum += rotsum;
			}
		}
		if (i * ulen >= 1.0 && otsum <= eps2) break;
		ans += otsum;
	}
	if (ans > 1.0) ans = 1.0;
	return ans;
#undef TK_NLEGQ
#undef TK_IHALFQ
}

static NV st_qinv(NV p, NV c, NV v)
{
	const double p0 = 0.322232421088,    q0 = 0.993484626060e-01;
	const double p1 = -1.0,              q1 = 0.588581570495;
	const double p2 = -0.342242088547,   q2 = 0.531103462366;
	const double p3 = -0.204231210125,   q3 = 0.103537752850;
	const double p4 = -0.453642210148e-04, q4 = 0.38560700634e-02;
	const double c1 = 0.8832, c2 = 0.2368, c3 = 1.214, c4 = 1.208, c5 = 1.4142;
	const double vmax = 120.0;
	double ps, qq, t, yi;

	ps = 0.5 - 0.5 * p;
	yi = nv_sqrt(nv_log(1.0 / (ps * ps)));
	t = yi + (((( yi * p4 + p3) * yi + p2) * yi + p1) * yi + p0)
		/ (((( yi * q4 + q3) * yi + q2) * yi + q1) * yi + q0);
	if (v < vmax) t += (t * t * t + t) / v / 4.0;
	qq = c1 - c2 * t;
	if (v < vmax) qq += -c3 / v + c4 * t / v;
	return t * (qq * nv_log(c - 1.0) + c5);
}

static NV st_qtukey(NV p, NV rr, NV cc, NV df)
{
	const double eps = 0.0001;
	double ans = 0.0, valx0, valx1, x0, x1, xabs;

	if (df < 2.0 || rr < 1.0 || cc < 2.0) return NAN;
	if (p <= 0.0) return 0.0;
	if (p >= 1.0) return INFINITY;

	x0 = st_qinv(p, cc, df);
	valx0 = st_ptukey(x0, rr, cc, df) - p;
	if (valx0 > 0.0) x1 = nv_fmax(0.0, x0 - 1.0);
	else             x1 = x0 + 1.0;
	valx1 = st_ptukey(x1, rr, cc, df) - p;

	for (unsigned short iter = 1; iter < 50; iter++) {
		ans = x1 - ((valx1 * (x1 - x0)) / (valx1 - valx0));
		valx0 = valx1;
		x0 = x1;
		if (ans < 0.0) { ans = 0.0; valx1 = -p; }
		valx1 = st_ptukey(ans, rr, cc, df) - p;
		x1 = ans;
		xabs = nv_fabs(x1 - x0);
		if (xabs < eps) return ans;
	}
	return ans; //did not converge in maxiter; best estimate
}

/*Shared engines for the set-operation XSUBs. Each pushes its result list
(or a single count in scalar context) onto the Perl stack and returns the
updated stack pointer, so callers use:  sp = helper(aTHX_ sp, ...);
XPUSHs/EXTEND operate on the local `sp`, hence the in/out pointer.*/

/*Backs is_equivalent(). Returns 1 iff all `nrefs` array refs share one
distinct-value set (multiplicity/order ignored), matching List::Compare's
is_LequivalentR() generalised to N lists; else 0. Equivalence is transitive,
so each ref is checked against the distinct-value set of the FIRST ref:
ref i matches iff it holds no value outside that set (foreign key => 0) AND
covers every value in it (matched == ref_size). Single pass per array;
memory is the first ref's set plus one reusable per-ref dedup set.*/
static int set_equivalent(pTHX_ SV **args, size_t nrefs, const char *name) {
	HV *ref;   //distinct values of the first array ref
	AV *av;
	size_t len;
	IV ref_size;
	if (!(SvROK(args[0]) && SvTYPE(SvRV(args[0])) == SVt_PVAV))
		croak("%s: argument index 0 of %" UVuf " total (max index %" UVuf ") is not an array reference", name, (UV)nrefs, (UV)(nrefs - 1));
	ref = (HV*)sv_2mortal((SV*)newHV());
	av  = (AV*)SvRV(args[0]);
	len = (size_t)(av_len(av) + 1);
	for (size_t j = 0; j < len; j++) {
		SV **tv = av_fetch(av, j, 0);
		STRLEN klen; const char *key; I32 hklen;
		if (!(tv && SvOK(*tv)))
			croak("%s: undefined value at array ref index %" UVuf " (argument 0)", name, (UV)j);
		key   = SvPV(*tv, klen);
		hklen = SvUTF8(*tv) ? -(I32)klen : (I32)klen;
		(void)hv_store(ref, key, hklen, &PL_sv_undef, 0);
	}
	ref_size = (IV)HvUSEDKEYS(ref);
	for (size_t i = 1; i < nrefs; i++) {
		HV *seen; IV matched = 0;
		if (!(SvROK(args[i]) && SvTYPE(SvRV(args[i])) == SVt_PVAV))
			croak("%s: argument index %" UVuf " of %" UVuf " total (max index %" UVuf ") is not an array reference", name, (UV)i, (UV)nrefs, (UV)(nrefs - 1));
		av   = (AV*)SvRV(args[i]);
		len  = (size_t)(av_len(av) + 1);
		seen = (HV*)sv_2mortal((SV*)newHV());   //per-ref dedup
		for (size_t j = 0; j < len; j++) {
			SV **tv = av_fetch(av, j, 0);
			STRLEN klen; const char *key; I32 hklen;
			if (!(tv && SvOK(*tv)))
				croak("%s: undefined value at array ref index %" UVuf " (argument %" UVuf ")", name, (UV)j, (UV)i);
			key   = SvPV(*tv, klen);
			hklen = SvUTF8(*tv) ? -(I32)klen : (I32)klen;
			if (hv_exists(seen, key, hklen)) continue;   //already counted for this ref
			(void)hv_store(seen, key, hklen, &PL_sv_undef, 0);
			if (!hv_exists(ref, key, hklen)) return 0;   //value absent from first ref
			matched++;
		}
		if (matched != ref_size) return 0;              //first ref has a value this ref lacks
	}
	return 1;
}
/*Backs intersection(), Lonly() and Ronly(). For every distinct value it counts
how many of the input arrays contain it (per-array dedup via `loc`), building
the candidate list `order` from one chosen array in first-appearance order,
then emits the candidates whose count matches the wanted multiplicity:
  want_all != 0 -> count == nrefs (in every array: intersection)
  want_all == 0 -> count == 1     (in the chosen array and no other)
`from_last` picks which array supplies the candidates: the FIRST (0) for
intersection/Lonly, or the LAST (1) for Ronly. With want_all == 0 that makes
Lonly "only in the first array" and Ronly "only in the last array", so the
two-array Ronly(a,b) still equals Lonly(b,a). Every emitted value is present
in the chosen array, so drawing candidates from it is correct for all three.*/
static SV** set_multiplicity(pTHX_ SV **sp, SV **args, size_t nrefs,
                             bool want_all, bool from_last, const char *name, int gimme) {
	HV *count = (HV*)sv_2mortal((SV*)newHV());
	AV *order = (AV*)sv_2mortal((SV*)newAV());
	size_t n = 0, olen;
	IV want = want_all ? (IV)nrefs : 1;
	for (size_t i = 0; i < nrefs; i++) {
		SV *arg = args[i];
		HV *loc; AV *av; size_t len;
		if (!(SvROK(arg) && SvTYPE(SvRV(arg)) == SVt_PVAV))
			croak("%s: argument index %" UVuf " of %" UVuf " total (max index %" UVuf ") is not an array reference", name, (UV)i, (UV)nrefs, (UV)(nrefs - 1));
		av  = (AV*)SvRV(arg);
		len = (size_t)(av_len(av) + 1);
		loc = (HV*)sv_2mortal((SV*)newHV());   //per-ref dedup
		for (size_t j = 0; j < len; j++) {
			SV **tv = av_fetch(av, j, 0);
			STRLEN klen; const char *key; I32 hklen; SV **cv;
			if (!(tv && SvOK(*tv)))
				croak("%s: undefined value at array ref index %" UVuf " (argument %" UVuf ")", name, (UV)j, (UV)i);
			key   = SvPV(*tv, klen);
			hklen = SvUTF8(*tv) ? -(I32)klen : (I32)klen;
			if (hv_exists(loc, key, hklen)) continue;   //already counted for this ref
			(void)hv_store(loc, key, hklen, &PL_sv_undef, 0);
			cv = hv_fetch(count, key, hklen, 1);
			if (cv && *cv) sv_setiv(*cv, SvOK(*cv) ? SvIV(*cv) + 1 : 1);
			if (i == (from_last ? nrefs - 1 : 0))       //candidates: chosen ref only
				av_push(order, newSVsv(*tv));
		}
	}
	olen = (size_t)(av_len(order) + 1);
	for (size_t oi = 0; oi < olen; oi++) {
		SV **e = av_fetch(order, oi, 0);
		STRLEN klen; const char *key; I32 hklen; SV **cv;
		if (!(e && *e)) continue;
		key   = SvPV(*e, klen);
		hklen = SvUTF8(*e) ? -(I32)klen : (I32)klen;
		cv    = hv_fetch(count, key, hklen, 0);
		if (cv && *cv && SvIV(*cv) == want) {
			if (gimme != G_SCALAR) XPUSHs(sv_2mortal(newSVsv(*e)));
			n++;
		}
	}
	if (gimme == G_SCALAR) XPUSHs(sv_2mortal(newSVuv(n)));
	return sp;
}
/*pnorm helpers: normal CDF via Cody's rational approximation
Ported from R's src/nmath/pnorm.c (Cody 1969; "_both"/lower/upper/log_p
variants by Martin Maechler). The Cody approximation is a double-precision
algorithm -- R itself computes pnorm in double and the coefficients carry
only double precision -- so the core runs in `double` regardless of the NV width, and results match R to full double precision. The XS wrapper converts at the NV boundary.*/

#ifndef M_SQRT_32
#define M_SQRT_32     5.656854249492380195206754896838  //sqrt(32)
#endif
#ifndef M_1_SQRT_2PI
#define M_1_SQRT_2PI  0.398942280401432677939946059934  //1/sqrt(2*pi)
#endif

//d_2(x) == x/2, exactly; and R's do_del / swap_tail body macros.
#define pn_d2(_x_)  nv_ldexp(_x_, -1)
#define pn_do_del(X)                                                       \
	xsq = nv_ldexp(nv_trunc(nv_ldexp(X, 4)), -4);                               \
	del = (X - xsq) * (X + xsq);                                       \
	if (log_p) {                                                       \
		*cum = (-xsq * pn_d2(xsq)) - pn_d2(del) + nv_log(temp);       \
		if ((lower && x > 0.) || (upper && x <= 0.))               \
			*ccum = nv_log1p(-nv_exp(-xsq * pn_d2(xsq)) *            \
			              nv_exp(-pn_d2(del)) * temp);            \
	} else {                                                           \
		*cum  = nv_exp(-xsq * pn_d2(xsq)) * nv_exp(-pn_d2(del)) * temp;  \
		*ccum = 1.0 - *cum;                                        \
	}
#define pn_swap_tail                                                       \
	if (x > 0.) { temp = *cum; if (lower) *cum = *ccum; *ccum = temp; }

static void c_pnorm_both(double x, double *cum, double *ccum, int i_tail, bool log_p) {
	static const double a[5] = {
		2.2352520354606839287, 161.02823106855587881, 1067.6894854603709582,
		18154.981253343561249, 0.065682337918207449113
	};
	static const double b[4] = {
		47.20258190468824187, 976.09855173777669322,
		10260.932208618978205, 45507.789335026729956
	};
	static const double c[9] = {
		0.39894151208813466764, 8.8831497943883759412, 93.506656132177855979,
		597.27027639480026226, 2494.5375852903726711, 6848.1904505362823326,
		11602.651437647350124, 9842.7148383839780218, 1.0765576773720192317e-8
	};
	static const double d[8] = {
		22.266688044328115691, 235.38790178262499861, 1519.377599407554805,
		6485.558298266760755, 18615.571640885098091, 34900.952721145977266,
		38912.003286093271411, 19685.429676859990727
	};
	static const double p[6] = {
		0.21589853405795699, 0.1274011611602473639, 0.022235277870649807,
		0.001421619193227893466, 2.9112874951168792e-5, 0.02307344176494017303
	};
	static const double q[5] = {
		1.28426009614491121, 0.468238212480865118, 0.0659881378689285515,
		0.00378239633202758244, 7.29751555083966205e-5
	};
	double xden, xnum, temp, del, eps, xsq, y;
	unsigned int i;
	bool lower, upper;

	if (nv_isnan(x)) { *cum = *ccum = x; return; }

	eps = DBL_EPSILON * 0.5;
	lower = i_tail != 1;
	upper = i_tail != 0;

	y = nv_fabs(x);
	if (y <= 0.67448975) { //qnorm(3/4)
		if (y > eps) {
			xsq = x * x;
			xnum = a[4] * xsq;
			xden = xsq;
			for (i = 0; i < 3; ++i) {
				xnum = (xnum + a[i]) * xsq;
				xden = (xden + b[i]) * xsq;
			}
		} else xnum = xden = 0.0;
		temp = x * (xnum + a[3]) / (xden + b[3]);
		if (lower)  *cum  = 0.5 + temp;
		if (upper)  *ccum = 0.5 - temp;
		if (log_p) {
			if (lower)  *cum  = nv_log(*cum);
			if (upper)  *ccum = nv_log(*ccum);
		}
	} else if (y <= M_SQRT_32) { //0.674.. < |x| <= sqrt(32) ~= 5.657
		xnum = c[8] * y;
		xden = y;
		for (i = 0; i < 7; ++i) {
			xnum = (xnum + c[i]) * y;
			xden = (xden + d[i]) * y;
		}
		temp = (xnum + c[7]) / (xden + d[7]);
		pn_do_del(y);
		pn_swap_tail;
	} else if ((log_p && y < 1e170)
	           || (lower && -38.4674 < x && x < 8.2924)
	           || (upper && -8.2924  < x && x < 38.4674)) {
		//|x| in the (5.657, 37.5) region
		xsq = 1.0 / (x * x);
		xnum = p[5] * xsq;
		xden = xsq;
		for (i = 0; i < 4; ++i) {
			xnum = (xnum + p[i]) * xsq;
			xden = (xden + q[i]) * xsq;
		}
		temp = xsq * (xnum + p[4]) / (xden + q[4]);
		temp = (M_1_SQRT_2PI - temp) / y;
		pn_do_del(x);
		pn_swap_tail;
	} else { //large |x|: probs are 0 or 1
		if (x > 0) { *cum  = log_p ? 0.0 : 1.0; *ccum = log_p ? -INFINITY : 0.0; }
		else       { *cum  = log_p ? -INFINITY : 0.0; *ccum = log_p ? 0.0 : 1.0; }
	}
	return;
}

#undef pn_do_del
#undef pn_swap_tail
#undef pn_d2

//Scalar normal CDF. lower_tail / log_p as in R's pnorm(). sigma < 0 -> NaN.
static double c_pnorm(double x, double mu, double sigma, bool lower_tail, bool log_p) {
	double pp, cp;
#define PN_D__0 (log_p ? -INFINITY : 0.0)
#define PN_D__1 (log_p ? 0.0 : 1.0)
#define PN_DT_0 (lower_tail ? PN_D__0 : PN_D__1)
#define PN_DT_1 (lower_tail ? PN_D__1 : PN_D__0)
	if (nv_isnan(x) || nv_isnan(mu) || nv_isnan(sigma)) return x + mu + sigma;
	if (!nv_isfinite(x) && mu == x) return NAN; //x - mu = NaN
	if (sigma <= 0) {
		if (sigma < 0) return NAN;
		return (x < mu) ? PN_DT_0 : PN_DT_1; //sigma == 0
	}
	pp = (x - mu) / sigma;
	if (!nv_isfinite(pp)) return (x < mu) ? PN_DT_0 : PN_DT_1;
	x = pp;
	c_pnorm_both(x, &pp, &cp, (lower_tail ? 0 : 1), log_p);
	return lower_tail ? pp : cp;
#undef PN_D__0
#undef PN_D__1
#undef PN_DT_0
#undef PN_DT_1
}
/*anova() : sequential (Type-I) ANOVA table for a linear model, returned in
          the same shape as aov() in this module, OR an F-test comparison
          of two or more nested models (R's anova(m1, m2, ...) generic).

  my $tab = anova(\%data, 'yield ~ ctrl');            # one model  -> HashRef
  my $tab = anova(\%data, 'len ~ supp * dose');       # one model  -> HashRef
  my $cmp = anova(\%data, 'y ~ a', 'y ~ a + b');      # 2+ models  -> ArrayRef

---- single-model form (one formula) --------------------------------------
Input mirrors aov(): a Hash-of-Arrays (\%h, columns) or Array-of-Hashes
(\@a, rows), plus a formula string 'response ~ rhs'. The RHS understands
'+', ':' (interaction) and '*' (factorial expansion: a*b -> a + b + a:b,
a*b*c -> a + b + c + a:b + a:c + b:c + a:b:c). Bare string columns are
treated as factors and treatment-coded (first level = reference); numeric
columns and I(x^2) enter as single regressors. Interactions form the
product of their factors' coded columns, so factor:factor uses
(la-1)*(lb-1) columns exactly as R's treatment contrasts do.

The model is fit sequentially by Householder QR (apply_householder_aov)
and the model SS is decomposed term by term, in formula order (Type I).
Collinear / rank-deficient terms gracefully receive 0 df and 0 Sum Sq.
Rows with any missing / non-numeric response or predictor are dropped
listwise (R's default na.omit).

Returns a HashRef keyed by term name (plus "Residuals"); each value is a
nested hash using R's column names:
    term        => { Df, "Sum Sq", "Mean Sq", "F value", "Pr(>F)" }
    Residuals   => { Df, "Sum Sq", "Mean Sq" }
"Mean Sq"/"F value"/"Pr(>F)" are omitted where undefined (0-df terms; the
Residuals row never carries an F test), matching aov()'s output.

---- model-comparison form (two or more formulas) -------------------------
anova(\%data, 'y ~ a', 'y ~ a + b', ...) fits every model and returns an
ArrayRef with one HashRef per model, in the order supplied, mirroring R's
anova(m1, m2, ...) table (columns Res.Df, RSS, Df, Sum of Sq, F, Pr(>F)):
    [ { "Res.Df", "RSS", formula },
      { "Res.Df", "RSS", "Df", "Sum of Sq", "F", "Pr(>F)", formula }, ... ]
The first row carries no comparison stats (nothing precedes it). For each
later row: Df = drop in residual df from the previous model, "Sum of Sq" =
drop in RSS, and F = ("Sum of Sq"/Df) / scale, where scale is the residual
mean square of the *largest* model in the set (smallest residual df) --
the common denominator R uses for the whole table. "F"/"Pr(>F)" are omitted
for any row whose Df is not positive (non-nested / equal-size steps).

All models are fit on ONE shared row set: completeness is evaluated
listwise over the UNION of every response and predictor across every
formula, so the fits are always mutually comparable (unlike R, which fits
each model on its own na.omit and then errors if the sizes disagree).

This form performs the F-test only. R's Chisq/LRT variant would need a
chi-square CDF; it can be layered on later behind a test option.

Depends on: parse_formula(), apply_householder_aov(), pf(),
evaluate_term(), is_column_categorical(), get_data_string_alloc().*/

/*A factor token may be treated as categorical only when it is a plain
column name (no ':' interaction, no 'I(...)' / '^' transform).*/
static bool anova_is_bare(const char *t) {
	return !(strchr(t, ':') || strchr(t, '(') || strchr(t, '^'));
}

/*First-appearance distinct string levels of a bare column over the rows
flagged complete[]. Returns count; *out gets a malloc'd array of savepv'd
strings (caller frees each + the array).*/
static size_t anova_levels(pTHX_ HV *hoa, HV **rows, size_t n,
		const bool *complete, const char *var, char ***out) {
	char **lv = NULL;
	size_t cnt = 0, cap = 0;
	for (size_t i = 0; i < n; i++) {
		if (!complete[i]) continue;
		char *s = get_data_string_alloc(aTHX_ hoa, rows, i, var);
		if (!s) continue;
		bool seen = FALSE;
		for (size_t j = 0; j < cnt; j++)
			if (strcmp(lv[j], s) == 0) { seen = TRUE; break; }
		if (seen) { Safefree(s); continue; }
		if (cnt == cap) { cap = cap ? cap * 2 : 4; Renew(lv, cap, char*); }
		lv[cnt++] = s;
	}
	*out = lv;
	return cnt;
}

/*Split str on separator `sep` at parenthesis depth 0. Returns a malloc'd
array of savepv'd, whitespace-trimmed tokens; empty tokens are dropped.*/
static char** anova_split0(pTHX_ const char *str, char sep, size_t *cnt) {
	char **out = NULL;
	size_t n = 0, cap = 0, depth = 0;
	const char *start = str, *p = str;
	for (;; p++) {
		if (*p == '(') depth++;
		else if (*p == ')') { if (depth) depth--; }
		if ((*p == sep && depth == 0) || *p == '\0') {
			const char *a = start, *b = p;
			while (a < b && isspace((unsigned char)*a)) a++;
			while (b > a && isspace((unsigned char)b[-1])) b--;
			if (b > a) {
				if (n == cap) { cap = cap ? cap * 2 : 4; Renew(out, cap, char*); }
				out[n++] = savepvn(a, (STRLEN)(b - a));
			}
			start = p + 1;
		}
		if (*p == '\0') break;
	}
	*cnt = n;
	return out;
}

//Does s contain char c at paren depth 0?
static int anova_has0(const char *s, char c) {
	size_t d = 0;
	for (; *s; s++) {
		if (*s == '(') d++;
		else if (*s == ')') { if (d) d--; }
		else if (*s == c && d == 0) return 1;
	}
	return 0;
}

// Join f[idx[0..m-1]] with ':' into a fresh savemalloc'd string
static char* anova_joinf(pTHX_ char **f, const size_t *idx, size_t m) {
	size_t len = 0;
	for (size_t i = 0; i < m; i++) len += strlen(f[idx[i]]) + 1;
	char *out = (char*)safemalloc(len + 1);
	out[0] = '\0';
	for (size_t i = 0; i < m; i++) { if (i) strcat(out, ":"); strcat(out, f[idx[i]]); }
	return out;
}

typedef struct { char **factors; size_t *fi; size_t nf; char *name; size_t width, start; } AnTerm;
typedef struct { char *name; bool is_cat; size_t width, nlv; NV *col; char **lv; } AnFac;

/*Append a term built from f[idx[0..m-1]] unless a term with the same
canonical name already exists (R merges duplicate terms).*/
static void anova_term_add(pTHX_ AnTerm **tp, size_t *np,
		size_t *cp, char **f, const size_t *idx, size_t m) {
	char *name = anova_joinf(aTHX_ f, idx, m);
	for (size_t i = 0; i < *np; i++)
		if (strcmp((*tp)[i].name, name) == 0) { Safefree(name); return; }
	if (*np == *cp) { *cp = *cp ? *cp * 2 : 8; Renew(*tp, *cp, AnTerm); }
	AnTerm *t = &(*tp)[*np];
	t->nf = m; t->name = name; t->width = 0; t->start = 0; t->fi = NULL;
	Newx(t->factors, m, char*);
	for (size_t i = 0; i < m; i++) t->factors[i] = savepv(f[idx[i]]);
	(*np)++;
}

static void anova_free_terms(pTHX_ AnTerm *t, size_t n) {
	if (!t) return;
	for (size_t i = 0; i < n; i++) {
		for (size_t j = 0; j < t[i].nf; j++) Safefree(t[i].factors[j]);
		Safefree(t[i].factors);	Safefree(t[i].fi);	Safefree(t[i].name);
	}
	Safefree(t);
}

static void anova_free_facs(pTHX_ AnFac *f, size_t n) {
	if (!f) return;
	for (size_t i = 0; i < n; i++) {
		Safefree(f[i].name);
		Safefree(f[i].col);
		if (f[i].lv) {
			for (size_t j = 0; j < f[i].nlv; j++) Safefree(f[i].lv[j]);
			Safefree(f[i].lv);
		}
	}
	Safefree(f);
}

/*Free the parsed lhs/rhs pairs produced by parse_formula for the multi-model
form (parse_formula allocates with the safefree-compatible allocator, the
same convention the single-model path frees under). Tolerates NULL slots so
it is safe to call after a partial parse.*/
static void anova_free_formulas(pTHX_ char **lhss, char **rhss, size_t nf) {
	if (lhss) for (size_t i = 0; i < nf; i++) if (lhss[i]) safefree(lhss[i]);
	if (rhss) for (size_t i = 0; i < nf; i++) if (rhss[i]) safefree(rhss[i]);
	Safefree(lhss); Safefree(rhss);
}

//Find-or-add a factor token in the registry; classifies on insertion.
static size_t anova_fac(pTHX_ AnFac **fp, size_t *np, size_t *cp,
		HV *hoa, HV **rows, size_t n, const char *name) {
	for (size_t i = 0; i < *np; i++) if (strcmp((*fp)[i].name, name) == 0) return i;
	if (*np == *cp) { *cp = *cp ? *cp * 2 : 8; Renew(*fp, *cp, AnFac); }
	AnFac *f = &(*fp)[*np];
	f->name  = savepv(name);
	f->is_cat = anova_is_bare(name) && is_column_categorical(aTHX_ hoa, rows, n, name);
	f->width = 0; f->nlv = 0; f->col = NULL; f->lv = NULL;
	return (*np)++;
}

/*Expand a formula RHS string into ordered, de-duplicated terms, appending to
*tp (with count *np / capacity *cp). Understands '+', ':' and the '*'
factorial expansion. Shared by the single-model table path and the
per-model fitter below so both parse identically.*/
static void anova_expand_rhs(pTHX_ const char *rhs,
		AnTerm **tp, size_t *np, size_t *cp) {
	size_t nsum;
	char **sum = anova_split0(aTHX_ rhs, '+', &nsum);
	for (size_t si = 0; si < nsum; si++) {
		char *s = sum[si];
		if (!strcmp(s, "1") || !strcmp(s, "0") || !strcmp(s, "-1")) continue;
		if (anova_has0(s, '*')) {
			size_t k;
			char **fk = anova_split0(aTHX_ s, '*', &k);
			for (size_t sz = 1; sz <= k; sz++) {
				size_t *idx; Newx(idx, sz, size_t);
				for (size_t i = 0; i < sz; i++) idx[i] = i;
				for (;;) {
					anova_term_add(aTHX_ tp, np, cp, fk, idx, sz);
					long i = (long)sz - 1;
					while (i >= 0 && idx[i] == k - sz + (size_t)i) i--;
					if (i < 0) break;
					idx[i]++;
					for (size_t j = (size_t)i + 1; j < sz; j++) idx[j] = idx[j-1] + 1;
				}
				Safefree(idx);
			}
			for (size_t j = 0; j < k; j++) Safefree(fk[j]);
			Safefree(fk);
		} else if (anova_has0(s, ':')) {
			size_t k;
			char **fk = anova_split0(aTHX_ s, ':', &k);
			size_t *idx; Newx(idx, k, size_t);
			for (size_t i = 0; i < k; i++) idx[i] = i;
			anova_term_add(aTHX_ tp, np, cp, fk, idx, k);
			Safefree(idx);
			for (size_t j = 0; j < k; j++) Safefree(fk[j]);
			Safefree(fk);
		} else {
			char *one[1]; size_t z = 0; one[0] = s;
			anova_term_add(aTHX_ tp, np, cp, one, &z, 1);
		}
	}
	for (size_t si = 0; si < nsum; si++) Safefree(sum[si]);
	Safefree(sum);
}

/*Fit a single model `lhs ~ rhs` on the shared complete-case row set
(ridx[0..n_used-1]) and report its residual SS and model rank. Builds its
own term/factor registries and design matrix, runs the sequential QR, then
frees all of its own scratch. Returns 1 on success, 0 if the RHS expands to
no predictor terms (caller croaks). Used only by the model-comparison form;
the single-model table path below is unchanged.*/
static int anova_fit_one(pTHX_ HV *hoa, HV **rows, size_t n,
		const bool *complete, const size_t *ridx, size_t n_used,
		const char *lhs, const char *rhs,
		NV *rss_out, size_t *rank_out) {
	AnTerm *terms = NULL;
	AnFac  *facs  = NULL;
	size_t nterms = 0, tcap = 0, nfac = 0, fcap = 0;

	anova_expand_rhs(aTHX_ rhs, &terms, &nterms, &tcap);
	if (nterms == 0) { anova_free_terms(aTHX_ terms, nterms); return 0; }

	//factor registry + per-term factor indices
	for (size_t t = 0; t < nterms; t++) {
		Newx(terms[t].fi, terms[t].nf, size_t);
		for (size_t j = 0; j < terms[t].nf; j++)
			terms[t].fi[j] = anova_fac(aTHX_ &facs, &nfac, &fcap, hoa, rows, n, terms[t].factors[j]);
	}

	// factor widths + coded columns (levels taken over the shared row set)
	for (size_t f = 0; f < nfac; f++) {
		if (facs[f].is_cat) {
			facs[f].nlv = anova_levels(aTHX_ hoa, rows, n, complete, facs[f].name, &facs[f].lv);
			facs[f].width = facs[f].nlv > 1 ? facs[f].nlv - 1 : 0;
		} else {
			facs[f].width = 1;
		}
		if (facs[f].width == 0) continue;
		Newx(facs[f].col, n_used * facs[f].width, NV);
		if (facs[f].is_cat) {
			for (size_t r = 0; r < n_used; r++) {
				char *sv = get_data_string_alloc(aTHX_ hoa, rows, ridx[r], facs[f].name);
				for (size_t j = 1; j < facs[f].nlv; j++)
					facs[f].col[r * facs[f].width + (j - 1)] =
						(sv && strcmp(sv, facs[f].lv[j]) == 0) ? 1.0 : 0.0;
				Safefree(sv);
			}
		} else {
			for (size_t r = 0; r < n_used; r++)
				facs[f].col[r] = evaluate_term(aTHX_ hoa, rows, (unsigned)ridx[r], facs[f].name);
		}
	}

	// term widths + design layout
	size_t p = 1;
	for (size_t t = 0; t < nterms; t++) {
		size_t w = 1;
		for (size_t j = 0; j < terms[t].nf; j++) w *= facs[terms[t].fi[j]].width;
		terms[t].width = w;
		terms[t].start = p;
		p += w;
	}
	// design matrix (intercept + term blocks)
	NV **X = NULL, *y = NULL;
	Newx(y, n_used, NV);
	Newx(X, n_used, NV*);
	for (size_t r = 0; r < n_used; r++) {
		Newx(X[r], p, NV);
		X[r][0] = 1.0;
		y[r] = evaluate_term(aTHX_ hoa, rows, (unsigned)ridx[r], lhs);
	}
	for (size_t t = 0; t < nterms; t++) {
		size_t w = terms[t].width;
		if (w == 0) continue;
		for (size_t r = 0; r < n_used; r++) {
			for (size_t c = 0; c < w; c++) {
				size_t rem = c; NV v = 1.0;
				for (size_t j = 0; j < terms[t].nf; j++) {
					AnFac *fj = &facs[terms[t].fi[j]];
					size_t d = rem % fj->width; rem /= fj->width;
					v *= fj->col[r * fj->width + d];
				}
				X[r][terms[t].start + c] = v;
			}
		}
	}

	//sequential QR (X, y overwritten in place) -> residual SS + rank
	bool   *aliased  = NULL;
	size_t *rank_map = NULL;
	Newx(aliased,  p, bool);
	Newx(rank_map, p, size_t);
	for (size_t k = 0; k < p; k++) rank_map[k] = 0;
	apply_householder_aov(X, y, n_used, p, aliased, rank_map);

	size_t rank = 0;
	for (size_t k = 0; k < p; k++) if (!aliased[k]) rank++;
	NV rss = 0.0;
	for (size_t r = rank; r < n_used; r++) rss += y[r] * y[r];

	*rss_out  = rss;
	*rank_out = rank;

	for (size_t r = 0; r < n_used; r++) Safefree(X[r]);
	Safefree(X); Safefree(y);	Safefree(aliased); Safefree(rank_map);
	anova_free_terms(aTHX_ terms, nterms);	anova_free_facs(aTHX_ facs, nfac);
	return 1;
}
/* rank() helpers: sort a small record carrying value, original index
 (among non-NA elements) and a random tie-break key*/
typedef struct {
	NV val; // numeric value
	IV idx; // 0-based index among non-NA elements
	NV rnd; // random tie-break key (ties.method => 'random')
} rank_pair;

// value ascending, ties broken by original index ascending
static int rank_cmp_idx_asc(const void *a, const void *b) {
	const rank_pair *pa = (const rank_pair *)a;
	const rank_pair *pb = (const rank_pair *)b;
	if (pa->val < pb->val) return -1;
	if (pa->val > pb->val) return  1;
	if (pa->idx < pb->idx) return -1;
	if (pa->idx > pb->idx) return  1;
	return 0;
}

// value ascending, ties broken by original index descending ('last')
static int rank_cmp_idx_desc(const void *a, const void *b) {
	const rank_pair *pa = (const rank_pair *)a;
	const rank_pair *pb = (const rank_pair *)b;
	if (pa->val < pb->val) return -1;
	if (pa->val > pb->val) return  1;
	if (pa->idx > pb->idx) return -1;
	if (pa->idx < pb->idx) return  1;
	return 0;
}

// value ascending, ties broken randomly ('random'); idx as final fallback
static int rank_cmp_rnd_asc(const void *a, const void *b) {
	const rank_pair *pa = (const rank_pair *)a;
	const rank_pair *pb = (const rank_pair *)b;
	if (pa->val < pb->val) return -1;
	if (pa->val > pb->val) return  1;
	if (pa->rnd < pb->rnd) return -1;
	if (pa->rnd > pb->rnd) return  1;
	if (pa->idx < pb->idx) return -1;
	if (pa->idx > pb->idx) return  1;
	return 0;
}

// ties.method codes
#define RANK_AVERAGE 0
#define RANK_FIRST   1
#define RANK_LAST    2
#define RANK_RANDOM  3
#define RANK_MAX     4
#define RANK_MIN     5

// na.last codes
#define NALAST_TRUE  0  // NAs get the highest ranks (default)
#define NALAST_FALSE 1  // NAs get the lowest ranks
#define NALAST_KEEP  2  // NAs stay undef, in place
#define NALAST_DROP  3  // NAs removed (R's na.last = NA)

/* Column verbs for Stats::LikeR -- fast, low-RAM paths for select_cols /
 drop_cols / rename_cols on the row-oriented shapes (AoH, HoH, AoA).

 INTEGRATION: paste the three `static` helpers below in with the other
 file-scope C helpers (above the existing `MODULE = Stats::LikeR` line), and
 paste the three XSUBs into the existing MODULE block. The `MODULE = ... `
 line here is a marker only -- drop it if you already have one, so it is not
 duplicated. Headers (EXTERN.h / perl.h / XSUB.h / ppport.h) are assumed to
 be present at the top of LikeR.xs already.

 These are PRIVATE (leading underscore) and are NOT added to @EXPORT_OK; the
 Perl wrappers in LikeR.pm validate their arguments and call them. All cell
 SVs are SHARED by refcount (like transpose), so results are shallow views:
 no per-cell copy (speed) and no duplicate scalar bodies (RAM). HoA is left
 to pure Perl in the wrapper (it just aliases whole column arrayrefs).

 Verified: compiles -O2 clean; correctness vs a pure-Perl reference across
 AoH/HoH/AoA incl. ragged + utf8 keys; SV sharing confirmed by address; and
 zero net live-SV growth over 20k build/free iterations on every path.*/

// shared inner-row builders (all SHARE cell SVs via refcount)

/* select: new inner HV holding keys[0..nkeys-1]; a present cell is shared, an
 absent one becomes a fresh mutable undef.  hash=0 lets hv normalise utf8.*/
static HV *row_select(pTHX_ HV *src, SV **keys, SSize_t nkeys) {
	HV *out = newHV();
	if (nkeys > 0) hv_ksplit(out, (IV)nkeys);
	for (SSize_t j = 0; j < nkeys; j++) {
		HE *e = src ? hv_fetch_ent(src, keys[j], 0, 0) : NULL;
		SV *val;
		if (e && HeVAL(e)) { val = HeVAL(e); SvREFCNT_inc_simple_void(val); }
		else               { val = newSV(0); }                 // absent -> undef
		(void)hv_store_ent(out, keys[j], val, 0);
	}
	return out;
}

/* drop: new inner HV = every source key not present in drop_hv; cells shared.
 The source entry's own key bytes/utf8/hash are reused (no re-hash, utf8-safe).*/
static HV *row_drop(pTHX_ HV *src, HV *drop_hv) {
	HV *out = newHV();
	if (!src) return out;
	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;
		if (hv_exists(drop_hv, kp, sk)) continue;
		SV *val = HeVAL(he); SvREFCNT_inc_simple_void(val);
		(void)hv_store(out, kp, sk, val, HeHASH(he));
	}
	return out;
}

/* rename: new inner HV; a key found in map_hv is re-labelled with the map's
 new-name SV (utf8-normalised), others keep their source key verbatim.*/
static HV *row_rename(pTHX_ HV *src, HV *map_hv) {
	HV *out = newHV();
	if (!src) return out;
	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 *val = HeVAL(he); SvREFCNT_inc_simple_void(val);
		SV **mp = hv_fetch(map_hv, kp, sk, 0);
		if (mp && *mp) (void)hv_store_ent(out, *mp, val, 0);
		else           (void)hv_store(out, kp, sk, val, HeHASH(he));
	}
	return out;
}

/* AoA select/keep: new inner AV of the given positions; cells shared, an
 out-of-range position becomes a fresh mutable undef.*/
static AV *rowA_select(pTHX_ AV *src, IV *idx, SSize_t n) {
	AV *out = newAV();
	if (n > 0) av_extend(out, n - 1);
	for (SSize_t j = 0; j < n; j++) {
		SV **ep = src ? av_fetch(src, idx[j], 0) : NULL;
		SV *val;
		if (ep && *ep) { val = *ep; SvREFCNT_inc_simple_void(val); }
		else           { val = newSV(0); }
		av_push(out, val);
	}
	return out;
}

/*merge() helpers -- full relational join (R merge / pandas merge).

The join reads its inputs where they lie.  A HoA frame is used column by
column and a row frame (AoH/HoH) row by row, so neither is transposed into
the other on the way in and the only cells copied are the ones the result
keeps.  Join keys match on the *stringified* cell value (canonical,
length-prefixed), the natural Perl hash-join semantics; an undef/missing
key cell never matches (pandas NaN rule).*/
#define MG_KEYSEP "\x1e"
#define MG_INNER 0
#define MG_LEFT  1
#define MG_RIGHT 2
#define MG_OUTER 3
#define MG_CROSS 4

/*An input frame, ready to be read cell by cell.  A HoA keeps its column
arrays; an AoH/HoH is an AV of row hashrefs, aliased rather than copied.
`names`/`seen` are the frame's column universe in first-seen order.*/
typedef struct {
	int      hoa;	// 1 = column-major (HoA)
	HV      *cols;	// hoa: the source hash of column array-refs
	AV      *rows;	// !hoa: mortal AV of row hashrefs
	SSize_t  nrows;
	AV      *names;// mortal AV of column-name SVs
	HV      *seen;	// mortal HV, name -> 1
} mg_frame;

/*One column of a frame, resolved once and then read by row index: the
column array for a HoA, the column name for a row frame.*/
typedef struct {
	AV *av; // hoa
	SV *name; // !hoa
} mg_col;

//Note a column name the first time it is seen.
static void mg_saw(pTHX_ mg_frame *f, SV *name) {
	if (hv_exists_ent(f->seen, name, 0)) return;
	(void)hv_store_ent(f->seen, name, newSViv(1), 0);
	av_push(f->names, newSVsv(name));
}

/*Validate a frame and describe it in *f.  Nothing is copied: an AoH/HoH
lends its rows, a HoA its columns.*/
static void
mg_prep(pTHX_ SV *frame, const char *side, mg_frame *f) {
	if (!frame || !SvROK(frame))
		croak("merge: %s frame must be an array-ref (AoH) or hash-ref (HoA/HoH)", side);
	SV *rv = SvRV(frame);
	f->hoa   = 0;
	f->cols  = NULL;
	f->rows  = (AV *)sv_2mortal((SV *)newAV());
	f->nrows = 0;
	f->names = (AV *)sv_2mortal((SV *)newAV());
	f->seen  = (HV *)sv_2mortal((SV *)newHV());

	if (SvTYPE(rv) == SVt_PVAV) {			//AoH
		AV *av = (AV *)rv;
		SSize_t n = av_len(av) + 1;
		for (SSize_t i = 0; i < n; i++) {
			SV *r = av_row_at(aTHX_ av, i);
			if (!r) {			//not a row hash: skip an empty slot, refuse the rest
				SV *bad = av_at(aTHX_ av, i);	//a value, not a slot: see av_slow_at
				if (!bad) continue;
				SvGETMAGIC(bad);
				if (!SvOK(bad)) continue;
				if (SvROK(bad) && SvTYPE(SvRV(bad)) == SVt_PVAV)
					croak("merge: %s frame is an array-of-arrays; merge needs "
					      "named columns (give it an AoH, HoA, or HoH)", side);
				croak("merge: %s frame row %ld is not a hash-ref (need an AoH)",
				      side, (long)i);
			}
			av_push(f->rows, av_row_keep(aTHX_ r));
			HE *e; hv_iterinit((HV *)SvRV(r));
			while ((e = hv_iternext((HV *)SvRV(r)))) mg_saw(aTHX_ f, hv_iterkeysv(e));
		}
		f->nrows = av_len(f->rows) + 1;
		return;
	}
	if (SvTYPE(rv) != SVt_PVHV)
		croak("merge: %s frame must be AoH/HoA/HoH", side);
	HV *hv = (HV *)rv;
	hv_iterinit(hv);
	HE *e0 = hv_iternext(hv);
	if (!e0) return;						//empty hash -> empty frame
	SV *v0 = HeVAL(e0);
	if (SvROK(v0) && SvTYPE(SvRV(v0)) == SVt_PVHV) {	//HoH: values are rows
		HE *e;
		hv_iterinit(hv);
		while ((e = hv_iternext(hv))) {
			SV *v = HeVAL(e);
			if (!SvROK(v) || SvTYPE(SvRV(v)) != SVt_PVHV)
				croak("merge: %s frame (HoH) value for row '%s' is not a hash-ref",
				      side, HePV(e, PL_na));
			av_push(f->rows, SvREFCNT_inc_simple_NN(v));
			HE *re; hv_iterinit((HV *)SvRV(v));
			while ((re = hv_iternext((HV *)SvRV(v)))) mg_saw(aTHX_ f, hv_iterkeysv(re));
		}
		f->nrows = av_len(f->rows) + 1;
		return;
	}
	if (!(SvROK(v0) && SvTYPE(SvRV(v0)) == SVt_PVAV))
		croak("merge: %s frame hash values must be array-refs (HoA) or hash-refs (HoH)", side);
	/*HoA: the columns are read where they are.  Row count is the longest
	column; a short one reads as undef past its end, as a transpose would
	have padded it.*/
	f->hoa  = 1;
	f->cols = hv;
	f->rows = NULL;
	HE *e;
	hv_iterinit(hv);
	while ((e = hv_iternext(hv))) {
		SV *v = HeVAL(e);
		if (!SvROK(v) || SvTYPE(SvRV(v)) != SVt_PVAV)
			croak("merge: %s frame (HoA) column '%s' is not an array-ref",
			      side, HePV(e, PL_na));
		SSize_t l = av_len((AV *)SvRV(v)) + 1;
		if (l > f->nrows) f->nrows = l;
		mg_saw(aTHX_ f, hv_iterkeysv(e));
	}
}

/*A shared-hash copy of a column name.  Every hv_fetch_ent/hv_store_ent that
uses it gets the key's hash for free (perl keeps it in the SV) and finds the
HEK already interned, which is worth having when the same dozen names are
looked up once per output row.*/
static SV *mg_shared(pTHX_ SV *name) {
	STRLEN l;
	const char *p = SvPV(name, l);
	return sv_2mortal(newSVpvn_share(p, SvUTF8(name) ? -(I32)l : (I32)l, 0));
}

//Resolve one column name against a frame, once, for the whole join.
static void
mg_resolve(pTHX_ const mg_frame *f, SV *name, mg_col *c) {
	c->av = NULL;
	c->name = mg_shared(aTHX_ name);
	if (!f->hoa) return;
	HE *e = hv_fetch_ent(f->cols, name, 0, 0);
	if (e && SvROK(HeVAL(e)) && SvTYPE(SvRV(HeVAL(e))) == SVt_PVAV)
		c->av = (AV *)SvRV(HeVAL(e));
}

/*The cell at (row, column), or NULL when the frame has none there.

A join reads every key cell of both frames and every cell of every column it
keeps, and up to 0.301 each of those was an av_fetch(): 7% of the 300,000-row
self-join in scale.pl.  av_at() is the same read without the out-of-line call,
and is where the tied-column case is handled.

f->rows is this call's own AV, built by mg_prep and never handed out, so it is
never the tied one; it goes through av_at() anyway rather than repeating the
test here.*/
PERL_STATIC_INLINE SV *
mg_cell(pTHX_ const mg_frame *f, const mg_col *c, SSize_t i) {
	if (f->hoa) return av_at(aTHX_ c->av, i);
	SV *r = av_at(aTHX_ f->rows, i);
	if (!r) return NULL;
	HE *e = hv_fetch_ent((HV *)SvRV(r), c->name, 0, 0);
	return e ? HeVAL(e) : NULL;
}

// Everything the result needs, resolved once before the join runs
typedef struct {
	const mg_frame *L, *R;
	mg_col  *lk, *rk;	// join key columns, nkeys of each
	mg_col  *lc, *rc;	// data columns, nlc / nrc of them
	SSize_t  nkeys, nlc, nrc;
	SV     **oname; // nkeys + nlc + nrc output names, in that order
	int      out_hoa;
} mg_join;

//0 = AoH, 1 = HoA, 2 = HoH (used only to pick the default output shape).
static int
mg_shape(pTHX_ SV *frame) {
	SV *rv = SvRV(frame);
	if (SvTYPE(rv) == SVt_PVAV) return 0;
	HV *hv = (HV *)rv;
	hv_iterinit(hv);
	HE *e = hv_iternext(hv);
	if (!e) return 1;
	SV *v = HeVAL(e);
	if (SvROK(v) && SvTYPE(SvRV(v)) == SVt_PVHV) return 2;
	return 1;
}

//Expand a scalar-or-arrayref option into a mortal AV of name SVs.
static AV *mg_names(pTHX_ SV *v) {
	AV *a = (AV *)sv_2mortal((SV *)newAV());
	if (SvROK(v) && SvTYPE(SvRV(v)) == SVt_PVAV) {
		AV *s = (AV *)SvRV(v);
		SSize_t n = av_len(s) + 1;
		for (SSize_t i = 0; i < n; i++) {
			SV **p = av_fetch(s, i, 0);
			av_push(a, newSVsv((p && *p) ? *p : &PL_sv_undef));
		}
	} else {
		av_push(a, newSVsv(v));
	}
	return a;
}

/*drop_duplicates() helpers -- row-level de-duplication for AoA / AoH / HoA.

A row's identity is a canonical, length-prefixed key over the subset
cells, exactly the hash-join semantics merge() uses (mg_key): two cells
are "the same" iff they stringify equally, an undef cell gets its own
sentinel that never collides with a real value (a real cell always opens
with a decimal length, the undef token opens with '~'). HoH is handled
entirely in the Perl wrapper (it dies) so there is no code path for it.

The keys are interned into one growable arena behind a small open-addressed
table instead of a Perl hash of per-row key SVs.  A row whose key is already
present rewinds the arena, so a pass costs one copy of each *distinct* key
plus ~40 bytes per distinct row -- not an SV, an HE, a HEK and a value SV
per input row, all of them alive at once.  Everything the pass allocates is
hung off a dd_ctx that a save-stack destructor releases, so a croak out of
an overloaded stringification cannot leak it.*/
typedef struct {
	char     *buf; // arena: the distinct keys, back to back
	size_t    len, cap;
	SSize_t  *off; //group -> key offset; off[ng] == len, so the key
	//length of group g is off[g + 1] - off[g]
	uint64_t *khash; // group -> key hash
	SSize_t  *first; // group -> row that created it (ascending in g)
	SSize_t  *cnt;   // group -> occurrences (kept only when use_cnt)
	bool      use_cnt;
	SSize_t   ng, gcap;
	SSize_t  *slot; // open addressing: slot -> group + 1, 0 = free
	size_t    nslot;    // always a power of two
	IV       *pos;  // AoA: subset column positions
	AV      **cols; // HoA: subset column arrays
	bool      fast_nv; // one nk_fast_nv_ok() answer, for the whole pass
} dd_ctx;

static void dd_ctx_free(pTHX_ void *p) {
	dd_ctx *T = (dd_ctx *)p;
	Safefree(T->buf);   Safefree(T->off);  Safefree(T->khash);
	Safefree(T->first); Safefree(T->cnt);  Safefree(T->slot);
	Safefree(T->pos);   Safefree(T->cols);
	Safefree(T);
}

/*64-bit key hash, eight bytes at a time (keys are long: every cell in them
carries its own length prefix and separators).*/
PERL_STATIC_INLINE uint64_t
dd_hash(const char *p, size_t n) {
	const uint64_t M1 = UINT64_C(0x9e3779b97f4a7c15),
	               M2 = UINT64_C(0xc2b2ae3d27d4eb4f);
	uint64_t h = M1 ^ (n * M2), k;
	for (; n >= 8; p += 8, n -= 8) {
		memcpy(&k, p, 8);
		k *= M1; k ^= k >> 47; k *= M2;
		h ^= k;  h *= M1;
	}
	k = 0;
	if (n) memcpy(&k, p, n);
	h ^= k * M2;
	h ^= h >> 32; h *= M2; h ^= h >> 29;
	return h;
}

//make room for `extra` more key bytes
PERL_STATIC_INLINE void
dd_reserve(pTHX_ dd_ctx *T, size_t extra) {
	if (T->len + extra > T->cap) {
		size_t want = T->cap ? T->cap * 2 : 4096;
		while (want < T->len + extra) want *= 2;
		Renew(T->buf, want, char);
		T->cap = want;
	}
}

//append one cell's rendered bytes to the key under construction, length-
//prefixed.  p must not point into T->buf: dd_reserve() can move the arena.
PERL_STATIC_INLINE void
dd_put(pTHX_ dd_ctx *T, const char *p, STRLEN l) {
	char nb[24], *np = nb + sizeof nb;
	size_t v = (size_t)l;
	do { *--np = (char)('0' + (v % 10)); v /= 10; } while (v);
	size_t nd = (size_t)(nb + sizeof nb - np);
	dd_reserve(aTHX_ T, l + nd + 2);
	char *w = T->buf + T->len;
	memcpy(w, np, nd);      w += nd;
	*w++ = MG_KEYSEP[0];
	memcpy(w, p, l);        w += l;
	*w++ = MG_KEYSEP[0];
	T->len = (size_t)(w - T->buf);
}


/*append one cell's canonical form to the key under construction.

SvGETMAGIC first: a tied array's element and a tied hash's value both arrive
here as an SV that has no value until mg_get() has run on it, and testing
SvOK() before that reported every cell of every tied frame as undef -- which,
undef having its own sentinel, made every row of such a frame the same row.*/
PERL_STATIC_INLINE void
dd_cell(pTHX_ dd_ctx *T, SV *c) {
	if (c) SvGETMAGIC(c);
	if (c && SvOK(c)) {
		STRLEN l;
		char numbuf[NK_NUMBUF];
		const char *p = nk_num_pv(c, numbuf, &l, T->fast_nv);
		if (!p) p = SvPV(c, l);       //before dd_reserve: may croak
		dd_put(aTHX_ T, p, l);
	} else {
		dd_reserve(aTHX_ T, 2);                      //undef sentinel
		T->buf[T->len++] = '~';
		T->buf[T->len++] = MG_KEYSEP[0];
	}
}

/*Size the group tables from the row count, which is known before the pass
starts and bounds the group count.  Growing them instead costs a rehash of
everything interned so far at each doubling -- nine of them on a frame of
10,000 distinct rows, each one a scattered walk over a table too big for L2.
Frames that turn out to be mostly duplicates would rather not pay for a slot
per row, so the hint is capped: past that, the doubling takes over again.*/
#define DD_PRESIZE_MAX (1 << 16)
static void dd_presize(pTHX_ dd_ctx *T, SSize_t R) {
	if (R < 64) return;                          //the default start is enough
	const SSize_t g = R < DD_PRESIZE_MAX ? R : DD_PRESIZE_MAX;
	size_t n = 64;
	while (n < (size_t)g * 2) n *= 2;
	Safefree(T->slot);
	Newxz(T->slot, n, SSize_t);                  //no groups yet: nothing to move
	T->nslot = n;
	Renew(T->off,   g + 1, SSize_t);
	Renew(T->khash, g,     uint64_t);
	Renew(T->first, g,     SSize_t);
	if (T->use_cnt) Renew(T->cnt, g, SSize_t);
	T->gcap = g;
}

//double the slot table and reinsert every group (hashes are already known)
static void dd_rehash(pTHX_ dd_ctx *T) {
	size_t n = T->nslot ? T->nslot * 2 : 64, mask = n - 1;
	Safefree(T->slot);
	Newxz(T->slot, n, SSize_t);
	T->nslot = n;
	for (SSize_t g = 0; g < T->ng; g++) {
		size_t i = (size_t)T->khash[g] & mask;
		while (T->slot[i]) i = (i + 1) & mask;
		T->slot[i] = g + 1;
	}
}

/*Intern the key just appended at buf[start .. len).  Returns its group; a key
already interned rewinds the arena, so only distinct keys are kept.  `row`
is recorded as the group's first occurrence when the group is new -- and
because groups are created in row order, first[] comes out sorted.*/
static SSize_t
dd_intern(pTHX_ dd_ctx *T, size_t start, SSize_t row) {
	const size_t n = T->len - start;
	const uint64_t h = dd_hash(T->buf + start, n);
	if ((T->ng + 1) * 2 >= (SSize_t)T->nslot) dd_rehash(aTHX_ T);
	const size_t mask = T->nslot - 1;
	size_t i = (size_t)h & mask;
	while (T->slot[i]) {
		const SSize_t g = T->slot[i] - 1;
		if (T->khash[g] == h && (size_t)(T->off[g + 1] - T->off[g]) == n
		    && memcmp(T->buf + T->off[g], T->buf + start, n) == 0) {
			T->len = start; // duplicate: drop the copy
			return g;
		}
		i = (i + 1) & mask;
	}
	if (T->ng + 2 > T->gcap) { // +2: off[] holds ng + 1
		SSize_t want = T->gcap ? T->gcap * 2 : 64;
		Renew(T->off,   want + 1, SSize_t);
		Renew(T->khash, want,     uint64_t);
		Renew(T->first, want,     SSize_t);
		if (T->use_cnt) Renew(T->cnt, want, SSize_t);
		T->gcap = want;
	}
	const SSize_t g = T->ng++;
	T->off[g]     = (SSize_t)start;
	T->off[g + 1] = (SSize_t)T->len;
	T->khash[g]   = h;
	T->first[g]   = row;
	if (T->use_cnt) T->cnt[g] = 0;
	T->slot[i]    = g + 1;
	return g;
}

/*merge()'s join index, probe and materialiser.

Up to 0.301 the index was a perl HV keyed by the join key and the join emitted
each output row as it found it.  The HV cost an HE, a shared HEK and an IV SV
per distinct key -- three allocations per right row when the key is unique --
and hv_fetch_ent() has no way of being told that a probe key is bytes nobody
will ever want again.  Emitting as it went cost more: the output row count is
not known until the probe has finished, so every output column grew by
av_push() and was reallocated its way up to the answer.

Both go away by splitting the join in two.  The index is the same
open-addressed table over a key arena that drop_duplicates() interns into
(dd_ctx: no SV, no HEK, one copy of each distinct key, and the same definition
of "the same key" in both functions).  The probe records (left row, right row)
pairs in a flat list rather than building anything, and only once that list is
complete -- so the row count is exact -- is each output column allocated at its
final size and filled straight into AvARRAY.

The list costs two SSize_t per output *row* against roughly one SV per output
*cell*, so it is a small fraction of the result on any join wide enough to
care, a cross join included.*/

/*Look up the key just appended at buf[start .. len) instead of interning it,
rewinding the arena either way: a probe pass leaves nothing behind, however
many rows it reads.  Returns the group, or -1 when the key is not in the
table.*/
static SSize_t dd_find(dd_ctx *T, size_t start) {
	const size_t n = T->len - start;
	const uint64_t h = dd_hash(T->buf + start, n);
	SSize_t found = -1;
	if (T->nslot) {
		const size_t mask = T->nslot - 1;
		size_t i = (size_t)h & mask;
		while (T->slot[i]) {
			const SSize_t g = T->slot[i] - 1;
			if (T->khash[g] == h && (size_t)(T->off[g + 1] - T->off[g]) == n
			    && memcmp(T->buf + T->off[g], T->buf + start, n) == 0) {
				found = g;
				break;
			}
			i = (i + 1) & mask;
		}
	}
	T->len = start;
	return found;
}

/*The join key of row `i` of frame `f`, appended to the arena at `start`.  The
canonical, length-prefixed form dd_cell() builds, so drop_duplicates() and
merge() agree on when two rows carry the same key -- except that a one-column
join writes the cell's bytes bare, there being nothing for a length prefix to
disambiguate when the key has only one field.  That is worth doing because it
is the common case and the prefix and its two separators are, on an integer
id, about as many bytes again to hash and to compare.

Returns FALSE with the arena rewound if any key cell is missing or undef: an
undef key matches nothing, which is pandas' NaN rule and what R's merge() does
under its default incomparables = NA.*/
static bool
mg_key(pTHX_ dd_ctx *T, const mg_frame *f, const mg_col *keys,
       SSize_t nkeys, SSize_t i, size_t start) {
	for (SSize_t j = 0; j < nkeys; j++) {
		SV *cell = mg_cell(aTHX_ f, &keys[j], i);
		if (!cell) { T->len = start; return FALSE; }
		/*av_fetch() on a tied column hands back a PVLV that has no value
		until FETCH has run, so testing SvOK() first read every cell of every
		tied frame as undef -- which, an undef key matching nothing, made
		merge() on one return no matched rows at all.*/
		SvGETMAGIC(cell);
		if (!SvOK(cell)) { T->len = start; return FALSE; }
		STRLEN l;
		char numbuf[NK_NUMBUF];
		const char *p = nk_num_pv(cell, numbuf, &l, T->fast_nv);
		if (!p) p = SvPV(cell, l);      //before dd_reserve: may croak
		if (nkeys == 1) {
			dd_reserve(aTHX_ T, l);
			if (l) memcpy(T->buf + T->len, p, l);
			T->len += l;
		} else dd_put(aTHX_ T, p, l);
	}
	return TRUE;
}

/*The (left row, right row) pairs a join comes down to, in output order; -1 on
either side is the half an outer join found nothing for.*/
typedef struct {
	SSize_t *pl;
	SSize_t *pr;
	SSize_t  n, cap;
} mg_pairs;

static void mg_pairs_free(pTHX_ void *p) {
	mg_pairs *P = (mg_pairs *)p;
	Safefree(P->pl);
	Safefree(P->pr);
	Safefree(P);
}

/*Room for `want` pairs.  The probe knows an upper bound for every join but the
cross one (nL for inner and left, nR for right, nL + nR for outer), so the list
is normally allocated once; the doubling below is what a cross join and a
one-to-many inner join grow by.*/
static void mg_pairs_reserve(pTHX_ mg_pairs *P, SSize_t want) {
	if (want <= P->cap) return;
	Renew(P->pl, want, SSize_t);
	Renew(P->pr, want, SSize_t);
	P->cap = want;
}

PERL_STATIC_INLINE void
mg_pair(pTHX_ mg_pairs *P, SSize_t li, SSize_t ri) {
	if (P->n == P->cap) mg_pairs_reserve(aTHX_ P, P->cap ? P->cap * 2 : 1024);
	P->pl[P->n] = li;
	P->pr[P->n] = ri;
	P->n++;
}

/*One output column, `np` cells long, taken from column `c` of frame `f` at row
`rows[t]` (-1 where the join had no row on that side).  A join key falls back
to the other side wherever this one has nothing, which is the coalesce both R
and pandas do; `af`/`ac`/`arows` describe that other side and are NULL for a
data column, which has none.

AvARRAY is filled directly and AvFILLp advanced behind it, the way filter()
builds its columns: the length is known before the first cell, so the array is
never grown and nothing is ever copied into a bigger one.  Nothing in the loop
can move it -- the array is not reachable from perl yet and av_extend() is not
called again -- while mg_cell() re-derives the *source* pointer per cell,
which copying a cell can invalidate.  Advancing AvFILLp per cell rather than
once at the end is what makes the array own the cells already written, so a
croak out of an overloaded stringification frees them with it.*/
static AV *
mg_column(pTHX_ SSize_t np,
          const mg_frame *f,  const mg_col *c,  const SSize_t *rows,
          const mg_frame *af, const mg_col *ac, const SSize_t *arows) {
	AV *o = (AV *)sv_2mortal((SV *)newAV());
	if (np <= 0) return o;
	av_extend(o, np - 1);
	SV **d = AvARRAY(o);
	for (SSize_t t = 0; t < np; t++) {
		const SSize_t r = rows[t];
		SV *v = (r >= 0) ? mg_cell(aTHX_ f, c, r) : NULL;
		if (af) {			//a join key: SvOK() decides, so run get magic
			if (v) SvGETMAGIC(v);
			if (!v || !SvOK(v)) {
				const SSize_t ar = arows[t];
				SV *w = (ar >= 0) ? mg_cell(aTHX_ af, ac, ar) : NULL;
				if (w) v = w;
			}
		}
		d[t] = v ? flt_cell_copy(aTHX_ v) : newSV(0);
		AvFILLp(o) = t;
	}
	return o;
}

/*The result, in whichever shape merge() was asked for.  Returns a new
reference to a mortal container, so a croak part-way through -- tied cell,
overloaded stringification -- takes the whole half-built frame with it.*/
static SV *
mg_build(pTHX_ const mg_join *J, const mg_pairs *P) {
	const SSize_t np = P->n;
	const SSize_t nu = J->nkeys + J->nlc + J->nrc;
	if (J->out_hoa) {
		HV *out = (HV *)sv_2mortal((SV *)newHV());
		hv_ksplit(out, (STRLEN)(nu > 0 ? nu : 1));
		SSize_t o = 0;
		for (SSize_t k = 0; k < J->nkeys; k++, o++)
			(void)hv_store_ent(out, J->oname[o], newRV_inc((SV *)
			    mg_column(aTHX_ np, J->L, &J->lk[k], P->pl,
			                        J->R, &J->rk[k], P->pr)), 0);
		for (SSize_t c = 0; c < J->nlc; c++, o++)
			(void)hv_store_ent(out, J->oname[o], newRV_inc((SV *)
			    mg_column(aTHX_ np, J->L, &J->lc[c], P->pl, NULL, NULL, NULL)), 0);
		for (SSize_t c = 0; c < J->nrc; c++, o++)
			(void)hv_store_ent(out, J->oname[o], newRV_inc((SV *)
			    mg_column(aTHX_ np, J->R, &J->rc[c], P->pr, NULL, NULL, NULL)), 0);
		return newRV_inc((SV *)out);
	}
	AV *rows = (AV *)sv_2mortal((SV *)newAV());
	if (np > 0) {
		av_extend(rows, np - 1);
		SV **d = AvARRAY(rows);
		for (SSize_t t = 0; t < np; t++) {
			const SSize_t li = P->pl[t], ri = P->pr[t];
			HV *row = newHV();
			hv_ksplit(row, (STRLEN)(nu > 0 ? nu : 1));	//no rehash mid-row
			d[t] = newRV_noinc((SV *)row);
			AvFILLp(rows) = t;	//owned from here, so a croak below frees it
			SSize_t o = 0;
			for (SSize_t k = 0; k < J->nkeys; k++, o++) {
				SV *v = (li >= 0) ? mg_cell(aTHX_ J->L, &J->lk[k], li) : NULL;
				if (v) SvGETMAGIC(v);	//SvOK() decides: see mg_column
				if ((!v || !SvOK(v)) && ri >= 0) {
					SV *w = mg_cell(aTHX_ J->R, &J->rk[k], ri);
					if (w) v = w;
				}
				(void)hv_store_ent(row, J->oname[o],
				                   v ? flt_cell_copy(aTHX_ v) : newSV(0), 0);
			}
			for (SSize_t c = 0; c < J->nlc; c++, o++) {
				SV *v = (li >= 0) ? mg_cell(aTHX_ J->L, &J->lc[c], li) : NULL;
				(void)hv_store_ent(row, J->oname[o],
				                   v ? flt_cell_copy(aTHX_ v) : newSV(0), 0);
			}
			for (SSize_t c = 0; c < J->nrc; c++, o++) {
				SV *v = (ri >= 0) ? mg_cell(aTHX_ J->R, &J->rc[c], ri) : NULL;
				(void)hv_store_ent(row, J->oname[o],
				                   v ? flt_cell_copy(aTHX_ v) : newSV(0), 0);
			}
		}
	}
	return newRV_inc((SV *)rows);
}

/*interpolate() numeric core.  Backs Stats::LikeR::_interp_column_xs, which
fills the undef gaps of one already-extracted column (an AV of numbers /
undef gaps / defined non-numeric barriers) in place.  A direct C port of the
former pure-Perl kernels (_interp_* in LikeR.pm); the per-method maths is
validated against pandas/scipy by t/interpolate*.t.  All scratch is Newx +
SAVEFREEPV so it is freed at the XSUB's LEAVE, on normal and croak exits.

kind[i]: 0 = undef gap (fillable), 1 = numeric anchor, 2 = defined non-numeric
barrier (preserved; blocks the piecewise-local fits, ignored by the fits).*/

#define IP_LINEAR   1   //interior fill rules
#define IP_NEAREST  2
#define IP_LEFT     3
#define IP_RIGHT    4
#define IP_EDGE_NONE  0 //leading/trailing hold rules
#define IP_EDGE_BOTH  1
#define IP_EDGE_LEFT  2
#define IP_EDGE_RIGHT 3
#define IP_KLINEAR 1    //fit-kernel types
#define IP_KCUBIC  2
#define IP_KQUAD   3
#define IP_KPCHIP  4
#define IP_KAKIMA  5
#define IP_KBARY   6

//largest i with xa[i] <= t, clamped to a valid interval [0, n-2]
static IV ip_seg(const NV *xa, IV n, NV t) {
	IV lo = 0, hi = n - 1;
	while (lo < hi) {
		IV mid = (lo + hi + 1) / 2;
		if (xa[mid] <= t) lo = mid; else hi = mid - 1;
	}
	if (lo > n - 2) lo = n - 2;
	if (lo < 0)     lo = 0;
	return lo;
}

/*dense Gaussian elimination with partial pivoting: solve A x = b (A row-major
n*n, both overwritten), writing the solution into out.  Croaks if singular.*/
static void ip_solve(pTHX_ NV *restrict A, NV *restrict b, IV n, NV *restrict out) {
	for (IV col = 0; col < n; col++) {
		IV piv = col; NV best = nv_fabs(A[col * n + col]);
		for (IV r = col + 1; r < n; r++) {
			NV a = nv_fabs(A[r * n + col]);
			if (a > best) { best = a; piv = r; }
		}
		if (piv != col) {
			for (IV k = 0; k < n; k++) {
				NV t = A[col * n + k]; A[col * n + k] = A[piv * n + k]; A[piv * n + k] = t;
			}
			NV t = b[col]; b[col] = b[piv]; b[piv] = t;
		}
		NV d = A[col * n + col];
		if (d == 0) croak("interpolate: singular system in spline solve");
		for (IV r = col + 1; r < n; r++) {
			NV f = A[r * n + col] / d;
			if (f == 0) continue;
			for (IV k = col; k < n; k++) A[r * n + k] -= f * A[col * n + k];
			b[r] -= f * b[col];
		}
	}
	for (IV i = n - 1; i >= 0; i--) {
		NV s = b[i];
		for (IV k = i + 1; k < n; k++) s -= A[i * n + k] * out[k];
		out[i] = s / A[i * n + i];
	}
}

/*nearest numeric anchor strictly below / above each index, or -1 across a
barrier or the edge (kind==2 resets the search; kind==0 leaves it running).*/
static void ip_prevnext(const char *restrict kind, IV n, IV *restrict prev,
                        IV *restrict next) {
	IV p = -1;
	for (IV i = 0; i < n; i++) {
		prev[i] = p;
		if (kind[i] == 1) p = i; else if (kind[i] == 2) p = -1;
	}
	IV q = -1;
	for (IV i = n - 1; i >= 0; i--) {
		next[i] = q;
		if (kind[i] == 1) q = i; else if (kind[i] == 2) q = -1;
	}
}

// Cox-de Boor B-spline basis B_{j,kk}(tv) over knot vector t (length nt)
static NV ip_bspline(const NV *t, IV nt, IV j, int kk, NV tv) {
	if (kk == 0) {
		if ((t[j] <= tv && tv < t[j + 1])
		 || (tv == t[nt - 1] && t[j] <= tv && tv <= t[j + 1])) return 1.0;
		return 0.0;
	}
	NV d1 = t[j + kk]     - t[j];
	NV d2 = t[j + kk + 1] - t[j + 1];
	NV c1 = d1 > 0 ? (tv - t[j]) / d1 * ip_bspline(t, nt, j, kk - 1, tv) : 0.0;
	NV c2 = d2 > 0 ? (t[j + kk + 1] - tv) / d2 * ip_bspline(t, nt, j + 1, kk - 1, tv) : 0.0;
	return c1 + c2;
}

// scipy PchipInterpolator's one-sided endpoint slope
static NV ip_pchip_edge(NV h0, NV h1, NV d0, NV d1) {
	NV d = ((2 * h0 + h1) * d0 - h0 * d1) / (h0 + h1);
	int sd = (d > 0) - (d < 0), s0 = (d0 > 0) - (d0 < 0), s1 = (d1 > 0) - (d1 < 0);
	if (sd != s0)                                        d = 0;
	else if (s0 != s1 && nv_fabs(d) > 3 * nv_fabs(d0))         d = 3 * d0;
	return d;
}

typedef struct {
	int type; // IP_K*
	IV  na;   // anchor count
	const NV *xa, *ya; // anchors (borrowed)
	NV *h; // spacings (cubic/pchip/akima)
	NV *M; // cubic second derivatives
	NV *d; // pchip slopes / akima tangents
	NV *w; // barycentric weights
	NV *knots, *coef; // quadratic B-spline
	IV  nknots;
} ip_fit;

//not-a-knot interpolating cubic spline (== scipy CubicSpline / interp1d cubic)
static void ip_build_cubic(pTHX_ ip_fit *F) {
	IV n = F->na; const NV *xa = F->xa, *ya = F->ya;
	Newx(F->h, n > 1 ? n - 1 : 1, NV); SAVEFREEPV(F->h);
	for (IV i = 0; i < n - 1; i++) F->h[i] = xa[i + 1] - xa[i];
	if (n <= 3) { F->M = NULL; return; }        //eval handles 2 / 3 directly
	NV *restrict A; Newxz(A, n * n, NV); SAVEFREEPV(A);
	NV *restrict b; Newxz(b, n, NV);     SAVEFREEPV(b);
	for (IV i = 1; i <= n - 2; i++) {
		A[i * n + (i - 1)] = F->h[i - 1];
		A[i * n + i]       = 2 * (F->h[i - 1] + F->h[i]);
		A[i * n + (i + 1)] = F->h[i];
		b[i] = 6 * ((ya[i + 1] - ya[i]) / F->h[i] - (ya[i] - ya[i - 1]) / F->h[i - 1]);
	}
	A[0]           = -F->h[1]; A[1] = F->h[0] + F->h[1]; A[2] = -F->h[0];
	A[(n - 1) * n + (n - 3)] = -F->h[n - 2];
	A[(n - 1) * n + (n - 2)] =  F->h[n - 3] + F->h[n - 2];
	A[(n - 1) * n + (n - 1)] = -F->h[n - 3];
	Newx(F->M, n, NV); SAVEFREEPV(F->M);
	ip_solve(aTHX_ A, b, n, F->M);
}
static NV ip_eval_cubic(const ip_fit *F, NV t) {
	IV n = F->na; const NV *xa = F->xa, *ya = F->ya, *h = F->h;
	if (n == 2) return ya[0] + (ya[1] - ya[0]) * (t - xa[0]) / h[0];
	if (n == 3)
		return ya[0] * (t - xa[1]) * (t - xa[2]) / ((xa[0] - xa[1]) * (xa[0] - xa[2]))
		     + ya[1] * (t - xa[0]) * (t - xa[2]) / ((xa[1] - xa[0]) * (xa[1] - xa[2]))
		     + ya[2] * (t - xa[0]) * (t - xa[1]) / ((xa[2] - xa[0]) * (xa[2] - xa[1]));
	IV i = ip_seg(xa, n, t);
	NV hi = h[i], A_ = (xa[i + 1] - t) / hi, B_ = (t - xa[i]) / hi;
	return A_ * ya[i] + B_ * ya[i + 1]
	     + ((A_ * A_ * A_ - A_) * F->M[i] + (B_ * B_ * B_ - B_) * F->M[i + 1]) * hi * hi / 6;
}

// degree-2 interpolating B-spline, scipy's midpoint interior knots
static void ip_build_quad(pTHX_ ip_fit *F) {
	IV n = F->na; const NV *xa = F->xa, *ya = F->ya; int k = 2;
	IV nk = n + 3, idx = 0;
	Newx(F->knots, nk, NV); SAVEFREEPV(F->knots);
	for (int r = 0; r < k + 1; r++)  F->knots[idx++] = xa[0];
	for (IV i = 1; i <= n - 3; i++)  F->knots[idx++] = (xa[i] + xa[i + 1]) / 2;
	for (int r = 0; r < k + 1; r++)  F->knots[idx++] = xa[n - 1];
	F->nknots = nk;
	IV m = nk - k - 1;                            //== n
	NV *A; Newxz(A, n * n, NV); SAVEFREEPV(A);
	NV *b; Newx(b, n, NV);      SAVEFREEPV(b);
	for (IV i = 0; i < n; i++) {
		for (IV j = 0; j < m; j++) A[i * n + j] = ip_bspline(F->knots, nk, j, k, xa[i]);
		b[i] = ya[i];
	}
	Newx(F->coef, m, NV); SAVEFREEPV(F->coef);
	ip_solve(aTHX_ A, b, n, F->coef);
}
static NV ip_eval_quad(const ip_fit *F, NV t) {
	IV m = F->na; NV s = 0;
	for (IV j = 0; j < m; j++) s += F->coef[j] * ip_bspline(F->knots, F->nknots, j, 2, t);
	return s;
}

// monotone piecewise cubic Hermite (Fritsch-Carlson; == scipy Pchip)
static void ip_build_pchip(pTHX_ ip_fit *F) {
	IV n = F->na; const NV *xa = F->xa, *ya = F->ya;
	Newx(F->h, n - 1, NV); SAVEFREEPV(F->h);
	NV *dk; Newx(dk, n - 1, NV); SAVEFREEPV(dk);
	for (IV i = 0; i < n - 1; i++) { F->h[i] = xa[i + 1] - xa[i]; dk[i] = (ya[i + 1] - ya[i]) / F->h[i]; }
	Newx(F->d, n, NV); SAVEFREEPV(F->d);
	if (n == 2) { F->d[0] = dk[0]; F->d[1] = dk[0]; return; }
	F->d[0]     = ip_pchip_edge(F->h[0], F->h[1], dk[0], dk[1]);
	F->d[n - 1] = ip_pchip_edge(F->h[n - 2], F->h[n - 3], dk[n - 2], dk[n - 3]);
	for (IV i = 1; i <= n - 2; i++) {
		if (dk[i - 1] * dk[i] <= 0) F->d[i] = 0;
		else {
			NV w1 = 2 * F->h[i] + F->h[i - 1], w2 = F->h[i] + 2 * F->h[i - 1];
			F->d[i] = (w1 + w2) / (w1 / dk[i - 1] + w2 / dk[i]);
		}
	}
}
static NV ip_eval_pchip(const ip_fit *F, NV t) {
	IV n = F->na; const NV *xa = F->xa, *ya = F->ya, *h = F->h, *d = F->d;
	IV i = ip_seg(xa, n, t); NV hi = h[i], s = (t - xa[i]) / hi, s2 = s * s, s3 = s2 * s;
	NV h00 = 2 * s3 - 3 * s2 + 1, h10 = s3 - 2 * s2 + s, h01 = -2 * s3 + 3 * s2, h11 = s3 - s2;
	return h00 * ya[i] + h10 * hi * d[i] + h01 * ya[i + 1] + h11 * hi * d[i + 1];
}

//Akima piecewise cubic (== scipy Akima1DInterpolator); needs >= 3 anchors
static void ip_build_akima(pTHX_ ip_fit *F) {
	IV n = F->na; const NV *xa = F->xa, *ya = F->ya;
	Newx(F->h, n - 1, NV); SAVEFREEPV(F->h);
	NV *m; Newx(m, n - 1, NV); SAVEFREEPV(m);
	for (IV i = 0; i < n - 1; i++) { F->h[i] = xa[i + 1] - xa[i]; m[i] = (ya[i + 1] - ya[i]) / F->h[i]; }
	NV *mm; Newx(mm, n + 3, NV); SAVEFREEPV(mm); // slopes extended two each side
	for (IV i = 0; i < n - 1; i++) mm[i + 2] = m[i];
	mm[1] = 2 * mm[2] - mm[3];
	mm[0] = 2 * mm[1] - mm[2];
	mm[n + 1] = 2 * mm[n]     - mm[n - 1];
	mm[n + 2] = 2 * mm[n + 1] - mm[n];
	Newx(F->d, n, NV); SAVEFREEPV(F->d); // tangents
	for (IV i = 0; i < n; i++) {
		NV m1 = mm[i], m2 = mm[i + 1], m3 = mm[i + 2], m4 = mm[i + 3];
		NV d1 = nv_fabs(m4 - m3), d2 = nv_fabs(m2 - m1);
		F->d[i] = (d1 + d2 == 0) ? (m2 + m3) / 2 : (d1 * m2 + d2 * m3) / (d1 + d2);
	}
}
static NV ip_eval_akima(const ip_fit *F, NV t) {
	IV n = F->na; const NV *xa = F->xa, *ya = F->ya, *h = F->h, *tk = F->d;
	IV i = ip_seg(xa, n, t); NV hi = h[i], s = t - xa[i];
	NV c2 = (3 * (ya[i + 1] - ya[i]) / hi - 2 * tk[i] - tk[i + 1]) / hi;
	NV c3 = (tk[i] + tk[i + 1] - 2 * (ya[i + 1] - ya[i]) / hi) / (hi * hi);
	return ya[i] + tk[i] * s + c2 * s * s + c3 * s * s * s;
}

// global interpolating polynomial in barycentric form (== scipy barycentric/krogh)
static void ip_build_bary(pTHX_ ip_fit *F) {
	IV n = F->na; const NV *xa = F->xa;
	Newx(F->w, n, NV); SAVEFREEPV(F->w);
	for (IV j = 0; j < n; j++) {
		NV wj = 1.0;
		for (IV k = 0; k < n; k++) if (k != j) wj /= (xa[j] - xa[k]);
		F->w[j] = wj;
	}
}
static NV ip_eval_bary(const ip_fit *F, NV t) {
	IV n = F->na; const NV *xa = F->xa, *ya = F->ya, *w = F->w;
	NV num = 0, den = 0;
	for (IV j = 0; j < n; j++) {
		if (t == xa[j]) return ya[j];
		NV c = w[j] / (t - xa[j]);
		num += c * ya[j]; den += c;
	}
	return num / den;
}

static NV ip_eval_linear(const ip_fit *F, NV t) {
	IV n = F->na; const NV *xa = F->xa, *ya = F->ya;
	IV i = ip_seg(xa, n, t);
	return ya[i] + (ya[i + 1] - ya[i]) * (t - xa[i]) / (xa[i + 1] - xa[i]);
}

static NV ip_eval(const ip_fit *F, NV t) {
	switch (F->type) {
		case IP_KLINEAR: return ip_eval_linear(F, t);
		case IP_KCUBIC:  return ip_eval_cubic(F, t);
		case IP_KQUAD:   return ip_eval_quad(F, t);
		case IP_KPCHIP:  return ip_eval_pchip(F, t);
		case IP_KAKIMA:  return ip_eval_akima(F, t);
		case IP_KBARY:   return ip_eval_bary(F, t);
	}
	return 0;
}

/*map a piecewise-local method name to its (interior rule, edge rule); returns
0 for the fit-based methods*/
static int ip_local_rule(const char *m, int *rule, int *edge) {
	if (!strcmp(m, "linear") || !strcmp(m, "index") || !strcmp(m, "values") || !strcmp(m, "time"))
		{ *rule = IP_LINEAR; *edge = IP_EDGE_BOTH; return 1; }
	if (!strcmp(m, "slinear")) { *rule = IP_LINEAR;  *edge = IP_EDGE_NONE;  return 1; }
	if (!strcmp(m, "nearest")) { *rule = IP_NEAREST; *edge = IP_EDGE_NONE;  return 1; }
	if (!strcmp(m, "zero"))    { *rule = IP_LEFT;    *edge = IP_EDGE_NONE;  return 1; }
	if (!strcmp(m, "pad") || !strcmp(m, "ffill"))    { *rule = IP_LEFT;  *edge = IP_EDGE_LEFT;  return 1; }
	if (!strcmp(m, "bfill") || !strcmp(m, "backfill")) { *rule = IP_RIGHT; *edge = IP_EDGE_RIGHT; return 1; }
	return 0;
}

/*pandas _interp_limit (readable form): mark every gap whose [i-fw .. i+bw]
window is entirely gaps*/
static void ip_far(const char *kind, IV n, IV fw, IV bw, char *pre) {
	for (IV i = 0; i < n; i++) {
		if (kind[i] != 0) continue;
		IV lo = i - fw; if (lo < 0) lo = 0;
		IV hi = i + bw; if (hi > n - 1) hi = n - 1;
		bool all = 1;
		for (IV k = lo; k <= hi; k++) if (kind[k] != 0) { all = 0; break; }
		if (all) pre[i] = 1;
	}
}

//fill the undef gaps of one column in place (see block header)
static void ip_fill_column(pTHX_ AV *vals, AV *xav, const char *method,
                           SV *order_sv, const char *dir, SV *limit_sv, SV *area_sv) {
	IV n = av_len(vals) + 1;
	if (n <= 0) return;

	NV  *x, *y; char *kind;
	Newx(x, n, NV);       SAVEFREEPV(x);
	Newx(y, n, NV);       SAVEFREEPV(y);
	Newx(kind, n, char);  SAVEFREEPV(kind);
	IV anchors = 0;
	for (IV i = 0; i < n; i++) {
		SV **xp = av_fetch(xav, i, 0);
		x[i] = (xp && *xp) ? SvNV(*xp) : 0;
		SV **vp = av_fetch(vals, i, 0);
		SV  *v  = (vp && *vp) ? *vp : NULL;
		if (!v || !SvOK(v))            kind[i] = 0; // gap
		else if (looks_like_number(v)) { kind[i] = 1; y[i] = SvNV(v); anchors++; } // anchor
		else                           kind[i] = 2; // barrier
	}
	if (anchors == 0) return;

	NV   *cand; Newx(cand, n, NV);   SAVEFREEPV(cand);
	char *has;  Newxz(has, n, char); SAVEFREEPV(has);

	int rule, edge;
	if (ip_local_rule(method, &rule, &edge)) {
		IV *prev, *next;
		Newx(prev, n, IV); SAVEFREEPV(prev);
		Newx(next, n, IV); SAVEFREEPV(next);
		ip_prevnext(kind, n, prev, next);
		for (IV i = 0; i < n; i++) {
			if (kind[i] != 0) continue;
			IV l = prev[i], r = next[i];
			if (l >= 0 && r >= 0) {
				NV vl = y[l], vr = y[r];
				if      (rule == IP_LINEAR)  cand[i] = vl + (vr - vl) * (x[i] - x[l]) / (x[r] - x[l]);
				else if (rule == IP_NEAREST) cand[i] = (x[i] - x[l] <= x[r] - x[i]) ? vl : vr;
				else if (rule == IP_LEFT)    cand[i] = vl;
				else                         cand[i] = vr;
				has[i] = 1;
			} else if (l >= 0) {
				if (edge == IP_EDGE_BOTH || edge == IP_EDGE_LEFT)  { cand[i] = y[l]; has[i] = 1; }
			} else if (r >= 0) {
				if (edge == IP_EDGE_BOTH || edge == IP_EDGE_RIGHT) { cand[i] = y[r]; has[i] = 1; }
			}
		}
	} else if (anchors >= 2) {
		NV *xa, *ya;
		Newx(xa, anchors, NV); SAVEFREEPV(xa);
		Newx(ya, anchors, NV); SAVEFREEPV(ya);
		IV na = 0;
		for (IV i = 0; i < n; i++) if (kind[i] == 1) { xa[na] = x[i]; ya[na] = y[i]; na++; }
		for (IV i = 1; i < na; i++)
			if (!(xa[i] > xa[i - 1]))
				croak("interpolate: method '%s' needs strictly increasing x coordinates", method);

		IV order = SvOK(order_sv) ? SvIV(order_sv) : 0;
		int deg = -1, extrap = 0, ktype = 0;
		if      (!strcmp(method, "pchip")) { ktype = IP_KPCHIP; extrap = 1; }
		else if (!strcmp(method, "akima")) { ktype = IP_KAKIMA; extrap = 0; }
		else if (!strcmp(method, "barycentric") || !strcmp(method, "krogh")) { ktype = IP_KBARY; extrap = 1; }
		else {
			if      (!strcmp(method, "cubicspline")) { extrap = 1; deg = 3; }
			else if (!strcmp(method, "spline"))      { extrap = 0; deg = order; }
			else if (!strcmp(method, "polynomial"))  { extrap = 0; deg = order; }
			else if (!strcmp(method, "quadratic"))   { extrap = 0; deg = 2; }
			else if (!strcmp(method, "cubic"))       { extrap = 0; deg = 3; }
			if      (deg == 1) ktype = IP_KLINEAR;
			else if (deg == 2) {
				if (na < 3) croak("interpolate: method '%s' (degree 2) needs at least 3 numeric anchors", method);
				ktype = IP_KQUAD;
			} else if (deg == 3) {
				if (na < 4 && strcmp(method, "cubicspline") != 0)
					croak("interpolate: method '%s' (degree 3) needs at least 4 numeric anchors", method);
				ktype = IP_KCUBIC;
			} else
				croak("interpolate: method '%s' supports order 1, 2, or 3 (got %ld)", method, (long)order);
		}
		if (ktype == IP_KAKIMA && na == 2) ktype = IP_KCUBIC;// akima degenerates to the line

		ip_fit F; Zero(&F, 1, ip_fit);
		F.na = na; F.xa = xa; F.ya = ya; F.type = ktype;
		switch (ktype) {
			case IP_KLINEAR: break;
			case IP_KCUBIC:  ip_build_cubic(aTHX_ &F); break;
			case IP_KQUAD:   ip_build_quad(aTHX_ &F);  break;
			case IP_KPCHIP:  ip_build_pchip(aTHX_ &F); break;
			case IP_KAKIMA:  ip_build_akima(aTHX_ &F); break;
			case IP_KBARY:   ip_build_bary(aTHX_ &F);  break;
		}
		NV xmin = xa[0], xmax = xa[na - 1];
		for (IV i = 0; i < n; i++) {
			if (kind[i] != 0) continue;
			NV xv = x[i];
			if      (xv >= xmin && xv <= xmax) { cand[i] = ip_eval(&F, xv); has[i] = 1; }
			else if (extrap)                   { cand[i] = ip_eval(&F, xv); has[i] = 1; }
		}
	}

	//pandas preserve_nans: which gaps must stay NA under limit/direction/area
	char *pre; Newxz(pre, n, char); SAVEFREEPV(pre);
	IV first = n, last = -1;
	for (IV i = 0; i < n; i++)     if (kind[i] == 1) { first = i; break; }
	for (IV i = n - 1; i >= 0; i--) if (kind[i] == 1) { last = i; break; }
	int have_limit = SvOK(limit_sv);
	IV  limit = have_limit ? SvIV(limit_sv) : 0;
	if (!strcmp(dir, "forward")) {
		for (IV i = 0; i < first; i++) pre[i] = 1;
		if (have_limit) ip_far(kind, n, limit, 0, pre);
	} else if (!strcmp(dir, "backward")) {
		for (IV i = last + 1; i < n; i++) pre[i] = 1;
		if (have_limit) ip_far(kind, n, 0, limit, pre);
	} else { // both
		if (have_limit) ip_far(kind, n, limit, limit, pre);
	}
	if (SvOK(area_sv)) {
		const char *area = SvPV_nolen(area_sv);
		if (!strcmp(area, "inside")) {
			for (IV i = 0; i < first; i++)    pre[i] = 1;
			for (IV i = last + 1; i < n; i++) pre[i] = 1;
		} else if (!strcmp(area, "outside")) {
			for (IV i = 0; i < n; i++) if (kind[i] == 0 && i >= first && i <= last) pre[i] = 1;
		}
	}

	for (IV i = 0; i < n; i++) {
		if (kind[i] != 0 || !has[i] || pre[i]) continue;
		SV *nsv = newSVnv(cand[i]);
		if (av_store(vals, i, nsv) == NULL) SvREFCNT_dec(nsv);
	}
}

/*epidemiology: parse a 2x2 table from an array ref
Accepts a flat [a,b,c,d] or a nested [[a,b],[c,d]].  Layout convention
(rows = exposure/treatment, columns = outcome):
         outcome+   outcome-
  exp+       a          b
  exp-       c          d
Croaks on a malformed shape or a negative count.*/
static void epi_read_2x2(pTHX_ SV *sv, const char *who,
                         NV *a, NV *b, NV *c, NV *d) {
	if (!SvROK(sv) || SvTYPE(SvRV(sv)) != SVt_PVAV)
		croak("%s: expected a 2x2 table as an array ref [a,b,c,d] or [[a,b],[c,d]]", who);
	AV *av = (AV *)SvRV(sv);
	SSize_t top = av_len(av);
	if (top == 3) {                                   //flat [a,b,c,d]
		*a = SvNV(*av_fetch(av, 0, 0)); *b = SvNV(*av_fetch(av, 1, 0));
		*c = SvNV(*av_fetch(av, 2, 0)); *d = SvNV(*av_fetch(av, 3, 0));
	} else if (top == 1) {                            //nested [[a,b],[c,d]]
		SV **r0 = av_fetch(av, 0, 0), **r1 = av_fetch(av, 1, 0);
		if (!r0 || !r1 || !SvROK(*r0) || !SvROK(*r1)
		    || SvTYPE(SvRV(*r0)) != SVt_PVAV || SvTYPE(SvRV(*r1)) != SVt_PVAV)
			croak("%s: 2-row form must be [[a,b],[c,d]]", who);
		AV *ar0 = (AV *)SvRV(*r0), *ar1 = (AV *)SvRV(*r1);
		if (av_len(ar0) != 1 || av_len(ar1) != 1)
			croak("%s: each row of a 2x2 table needs exactly 2 cells", who);
		*a = SvNV(*av_fetch(ar0, 0, 0)); *b = SvNV(*av_fetch(ar0, 1, 0));
		*c = SvNV(*av_fetch(ar1, 0, 0)); *d = SvNV(*av_fetch(ar1, 1, 0));
	} else {
		croak("%s: expected 4 cells (a,b,c,d) or 2 rows of 2 cells", who);
	}
	if (*a < 0 || *b < 0 || *c < 0 || *d < 0)
		croak("%s: cell counts must be non-negative", who);
}

// ROC / AUC
typedef struct { NV score; int lab; } ROCPt;      //lab: 1 = positive case
static int rocpt_cmp_desc(const void *a, const void *b) {
	const ROCPt *pa = (const ROCPt *)a, *pb = (const ROCPt *)b;
	if (pa->score > pb->score) return -1;
	if (pa->score < pb->score) return 1;
	return 0;
}

/*(value, original-index) pair, sorted ascending by value.  Used by bedroc's
active_frac mode to pick exactly ceil(frac*N) items from the low or high
tail of the second array as the actives (matching an argsort selection).*/
typedef struct { NV v; size_t i; } NVIdx;
static int nvidx_cmp_asc(const void *a, const void *b) {
	NV x = ((const NVIdx *)a)->v, y = ((const NVIdx *)b)->v;
	return (x > y) - (x < y);
}

/*Split parallel score/label arrays into the positive and negative score
vectors.  A label counts as positive when its string form equals `positive`.
With lower_pos set, the score sign is flipped (lower marker => more positive).
Allocates pos/neg via Newx; the caller frees them.  Croaks on a bad shape.*/
static void roc_split(pTHX_ AV *sav, AV *lav,
                      const char *positive, bool lower_pos,
                      NV **pos, size_t *m,
                      NV **neg, size_t *n, const char *who) {
	SSize_t N = av_len(sav) + 1;
	if (N != av_len(lav) + 1)
		croak("%s: scores and labels must be the same length", who);
	if (N < 1) croak("%s: need at least one observation", who);
	NV *P; Newx(P, N, NV);
	NV *Q; Newx(Q, N, NV);
	size_t mm = 0, nn = 0;
	for (SSize_t i = 0; i < N; i++) {
		SV **sp = av_fetch(sav, i, 0), **lp = av_fetch(lav, i, 0);
		NV s = (sp && *sp) ? SvNV(*sp) : NAN;
		if (lower_pos) s = -s;
		bool ispos = (lp && *lp) ? strEQ(SvPV_nolen(*lp), positive) : 0;
		if (ispos) P[mm++] = s; else Q[nn++] = s;
	}
	if (mm == 0 || nn == 0) {
		Safefree(P); Safefree(Q);
		croak("%s: need both positive and negative labels (positive='%s')", who, positive);
	}
	*pos = P; *m = mm; *neg = Q; *n = nn;
}

/*DeLong AUC (c-statistic) and its standard error for one ROC curve.  Higher
score = more positive.  Midranks make ties exact; AUC equals the
Mann-Whitney concordance probability.*/
static void roc_delong(pTHX_ const NV *pos, size_t m,
                       const NV *neg, size_t n,
                       NV *auc_out, NV *se_out) {
	size_t N = m + n;
	NV *comb, *TX, *TY, *TZ, *V10, *V01;
	Newx(comb, N, NV); Newx(TX, m, NV); Newx(TY, n, NV);
	Newx(TZ, N, NV);   Newx(V10, m, NV); Newx(V01, n, NV);
	for (size_t i = 0; i < m; i++) comb[i]     = pos[i];
	for (size_t j = 0; j < n; j++) comb[m + j] = neg[j];
	rank_data(pos,  TX, m);           //midranks within positives
	rank_data(neg,  TY, n);           //midranks within negatives
	rank_data(comb, TZ, N);           //midranks in the combined sample
	NV auc = 0.0;
	for (size_t i = 0; i < m; i++) { V10[i] = (TZ[i] - TX[i]) / (NV)n; auc += V10[i]; }
	auc /= (NV)m;
	for (size_t j = 0; j < n; j++)   V01[j] = 1.0 - (TZ[m + j] - TY[j]) / (NV)m;
	NV s10 = 0.0, s01 = 0.0;
	for (size_t i = 0; i < m; i++) { NV dz = V10[i] - auc; s10 += dz * dz; }
	for (size_t j = 0; j < n; j++) { NV dz = V01[j] - auc; s01 += dz * dz; }
	s10 = (m > 1) ? s10 / (NV)(m - 1) : 0.0;
	s01 = (n > 1) ? s01 / (NV)(n - 1) : 0.0;
	*auc_out = auc;
	*se_out  = nv_sqrt(s10 / (NV)m + s01 / (NV)n);
	Safefree(comb); Safefree(TX); Safefree(TY); Safefree(TZ); Safefree(V10); Safefree(V01);
}

// survival analysis
typedef struct { NV time; int status; int grp; } SurvObs;   //status: 1=event
static int survobs_cmp(const void *a, const void *b) {
	const SurvObs *pa = (const SurvObs *)a, *pb = (const SurvObs *)b;
	if (pa->time < pb->time) return -1;
	if (pa->time > pb->time) return 1;
	return pb->status - pa->status;      //events before censors at a tie
}

/*Gauss-Jordan solve of A x = b (A is n*n row-major, destroyed in place).
Returns 0 on success, 1 if (near-)singular.  Used for the log-rank quadratic
form on the (g-1)-dimensional reduced observed-minus-expected vector.*/
static int srv_solve(NV *restrict A, const NV *restrict b, int n, NV *restrict x) {
	for (int i = 0; i < n; i++) x[i] = b[i];
	for (int col = 0; col < n; col++) {
		int piv = col; NV best = nv_fabs(A[col * n + col]);
		for (int r = col + 1; r < n; r++) { NV v = nv_fabs(A[r * n + col]); if (v > best) { best = v; piv = r; } }
		if (best < 1e-300) return 1;
		if (piv != col) {
			for (int c = 0; c < n; c++) { NV t = A[col*n+c]; A[col*n+c] = A[piv*n+c]; A[piv*n+c] = t; }
			NV t = x[col]; x[col] = x[piv]; x[piv] = t;
		}
		NV d = A[col * n + col];
		for (int r = 0; r < n; r++) {
			if (r == col) continue;
			NV f = A[r * n + col] / d;
			for (int c = col; c < n; c++) A[r * n + c] -= f * A[col * n + c];
			x[r] -= f * x[col];
		}
	}
	for (int i = 0; i < n; i++) x[i] /= A[i * n + i];
	return 0;
}

/*Invert an n*n matrix A (row-major) into inv via Gauss-Jordan with partial
pivoting; A is destroyed.  Returns 0 on success, 1 if (near-)singular.
Used for the Cox information matrix (coef covariance = its inverse).*/
static int mat_inv(NV *restrict A, int n, NV *restrict inv) {
	for (int i = 0; i < n * n; i++) inv[i] = (i % n == i / n) ? 1.0 : 0.0;
	for (int col = 0; col < n; col++) {
		int piv = col; NV best = nv_fabs(A[col * n + col]);
		for (int r = col + 1; r < n; r++) { NV v = nv_fabs(A[r * n + col]); if (v > best) { best = v; piv = r; } }
		if (best < 1e-300) return 1;
		if (piv != col)
			for (int c = 0; c < n; c++) {
				NV t = A[col*n+c]; A[col*n+c] = A[piv*n+c]; A[piv*n+c] = t;
				t = inv[col*n+c]; inv[col*n+c] = inv[piv*n+c]; inv[piv*n+c] = t;
			}
		NV d = A[col * n + col];
		for (int c = 0; c < n; c++) { A[col*n+c] /= d; inv[col*n+c] /= d; }
		for (int r = 0; r < n; r++) {
			if (r == col) continue;
			NV f = A[r * n + col];
			for (int c = 0; c < n; c++) { A[r*n+c] -= f * A[col*n+c]; inv[r*n+c] -= f * inv[col*n+c]; }
		}
	}
	return 0;
}

typedef struct { NV time; int idx; } TimeIdx; // sort observations by time

/*Read parallel time/status(/group) arrays into a SurvObs array.  Group index
is assigned by first appearance of each label string; the labels are pushed
(as SVs) into *labels_out in that order.  gav == NULL => one group "".
status is 1 (event) when the value is non-zero, else 0 (censored).*/
static SurvObs* srv_read(pTHX_ AV *tav, AV *sav, AV *gav,
                         size_t *N_out, AV *labels, const char *who) {
	SSize_t N = av_len(tav) + 1;
	if (N != av_len(sav) + 1) croak("%s: time and status must be the same length", who);
	if (gav && N != av_len(gav) + 1) croak("%s: group must match time/status length", who);
	if (N < 1) croak("%s: need at least one observation", who);
	SurvObs *o; Newx(o, N, SurvObs);
	for (SSize_t i = 0; i < N; i++) {
		SV **tp = av_fetch(tav, i, 0), **sp = av_fetch(sav, i, 0);
		NV t = (tp && *tp) ? SvNV(*tp) : NAN;
		if (t < 0) { Safefree(o); croak("%s: negative survival time", who); }
		o[i].time   = t;
		o[i].status = (sp && *sp && SvNV(*sp) != 0.0) ? 1 : 0;
		int g = 0;
		if (gav) {
			SV **gp = av_fetch(gav, i, 0);
			const char *lab = (gp && *gp) ? SvPV_nolen(*gp) : "";
			SSize_t G = av_len(labels) + 1, found = -1;
			for (SSize_t k = 0; k < G; k++)
				if (strEQ(SvPV_nolen(*av_fetch(labels, k, 0)), lab)) { found = k; break; }
			if (found < 0) { found = G; av_push(labels, newSVpv(lab, 0)); }
			g = (int)found;
		}
		o[i].grp = g;
	}
	if (av_len(labels) < 0) av_push(labels, newSVpv("", 0));   //single group
	*N_out = (size_t)N;
	return o;
}

/*Adjust m raw p-values (writes adj[]) for a family of methods, matching R's
p.adjust / the dunn.test package.  Used by dunn_test.*/
static void dunn_padjust(const NV *p, size_t m, const char *meth, NV *adj) {
	size_t *ord = NULL; Newx(ord, m, size_t);   //indices of p sorted ascending
	for (size_t i = 0; i < m; i++) ord[i] = i;
	for (size_t a = 0; a + 1 < m; a++)                   //small m; simple insertion sort
		for (size_t b = a + 1; b < m; b++)
			if (p[ord[b]] < p[ord[a]]) { size_t t = ord[a]; ord[a] = ord[b]; ord[b] = t; }

	if (strEQ(meth, "none")) {
		for (size_t i = 0; i < m; i++) adj[i] = p[i];
	} else if (strEQ(meth, "bonferroni")) {
		for (size_t i = 0; i < m; i++) { NV v = p[i] * m; adj[i] = v < 1.0 ? v : 1.0; }
	} else if (strEQ(meth, "sidak")) {
		for (size_t i = 0; i < m; i++) { NV v = 1.0 - nv_pow(1.0 - p[i], (NV)m); adj[i] = v < 1.0 ? v : 1.0; }
	} else if (strEQ(meth, "holm")) {
		NV cummax = 0.0;
		for (size_t i = 0; i < m; i++) { NV v = p[ord[i]] * (m - i); if (v > cummax) cummax = v; adj[ord[i]] = cummax < 1.0 ? cummax : 1.0; }
	} else if (strEQ(meth, "hs")) {   //Holm-Sidak
		NV cummax = 0.0;
		for (size_t i = 0; i < m; i++) { NV v = 1.0 - nv_pow(1.0 - p[ord[i]], (NV)(m - i)); if (v > cummax) cummax = v; adj[ord[i]] = cummax < 1.0 ? cummax : 1.0; }
	} else if (strEQ(meth, "bh")) {
		NV cummin = 1.0;
		for (ssize_t i = (ssize_t)m - 1; i >= 0; i--) { NV v = p[ord[i]] * m / (i + 1.0); if (v < cummin) cummin = v; adj[ord[i]] = cummin < 1.0 ? cummin : 1.0; }
	} else if (strEQ(meth, "by")) {
		NV q = 0.0; for (size_t i = 1; i <= m; i++) q += 1.0 / i;
		NV cummin = 1.0;
		for (ssize_t i = (ssize_t)m - 1; i >= 0; i--) { NV v = p[ord[i]] * m / (i + 1.0) * q; if (v < cummin) cummin = v; adj[ord[i]] = cummin < 1.0 ? cummin : 1.0; }
	} else {
		Safefree(ord);
		croak("dunn_test: unknown method '%s' (none, bonferroni, sidak, holm, hs, bh, by)", meth);
	}
	Safefree(ord);
}

/*shared machinery for skew() and kurtosis()
Both statistics are ratios of central moments, so both need the same one
pass over the sample.  The recurrence is Welford's, carried up to the third
and fourth moments (Terriberry).  What this buys over the textbook
expansion in raw moments -- m3 = Sx^3/n - 3*xbar*Sx^2/n + 2*xbar^3 -- is
everything: for a column of values around 1e7 (a lab value in the wrong
units, a timestamp) Sx^3/n is ~1e21 while m3 is single digits, so that form
cancels away every significant figure.  Centering first, whether in a
second pass or by this recurrence, is what keeps the answer; the recurrence
additionally needs no second look at the input, which matters because the
input here may be a bare list on the argument stack.  m2..m4 hold the
*sums* of the powered deviations, not the moments; callers divide by n.*/
typedef struct {
	NV mean, m2, m3, m4;
	size_t n;
} moment_acc;

static void moment_push(moment_acc *a, NV x) {
	const NV n1 = (NV)a->n; // count before this observation
	a->n++;
	const NV n     = (NV)a->n;
	const NV delta = x - a->mean;
	const NV dn    = delta / n;
	const NV dn2   = dn * dn;
	const NV term  = delta * dn * n1; // == n1/n * delta^2
	a->m4   += term * dn2 * (n * n - 3.0 * n + 3.0)
	         + 6.0 * dn2 * a->m2 - 4.0 * dn * a->m3;
	a->m3   += term * dn * (n - 2.0) - 3.0 * dn * a->m2;
	a->m2   += term;
	a->mean += dn;
}

static void moment_av(pTHX_ AV *av, size_t argi,
                      const char *fname, moment_acc *acc) {
	const size_t len = av_len(av) + 1;
	if (SvRMAGICAL((SV*)av)) {
		/*Tied, so the cells are not in AvARRAY at all.  av_fetch hands back
		a deferred PVLV rather than the value, and SvOK on that is false
		until the get-magic runs -- without SvGETMAGIC every element of a
		tied array looks undefined.*/
		for (size_t j = 0; j < len; j++) {
			SV **tv = av_fetch(av, j, 0);
			if (tv) SvGETMAGIC(*tv);
			if (tv && SvOK(*tv)) moment_push(acc, SvNV(*tv));
			else croak("%s: undefined value at array ref index %" UVuf
			           " (argument %" UVuf ")", fname, (UV)j, (UV)argi);
		}
		return;
	}
	SV **src = AvARRAY(av);
	for (SSize_t j = 0; j < len; j++) {
		SV *tv = src[j];
		if (tv && SvOK(tv)) moment_push(acc, SvNV(tv));
		else croak("%s: undefined value at array ref index %" UVuf
		           " (argument %" UVuf ")", fname, (UV)j, (UV)argi);
	}
}

/*Walk an argument list of numbers, array refs of numbers and 'type'/'x'
named pairs.  Shared so that skew() and kurtosis() cannot drift apart on
what they accept.  A named key is recognised only when the SV is a string
that is not a number, so it can never swallow a data value -- and anything
else that looks like a bareword is a typo worth reporting rather than
silently averaging in as zero.*/
static void moment_args(pTHX_ SV **args, size_t items,
                        const char *fname,
                        moment_acc *acc, IV *type) {
	for (size_t i = 0; i < items; i++) {
		SV *arg = args[i];
		if (arg && SvPOK(arg) && !SvROK(arg) && !looks_like_number(arg)) {
			const char *key = SvPV_nolen(arg);
			const bool is_type = strEQ(key, "type");
			if (!is_type && !strEQ(key, "x"))
				croak("%s: unknown argument '%s' (expected numbers, array "
				      "refs, x => \\@data or type => 1|2|3)", fname, key);
			if (i + 1 >= items)
				croak("%s: '%s' needs a value", fname, key);
			SV *val = args[++i];
			if (is_type) {
				if (!SvOK(val) || !looks_like_number(val))
					croak("%s: type must be 1, 2 or 3", fname);
				*type = SvIV(val);
				if (*type < 1 || *type > 3)
					croak("%s: type must be 1, 2 or 3, not %" IVdf, fname, *type);
			} else {
				if (!SvROK(val) || SvTYPE(SvRV(val)) != SVt_PVAV)
					croak("%s: 'x' must be an array reference", fname);
				moment_av(aTHX_ (AV*)SvRV(val), i, fname, acc);
			}
		} else if (arg && SvROK(arg) && SvTYPE(SvRV(arg)) == SVt_PVAV) {
			moment_av(aTHX_ (AV*)SvRV(arg), i, fname, acc);
		} else if (arg && SvOK(arg)) {
			moment_push(acc, SvNV(arg));
		} else {
			croak("%s: undefined value at argument index %" UVuf, fname, (UV)i);
		}
	}
}

/*==
density() and the bw.* bandwidth selectors
---------------------------------------------------------------------------
A port of R 4.6.1's stats::density.default(), together with the five bandwidth
rules its `bw =` string can name, so that a Perl caller gets the same grid, the
same bandwidth and the same estimate R would give.

Every piece below is named after, and follows line by line, the R source it
comes from:

  src/library/stats/R/density.R      density.default()
  src/library/stats/R/bandwidths.R   bw.nrd0 / bw.nrd / bw.SJ / bw.ucv / bw.bcv
  src/library/stats/src/massdist.c   BinDist()
  src/library/stats/src/bandwidths.c bw_den / bw_den_binned / bw_phi4 /
                                     bw_phi6 / bw_ucv / bw_bcv
  src/library/stats/src/approx.c     approx1()
  src/library/stats/src/optimize.c   Brent_fmin(), which is R's optimize()
  src/main/seq.c                     do_seq(), for seq.int(from, to, length.out=)
  src/library/stats/src/zeroin.c     which is ft_zeroin() above already

R disperses the data onto a grid, convolves it with the discretised kernel
using fft(), and interpolates back with approx().  It rounds n up to a power of
two precisely so that transform is cheap, which means the transform length here
(2n) is always a power of two and a plain radix-2 Cooley-Tukey is all that is
needed -- see dens_fft().
 ==========================================================================*/

/*bandwidths.c: "Avoid slow and possibly error-producing underflows by cutting
off at plus/minus sqrt(DELMAX) std deviations".*/
#define DENS_DELMAX 1000.0

/*all.equal.numeric()'s default tolerance.  density() reaches for it twice:
to decide whether user weights summed to one (and so should be re-normalised
after NA removal), and to decide whether to warn that they did not.*/
#define DENS_ALL_EQ_TOL 1.5e-8

/*pi at the full width of an NV.  A literal cannot supply this: an unsuffixed C
floating constant is a double, so spelling the digits out would silently round
pi to 53 bits on a long-double or __float128 build, and the `L` / `Q` suffixes
that would avoid that are per-build (and `Q` is a GNU extension).  acos(-1) is
pi correctly rounded to the working width on every libm, and nv_acos() picks
the right width's acos.*/
#define DENS_PI nv_acos((NV)-1.0)

/*Kernels, in the order R lists them in the `kernel` argument's default.  The
order is the one match.arg() sees, so a partial match resolves the same way.*/
#define DENS_K_GAUSSIAN     0
#define DENS_K_EPANECHNIKOV 1
#define DENS_K_RECTANGULAR  2
#define DENS_K_TRIANGULAR   3
#define DENS_K_BIWEIGHT     4
#define DENS_K_COSINE       5
#define DENS_K_OPTCOSINE    6
static const char *const dens_kernel_name[7] = {
	"gaussian", "epanechnikov", "rectangular", "triangular",
	"biweight", "cosine", "optcosine"
};

/*Bandwidth rules, in the order bw.nrd0 ... bw.SJ appear in density()'s switch.*/
#define DENS_BW_NRD0   0
#define DENS_BW_NRD    1
#define DENS_BW_UCV    2
#define DENS_BW_BCV    3
#define DENS_BW_SJ_STE 4
#define DENS_BW_SJ_DPI 5

/*var(x) as R's src/library/stats/src/cov.c computes it: the mean, then a
correction by the mean of the residuals, then the sum of squared residuals over
n-1.  The correction pass is not decoration -- dropping it moves sd() in the
last couple of digits, and sd() is what bw.nrd0() and bw.SJ() scale by.*/
static NV dens_var(const NV *x, size_t n)
{
	NV s = 0.0;
	for (size_t i = 0; i < n; i++) s += x[i];
	NV m = s / (NV)n;
	if (nv_isfinite(m)) {
		s = 0.0;
		for (size_t i = 0; i < n; i++) s += (x[i] - m);
		m += s / (NV)n;
	}
	s = 0.0;
	for (size_t i = 0; i < n; i++) { NV dv = x[i] - m; s += dv * dv; }
	return s / (NV)(n - 1);
}

/*quantile(x, p, type = 7) on an already sorted x, spelled the way R's
quantile.default() spells it so that the x[hi] == x[lo] short circuit lands the
same way.*/
static NV dens_quantile7(const NV *xs, size_t n, NV p)
{
	if (n == 1) return xs[0];
	NV index = (NV)(n - 1) * p;
	NV loi   = nv_floor(index);
	size_t lo = (size_t)loi;
	size_t hi = (size_t)nv_ceil(index);
	NV qs = xs[lo];
	if (index > loi && xs[hi] != qs) {
		NV hh = index - loi;
		qs = (1.0 - hh) * qs + hh * xs[hi];
	}
	return qs;
}

/*IQR(x) on a sorted x: quantile type 7 at 0.75 less quantile type 7 at 0.25.*/
static NV dens_iqr(const NV *xs, size_t n)
{
	return dens_quantile7(xs, n, 0.75) - dens_quantile7(xs, n, 0.25);
}

/*seq.int(from, to, length.out = m).  seq.int is a primitive, and do_seq() in
src/main/seq.c writes the two endpoints in exactly rather than accumulating to
them, which is why `up` and `to` come back bit-exact and the interpolation grid
never runs off the end of the FFT grid.*/
static void dens_seq(NV from, NV to, size_t m, NV *out)
{
	if (m == 0) return;
	out[0] = from;
	if (m > 1) out[m - 1] = to;
	if (m > 2) {
		NV by = (to - from) / (NV)(m - 1);
		for (size_t i = 1; i < m - 1; i++) out[i] = from + (NV)i * by;
	}
}

/*approx1() from src/library/stats/src/approx.c: linear interpolation of
(x, y) at v, with the interval found by bisection.  method = "linear" and
rule = 1, which are what density() asks approx() for, so a v outside [x0, xn]
would be NA -- it never is here, since the output grid is a sub-interval of the
FFT grid.*/
static NV dens_approx1(NV v, const NV *x, const NV *y, size_t n)
{
	if (n == 0) return NV_NAN;
	if (n == 1) return (v == x[0]) ? y[0] : NV_NAN;
	size_t i = 0, j = n - 1;
	if (v < x[i]) return NV_NAN;
	if (v > x[j]) return NV_NAN;
	while (i < j - 1) {
		size_t ij = (i + j) / 2;
		if (v < x[ij]) j = ij; else i = ij;
	}
	if (v == x[j]) return y[j];
	if (v == x[i]) return y[i];
	return y[i] + (y[j] - y[i]) * ((v - x[i]) / (x[j] - x[i]));
}

/*In-place radix-2 Cooley-Tukey.  n must be a power of two, which it always is
here: density() rounds its grid up to one before this is reached.  `sign` is -1
for R's fft(z) and +1 for fft(z, inverse = TRUE); like R's, neither direction is
normalised -- density() divides by the length itself.

wr/wi are the n/2 twiddle factors, computed once by the caller so that the
inner loop does no trigonometry; recomputing cos/sin from the exact angle (as
opposed to rotating an accumulator) is also what keeps the error at O(sqrt(log
n)) ulps instead of drifting with the stage.*/
static void dens_fft(NV *restrict re, NV *restrict im,
                     const NV *restrict wr, const NV *restrict wi, size_t n)
{
	if (n < 2) return;
	for (size_t i = 1, j = 0; i < n; i++) {   //bit-reversal permutation
		size_t bit = n >> 1;
		for (; j & bit; bit >>= 1) j ^= bit;
		j ^= bit;
		if (i < j) {
			NV t;
			t = re[i]; re[i] = re[j]; re[j] = t;
			t = im[i]; im[i] = im[j]; im[j] = t;
		}
	}
	for (size_t len = 2; len <= n; len <<= 1) {
		size_t half = len >> 1, step = n / len;
		for (size_t i = 0; i < n; i += len) {
			for (size_t k = 0; k < half; k++) {
				size_t t = k * step, a = i + k, b = a + half;
				NV br = re[b] * wr[t] - im[b] * wi[t];
				NV bi = re[b] * wi[t] + im[b] * wr[t];
				re[b] = re[a] - br; im[b] = im[a] - bi;
				re[a] += br;        im[a] += bi;
			}
		}
	}
}

/*BinDist() from src/library/stats/src/massdist.c: disperse each observation's
weight linearly over the two nearest of n grid points spanning [xlo, xhi].  The
upper half of y stays zero -- it is the zero padding that turns the circular
convolution the FFT computes into the linear one that is wanted.*/
static void dens_bindist(const NV *restrict x, const NV *restrict w, size_t nx,
                         NV xlo, NV xhi, size_t n, NV *restrict y)
{
	for (size_t i = 0; i < 2 * n; i++) y[i] = 0.0;
	/*ix is an int, and the guard below is written against INT_MAX/INT_MIN,
	because that truncation is part of the binning R performs and not an
	incidental choice of width.*/
	const int ixmin = 0, ixmax = (int)n - 2;
	NV xdelta = (xhi - xlo) / (NV)(n - 1);
	for (size_t i = 0; i < nx; i++) {
		if (!nv_isfinite(x[i])) continue;
		NV xpos = (x[i] - xlo) / xdelta;
		if (xpos > (NV)INT_MAX || xpos < (NV)INT_MIN) continue;
		int ix = (int)nv_floor(xpos);
		NV fx = xpos - (NV)ix;
		NV wi = w[i];
		if (ixmin <= ix && ix <= ixmax) {
			y[ix]     += (1.0 - fx) * wi;
			y[ix + 1] += fx * wi;
		}
		else if (ix == -1)        y[0]  += fx * wi;
		else if (ix == ixmax + 1) y[ix] += (1.0 - fx) * wi;
	}
}

/*kords in density.R: the kernel sampled on the FFT grid's lag coordinates,
with the second half carrying the negative lags.  `mult` is 2 under
old.coords = TRUE and (2n-1)/(n-1) otherwise -- R 4.4.0 changed it because the
old grid overstated the density by a factor of about 1 + 1/(2n-2).*/
static void dens_kernel_grid(short int kernel, NV bw, NV span, size_t n,
                             NV *kords)
{
	const NV pi = DENS_PI;
	size_t m = 2 * n;
	dens_seq(0.0, span, m, kords);
	for (size_t i = n + 1; i < m; i++) kords[i] = -kords[m - i];

	NV a;
	switch (kernel) {
	case DENS_K_GAUSSIAN:
		for (size_t i = 0; i < m; i++) kords[i] = c_dnorm(kords[i], 0.0, bw, FALSE);
		break;
	case DENS_K_RECTANGULAR:
		a = bw * nv_sqrt((NV)3.0);
		for (size_t i = 0; i < m; i++)
			kords[i] = (nv_fabs(kords[i]) < a) ? 0.5 / a : 0.0;
		break;
	case DENS_K_TRIANGULAR:
		a = bw * nv_sqrt((NV)6.0);
		for (size_t i = 0; i < m; i++) {
			NV ax = nv_fabs(kords[i]);
			kords[i] = (ax < a) ? (1.0 - ax / a) / a : 0.0;
		}
		break;
	case DENS_K_EPANECHNIKOV:
		a = bw * nv_sqrt((NV)5.0);
		for (size_t i = 0; i < m; i++) {
			NV ax = nv_fabs(kords[i]);
			kords[i] = (ax < a) ? 0.75 * (1.0 - (ax / a) * (ax / a)) / a : 0.0;
		}
		break;
	case DENS_K_BIWEIGHT:
		a = bw * nv_sqrt((NV)7.0);
		for (size_t i = 0; i < m; i++) {
			NV ax = nv_fabs(kords[i]);
			if (ax < a) {
				NV u = 1.0 - (ax / a) * (ax / a);
				kords[i] = (15.0 / 16.0) * u * u / a;
			} else kords[i] = 0.0;
		}
		break;
	case DENS_K_COSINE:
		a = bw / nv_sqrt(1.0 / 3.0 - 2.0 / (pi * pi));
		for (size_t i = 0; i < m; i++)
			kords[i] = (nv_fabs(kords[i]) < a)
			         ? (1.0 + nv_cos(pi * kords[i] / a)) / (2.0 * a) : 0.0;
		break;
	default: /* DENS_K_OPTCOSINE */
		a = bw / nv_sqrt(1.0 - 8.0 / (pi * pi));
		for (size_t i = 0; i < m; i++)
			kords[i] = (nv_fabs(kords[i]) < a)
			         ? pi / 4.0 * nv_cos(pi * kords[i] / (2.0 * a)) / a : 0.0;
		break;
	}
}

/*give.Rkern = TRUE: sigma(K) * R(K), the scale invariant canonical bandwidth.*/
static NV dens_rkern(short int kernel)
{
	const NV pi = DENS_PI;
	switch (kernel) {
	case DENS_K_GAUSSIAN:     return 1.0 / (2.0 * nv_sqrt(pi));
	case DENS_K_RECTANGULAR:  return nv_sqrt((NV)3.0) / 6.0;
	case DENS_K_TRIANGULAR:   return nv_sqrt((NV)6.0) / 9.0;
	case DENS_K_EPANECHNIKOV: return 3.0 / (5.0 * nv_sqrt((NV)5.0));
	case DENS_K_BIWEIGHT:     return 5.0 * nv_sqrt((NV)7.0) / 49.0;
	case DENS_K_COSINE:       return 0.75 * nv_sqrt(1.0 / 3.0 - 2.0 / (pi * pi));
	default:                  return nv_sqrt(1.0 - 8.0 / (pi * pi)) * pi * pi / 16.0;
	}
}

/*The S `width` parameter is the length of the kernel's support (4 * sd for the
gaussian); R's bw is a multiple of the sd, so density() divides by these.*/
static NV dens_width_factor(short int kernel)
{
	const NV pi = DENS_PI;
	switch (kernel) {
	case DENS_K_GAUSSIAN:     return 4.0;
	case DENS_K_RECTANGULAR:  return 2.0 * nv_sqrt((NV)3.0);
	case DENS_K_TRIANGULAR:   return 2.0 * nv_sqrt((NV)6.0);
	case DENS_K_EPANECHNIKOV: return 2.0 * nv_sqrt((NV)5.0);
	case DENS_K_BIWEIGHT:     return 2.0 * nv_sqrt((NV)7.0);
	case DENS_K_COSINE:       return 2.0 / nv_sqrt(1.0 / 3.0 - 2.0 / (pi * pi));
	default:                  return 2.0 / nv_sqrt(1.0 - 8.0 / (pi * pi));
	}
}

/*bandwidth selection */

/*The binned pair counts bw.SJ/bw.ucv/bw.bcv all work from: cnt[k] is the
number of pairs whose binned distance is k bins.  R switches to the binned
approximation when n > nb/2, "found by empirical timing" -- and the two routes
do not give the same counts, so which one runs is part of the answer.*/
typedef struct { NV d; NV *cnt; size_t nb; } dens_pairs;

static const char *dens_pair_cnts(pTHX_ const NV *restrict x, size_t n,
                                  size_t nb, dens_pairs *restrict out)
{
	out->cnt = NULL; out->nb = nb; out->d = 0.0;
	NV xmin = NV_INF, xmax = -NV_INF;
	for (size_t i = 0; i < n; i++) {
		if (!nv_isfinite(x[i])) return "non-finite x in bandwidth calculation";
		if (x[i] < xmin) xmin = x[i];
		if (x[i] > xmax) xmax = x[i];
	}
	NV rang = (xmax - xmin) * 1.01;
	if (rang == 0.0) return "data are constant in bandwidth calculation";
	NV dd = rang / (NV)nb;
	out->d = dd;
	Newxz(out->cnt, nb, NV);

	if (n > nb / 2) {
		/*bw_pair_cnts(binned = TRUE) in bandwidths.R, which emulates the C
		binning in R and then calls bw_den_binned().*/
		NV *xx; Newx(xx, n, NV);
		NV mn = NV_INF;
		for (size_t i = 0; i < n; i++) {
			NV t = nv_trunc(nv_fabs(x[i]) / dd);
			if (x[i] < 0.0) t = -t;          //sign(x); sign(0) == 0 keeps t == 0
			xx[i] = t;
			if (t < mn) mn = t;
		}
		NV *tab; Newxz(tab, nb, NV);          //tabulate(xx, nb)
		for (size_t i = 0; i < n; i++) {
			NV v = xx[i] - mn + 1.0;
			if (v >= 1.0 && v <= (NV)nb) tab[(size_t)v - 1] += 1.0;
		}
		Safefree(xx);
		for (size_t ii = 0; ii < nb; ii++) {  //bw_den_binned()
			NV w = tab[ii];
			out->cnt[0] += w * (w - 1.0);     //no distance to self
			for (size_t jj = 0; jj < ii; jj++) out->cnt[ii - jj] += w * tab[jj];
		}
		out->cnt[0] *= 0.5;                   //same-bin pairs were counted twice
		Safefree(tab);
	} else {
		/*bw_den(): the exact O(n^2) pair counts.  The two branches are R's --
		a small range very far from zero has to be shifted before it is binned,
		but the unshifted form is kept for everything else so that the counts do
		not change under R's own history.*/
		if (xmin / dd < (NV)INT_MIN || xmax / dd > (NV)INT_MAX) {
			for (size_t i = 1; i < n; i++) {
				int ii = (int)((x[i] - xmin) / dd);
				for (size_t j = 0; j < i; j++) {
					int jj = (int)((x[j] - xmin) / dd);
					int k = ii - jj; if (k < 0) k = -k;
					if ((size_t)k < nb) out->cnt[k] += 1.0;
				}
			}
		} else {
			for (size_t i = 1; i < n; i++) {
				int ii = (int)(x[i] / dd);
				for (size_t j = 0; j < i; j++) {
					int jj = (int)(x[j] / dd);
					int k = ii - jj; if (k < 0) k = -k;
					if ((size_t)k < nb) out->cnt[k] += 1.0;
				}
			}
		}
	}
	return NULL;
}

/*bw_phi4() and bw_phi6() from bandwidths.c: the binned estimates of the
functionals phi_4 and phi_6 that Sheather & Jones (1991) plug in.*/
static NV dens_phi4(size_t n, NV d, const NV *cnt, size_t nb, NV h)
{
	const NV inv_sqrt_2pi = 1.0 / nv_sqrt(2.0 * DENS_PI);
	NV sum = 0.0;
	for (size_t i = 0; i < nb; i++) {
		NV delta = (NV)i * d / h;
		delta *= delta;
		if (delta >= DENS_DELMAX) break;
		sum += nv_exp(-delta / 2.0) * (delta * delta - 6.0 * delta + 3.0) * cnt[i];
	}
	sum = 2.0 * sum + (NV)n * 3.0;                //add in diagonal
	return sum / ((NV)n * (NV)(n - 1) * nv_pow(h, (NV)5.0)) * inv_sqrt_2pi;
}

static NV dens_phi6(size_t n, NV d, const NV *cnt, size_t nb, NV h)
{
	const NV inv_sqrt_2pi = 1.0 / nv_sqrt(2.0 * DENS_PI);
	NV sum = 0.0;
	for (size_t i = 0; i < nb; i++) {
		NV delta = (NV)i * d / h;
		delta *= delta;
		if (delta >= DENS_DELMAX) break;
		sum += nv_exp(-delta / 2.0)
		     * (delta * delta * delta - 15.0 * delta * delta + 45.0 * delta - 15.0)
		     * cnt[i];
	}
	sum = 2.0 * sum - 15.0 * (NV)n;               //add in diagonal
	return sum / ((NV)n * (NV)(n - 1) * nv_pow(h, (NV)7.0)) * inv_sqrt_2pi;
}

typedef struct { size_t n, nb; NV d; const NV *cnt; } dens_cv_ctx;

/*bw_ucv(): unbiased (least-squares) cross-validation criterion.*/
static NV dens_ucv_f(NV h, void *info)
{
	const dens_cv_ctx *c = (const dens_cv_ctx *)info;
	NV sum = 0.0;
	for (size_t i = 0; i < c->nb; i++) {
		NV delta = (NV)i * c->d / h;
		delta *= delta;
		if (delta >= DENS_DELMAX) break;
		sum += (nv_exp(-delta / 4.0) - nv_sqrt((NV)8.0) * nv_exp(-delta / 2.0)) * c->cnt[i];
	}
	return (0.5 + sum / (NV)c->n) / ((NV)c->n * h * nv_sqrt(DENS_PI));
}

/*bw_bcv(): biased cross-validation criterion.*/
static NV dens_bcv_f(NV h, void *info)
{
	const dens_cv_ctx *c = (const dens_cv_ctx *)info;
	NV sum = 0.0;
	for (size_t i = 0; i < c->nb; i++) {
		NV delta = (NV)i * c->d / h;
		delta *= delta;
		if (delta >= DENS_DELMAX) break;
		sum += nv_exp(-delta / 4.0) * (delta * delta - 12.0 * delta + 12.0) * c->cnt[i];
	}
	return (1.0 + sum / (32.0 * (NV)c->n)) / (2.0 * (NV)c->n * h * nv_sqrt(DENS_PI));
}

typedef struct { size_t n, nb; NV d; const NV *cnt; NV alph2, c1; } dens_sj_ctx;

/*fSD() inside bw.SJ(method = "ste"): the solve-the-equation step's root
function.*/
static NV dens_sj_fSD(NV h, void *info)
{
	const dens_sj_ctx *c = (const dens_sj_ctx *)info;
	NV sd = dens_phi4(c->n, c->d, c->cnt, c->nb, c->alph2 * nv_pow(h, (NV)5.0 / 7.0));
	return nv_pow(c->c1 / sd, (NV)0.2) - h;
}

/*Brent_fmin() from src/library/stats/src/optimize.c, which is R's optimize():
golden section search with successive parabolic interpolation.  Carried over at
NV width, with eps scaled off NV_EPSILON rather than pinned to DBL_EPSILON --
the two agree on a double build, and eps only ever enters next to tol/3, which
is larger by ten orders of magnitude at every tolerance R's bandwidth rules
pass in.*/
static NV dens_brent_fmin(NV ax, NV bx, ft_fn f, void *info, NV tol)
{
	const NV c = (3.0 - nv_sqrt((NV)5.0)) * 0.5;   //squared inverse golden ratio
	NV a, b, d, e, p, q, r, u, v, w, x;
	NV t2, fu, fv, fw, fx, xm, eps, tol1, tol3;

	eps  = NV_EPSILON;
	tol1 = eps + 1.0;
	eps  = nv_sqrt(eps);

	a = ax; b = bx;
	v = a + c * (b - a);
	w = v; x = v;
	d = 0.0; e = 0.0;
	fx = f(x, info); fv = fx; fw = fx;
	tol3 = tol / 3.0;

	for (;;) {
		xm = (a + b) * 0.5;
		tol1 = eps * nv_fabs(x) + tol3;
		t2 = tol1 * 2.0;
		if (nv_fabs(x - xm) <= t2 - (b - a) * 0.5) break;
		p = 0.0; q = 0.0; r = 0.0;
		if (nv_fabs(e) > tol1) {                   //fit parabola
			r = (x - w) * (fx - fv);
			q = (x - v) * (fx - fw);
			p = (x - v) * q - (x - w) * r;
			q = (q - r) * 2.0;
			if (q > 0.0) p = -p; else q = -q;
			r = e;
			e = d;
		}
		if (nv_fabs(p) >= nv_fabs(q * 0.5 * r) ||
		    p <= q * (a - x) || p >= q * (b - x)) {   //golden-section step
			if (x < xm) e = b - x; else e = a - x;
			d = c * e;
		} else {                                      //parabolic step
			d = p / q;
			u = x + d;
			if (u - a < t2 || b - u < t2) {           //keep away from the ends
				d = tol1;
				if (x >= xm) d = -d;
			}
		}
		if (nv_fabs(d) >= tol1)  u = x + d;           //and away from x itself
		else if (d > 0.0)        u = x + tol1;
		else                     u = x - tol1;
		fu = f(u, info);
		if (fu <= fx) {
			if (u < x) b = x; else a = x;
			v = w;   w = x;   x = u;
			fv = fw; fw = fx; fx = fu;
		} else {
			if (u < x) a = u; else b = u;
			if (fu <= fw || w == x) {
				v = w; fv = fw;
				w = u; fw = fu;
			} else if (fu <= fv || v == x || v == w) {
				v = u; fv = fu;
			}
		}
	}
	return x;
}

/*bw.nrd0(): Silverman's rule of thumb, R's default.  x0 is the *first* element
in the caller's original order, which is what R's `abs(x[1L])` fallback reads --
not the smallest.*/
static const char *dens_bw_nrd0(const NV *xs, size_t n, NV x0, NV *out)
{
	if (n < 2) return "need at least 2 data points";
	NV hi = nv_sqrt(dens_var(xs, n));
	NV q  = dens_iqr(xs, n) / 1.34;           //qnorm(.75) - qnorm(.25) = 1.34898
	NV lo = (hi < q) ? hi : q;
	if (lo == 0.0) {                          //R: if(!(lo <- min(hi, IQR/1.34)))
		lo = hi;
		if (lo == 0.0) {
			lo = nv_fabs(x0);
			if (lo == 0.0) lo = 1.0;
		}
	}
	*out = 0.9 * lo * nv_pow((NV)n, (NV)-0.2);
	return NULL;
}

/*bw.nrd(): Scott's variant of the same rule.*/
static const char *dens_bw_nrd(const NV *xs, size_t n, NV *out)
{
	if (n < 2) return "need at least 2 data points";
	NV h  = dens_iqr(xs, n) / 1.34;
	NV sd = nv_sqrt(dens_var(xs, n));
	NV lo = (sd < h) ? sd : h;
	*out = 1.06 * lo * nv_pow((NV)n, (NV)-1.0 / 5.0);
	return NULL;
}

/*bw.ucv() and bw.bcv(): minimise the cross-validation criterion over
[lower, upper] with optimize().  `biased` picks bcv over ucv.*/
static const char *dens_bw_cv(pTHX_ const NV *x, const NV *xs,
                              size_t n, size_t nb, bool biased,
                              bool have_lower, NV lower, bool have_upper, NV upper,
                              bool have_tol, NV tol, NV *out)
{
	if (n < 2) return "need at least 2 data points";
	NV hmax = 1.144 * nv_sqrt(dens_var(xs, n)) * nv_pow((NV)n, (NV)-1.0 / 5.0);
	if (!have_lower) lower = 0.1 * hmax;
	if (!have_upper) upper = hmax;
	if (!have_tol)   tol   = 0.1 * lower;

	dens_pairs P;
	const char *err = dens_pair_cnts(aTHX_ x, n, nb, &P);
	if (err) return err;

	dens_cv_ctx ctx;
	ctx.n = n; ctx.nb = P.nb; ctx.d = P.d; ctx.cnt = P.cnt;
	NV h = dens_brent_fmin(lower, upper, biased ? dens_bcv_f : dens_ucv_f, &ctx, tol);
	Safefree(P.cnt);
	if (h < lower + tol || h > upper - tol)
		warn("%s: minimum occurred at one end of the range", biased ? "bw_bcv" : "bw_ucv");
	*out = h;
	return NULL;
}

/*bw.SJ(): the Sheather & Jones (1991) selector, "ste" (solve-the-equation) or
"dpi" (direct plug-in).*/
static const char *dens_bw_sj(pTHX_ const NV *x, const NV *xs,
                              size_t n, size_t nb, bool ste,
                              bool have_lower, NV lower, bool have_upper, NV upper,
                              bool have_tol, NV tol, NV *out)
{
	if (n < 2) return "need at least 2 data points";
	dens_pairs P;
	const char *err = dens_pair_cnts(aTHX_ x, n, nb, &P);
	if (err) return err;

	NV sd    = nv_sqrt(dens_var(xs, n));
	NV iqr   = dens_iqr(xs, n) / 1.349;
	NV scale = (sd < iqr) ? sd : iqr;
	NV a  = 1.24 * scale * nv_pow((NV)n, (NV)-1.0 / 7.0);
	NV b  = 1.23 * scale * nv_pow((NV)n, (NV)-1.0 / 9.0);
	NV c1 = 1.0 / (2.0 * nv_sqrt(DENS_PI) * (NV)n);
	NV TD = -dens_phi6(n, P.d, P.cnt, P.nb, b);
	if (!nv_isfinite(TD) || TD <= 0.0) {
		Safefree(P.cnt);
		return "sample is too sparse to find TD";
	}
	if (!ste) {
		NV h = nv_pow((NV)2.394 / ((NV)n * TD), (NV)1.0 / 7.0);
		*out = nv_pow(c1 / dens_phi4(n, P.d, P.cnt, P.nb, h), (NV)0.2);
		Safefree(P.cnt);
		return NULL;
	}
	/*Both bounds defaulted is what lets bw.SJ widen its search interval; if
	the caller pinned either one, a bracket that does not straddle the root is
	an error rather than something to grow out of.*/
	bool bnd_miss = (!have_lower && !have_upper);
	NV hmax = 1.144 * scale * nv_pow((NV)n, (NV)-1.0 / 5.0);
	if (!have_lower) lower = 0.1 * hmax;
	if (!have_upper) upper = hmax;

	dens_sj_ctx ctx;
	ctx.n = n; ctx.nb = P.nb; ctx.d = P.d; ctx.cnt = P.cnt; ctx.c1 = c1;
	ctx.alph2 = 1.357 * nv_pow(dens_phi4(n, P.d, P.cnt, P.nb, a) / TD, (NV)1.0 / 7.0);
	if (!nv_isfinite(ctx.alph2)) {
		Safefree(P.cnt);
		return "sample is too sparse to find alph2";
	}
	unsigned short int itry = 1;
	while (dens_sj_fSD(lower, &ctx) * dens_sj_fSD(upper, &ctx) > 0.0) {
		if (itry > 99 || !bnd_miss) {     //1.2^99 = 69'014'979, enough
			Safefree(P.cnt);
			return "no solution in the specified range of bandwidths";
		}
		if (itry % 2) upper *= 1.2; else lower /= 1.2;
		itry++;
	}
	/*tol is a promise in R, so it is 0.1 * the bound the loop finished with,
	not 0.1 * the bound it started from.*/
	if (!have_tol) tol = 0.1 * lower;
	*out = ft_zeroin(lower, upper, dens_sj_fSD, &ctx, tol, 1000);
	Safefree(P.cnt);
	return NULL;
}

/*match.arg() over the kernel names: an abbreviation is accepted when it is a
prefix of exactly one of them, which for this set means every single letter
works ("c" is cosine, "o" optcosine).  R's match.arg() is case sensitive; this
is not, in keeping with the rest of the keyword handling in this file.  Returns
-1 for no match or an ambiguous one.*/
static short int dens_match_kernel(const char *s)
{
	size_t len = strlen(s);
	if (len == 0) return -1;
	short int hit = -1;
	unsigned short int nhit = 0;
	for (short int k = 0; k < 7; k++) {
		const char *nm = dens_kernel_name[k];
		size_t j = 0;
		while (j < len && nm[j] != '\0') {
			char c = s[j];
			if (c >= 'A' && c <= 'Z') c += 'a' - 'A';
			if (c != nm[j]) break;
			j++;
		}
		if (j == len) { hit = k; nhit++; }
	}
	return (nhit == 1) ? hit : -1;
}

/*density()'s switch(tolower(bw), ...): the bandwidth rule names, which unlike
the kernels are matched in full.*/
static short int dens_match_bw(const char *s)
{
	if (str_ieq_ascii(s, "nrd0"))   return DENS_BW_NRD0;
	if (str_ieq_ascii(s, "nrd"))    return DENS_BW_NRD;
	if (str_ieq_ascii(s, "ucv"))    return DENS_BW_UCV;
	if (str_ieq_ascii(s, "bcv"))    return DENS_BW_BCV;
	if (str_ieq_ascii(s, "sj"))     return DENS_BW_SJ_STE;
	if (str_ieq_ascii(s, "sj-ste")) return DENS_BW_SJ_STE;
	if (str_ieq_ascii(s, "sj-dpi")) return DENS_BW_SJ_DPI;
	return -1;
}

/*Run the rule `rule` picked out by density()'s `bw =` string, or by a direct
call to one of the bw_* functions.  x is in the caller's order (bw.nrd0() reads
x[1] from it) and xs is the same values sorted.  nb/lower/upper/tol are only
looked at by the three rules that search.*/
static const char *dens_bw_rule(pTHX_ short int rule,
                                const NV *x, const NV *xs, size_t n,
                                size_t nb,
                                bool have_lower, NV lower, bool have_upper, NV upper,
                                bool have_tol, NV tol, NV *out)
{
	switch (rule) {
	case DENS_BW_NRD0: return dens_bw_nrd0(xs, n, x[0], out);
	case DENS_BW_NRD:  return dens_bw_nrd(xs, n, out);
	case DENS_BW_UCV:  return dens_bw_cv(aTHX_ x, xs, n, nb, FALSE,
	                                     have_lower, lower, have_upper, upper,
	                                     have_tol, tol, out);
	case DENS_BW_BCV:  return dens_bw_cv(aTHX_ x, xs, n, nb, TRUE,
	                                     have_lower, lower, have_upper, upper,
	                                     have_tol, tol, out);
	case DENS_BW_SJ_STE: return dens_bw_sj(aTHX_ x, xs, n, nb, TRUE,
	                                       have_lower, lower, have_upper, upper,
	                                       have_tol, tol, out);
	default:             return dens_bw_sj(aTHX_ x, xs, n, nb, FALSE,
	                                       have_lower, lower, have_upper, upper,
	                                       have_tol, tol, out);
	}
}

/*Read the numeric vector the bw_* selectors take.  R's bw.nrd0() and friends
want a plain numeric x, so a non-number here is an error rather than something
to drop quietly: bw.SJ(c(NA,2,3)) is an error in R too (PR#16024), and silently
dropping it would answer a different question from the one asked.  Returns the
values in the caller's order through *x_out and sorted through *xs_out; the
caller frees both.*/
static void dens_read_x(pTHX_ SV *sv, const char *fname,
                        NV **x_out, NV **xs_out,
                        size_t *n_out)
{
	if (!sv || !SvROK(sv) || SvTYPE(SvRV(sv)) != SVt_PVAV)
		croak("%s: 'x' must be an array reference", fname);
	AV *av = (AV *)SvRV(sv);
	size_t n = (size_t)(av_len(av) + 1);
	if (n < 2) croak("%s: need at least 2 data points", fname);
	NV *x, *xs;
	Newx(x, n, NV);
	for (size_t i = 0; i < n; i++) {
		SV **el = av_fetch(av, i, 0);
		if (!el || !*el || !SvOK(*el) ||
		    !(SvNIOK(*el) || looks_like_number(*el))) {
			Safefree(x);
			croak("%s: 'x' must be numeric and free of missing values", fname);
		}
		x[i] = SvNV(*el);
	}
	Newx(xs, n, NV);
	Copy(x, xs, n, NV);
	qsort(xs, n, sizeof(NV), cmp_nv3);
	*x_out = x; *xs_out = xs; *n_out = n;
}

/*Shared option parsing for bw_ucv() / bw_bcv() / bw_sj(): nb, lower, upper and
tol, each of which R defaults from the data when it is not given.*/
typedef struct {
	size_t nb;
	bool have_lower, have_upper, have_tol;
	NV lower, upper, tol;
	bool ste;                                //bw_sj() only: method = "ste"
} dens_bw_opts;

static void dens_bw_parse(pTHX_ SV **args, Stack_off_t start, Stack_off_t items,
                          const char *fname, bool want_method,
                          dens_bw_opts *o)
{
	o->nb = 1000; o->ste = TRUE;
	o->have_lower = o->have_upper = o->have_tol = FALSE;
	o->lower = o->upper = o->tol = 0.0;
	if (start == 0 && items == 1)     //a lone argument that was not 'x'
		croak("%s: 'x' must be an array reference", fname);
	if ((items - start) % 2 != 0)
		croak("%s: named arguments must come in key => value pairs", fname);
	for (Stack_off_t i = start; i < items; i += 2) {
		const char *key = SvPV_nolen(args[i]);
		SV *val = args[i + 1];
		if      (strEQ(key, "x")) continue;   //already consumed by the caller
		else if (strEQ(key, "nb")) {
			IV nb = SvIV(val);
			if (nb <= 0) croak("%s: invalid 'nb'", fname);
			o->nb = (size_t)nb;
		}
		else if (strEQ(key, "lower")) { o->lower = SvNV(val); o->have_lower = TRUE; }
		else if (strEQ(key, "upper")) { o->upper = SvNV(val); o->have_upper = TRUE; }
		else if (strEQ(key, "tol"))   { o->tol   = SvNV(val); o->have_tol   = TRUE; }
		else if (want_method && strEQ(key, "method")) {
			const char *m = SvPV_nolen(val);
			if      (str_ieq_ascii(m, "ste")) o->ste = TRUE;
			else if (str_ieq_ascii(m, "dpi")) o->ste = FALSE;
			else croak("%s: 'method' must be 'ste' or 'dpi'", fname);
		}
		else croak("%s: unknown argument '%s'", fname, key);
	}
}

/*uniq()'s distinct-value table.

uniq() compares by stringification, so the key it needs from every element is
the one dd_cell() already builds for drop_duplicates(): the text perl would
print. Up to 0.301 those keys went into a perl HV, and that is why
uniq(rnorm(n => 1e6)) took 0.80s where R's unique() takes 0.019 and pandas'
pd.unique() 0.029. Three separate costs, none of them the hashing:

  * SvPV() on an NV runs snprintf("%.*g") at ~270ns a cell -- walking the same
    million SVs without it costs 2ms -- and leaves the rendered buffer on the
    caller's own SV without ever reusing it, so asking a million-element
    column for its distinct values also grew that column by tens of megabytes,
    for good.
  * a perl HV allocates an HE and a copied HEK per distinct key, which is
    ~72MB of scattered small allocations at a million of them.
  * it rehashes every key each time the count passes the bucket count, which
    is seventeen times on the way to a million.

This is dd_ctx instead: the same open-addressed slot array over one arena of
key bytes, presized from the element count, with nk_num_pv() rendering plain
numbers into a stack buffer without touching the SV. Measured by
plot.scaling.pl -- one process per measurement, pinned to one CPU, best of
seven -- 1e6 distinct doubles went from 0.80s to 0.16s; a million-element
column holding ten distinct values, from 0.23s to 0.05s.

What it does *not* do is compare doubles by value. R and pandas hash the eight
bytes of the double and so keep 0.1 + 0.2 apart from 0.3; uniq is documented
to compare the way `eq` and List::Util::uniq do, where both print "0.3" and
collapse. Keeping that promise is what the rendering pass is for, and it is
the whole of the remaining distance to R.*/

/*Whether any byte is outside ASCII, which is what decides whether a UTF-8 key
has to be downgraded below.*/
PERL_STATIC_INLINE bool uniq_high_byte(const char *p, STRLEN n) {
	while (n--) if ((U8)*p++ & 0x80) return TRUE;
	return FALSE;
}

/*Fold one value into the table, and copy it into `out` the first time its key
is seen.  `out` is NULL in scalar context, where only T->ng is wanted.

`scratch` is one reusable SV for the UTF-8 downgrade: hv_common() canonicalises
a UTF-8 key whose every code point is below 256 to bytes before it hashes, so
"\x{e9}" and "\xe9" are one key in a perl hash and have to stay one key here.
A UTF-8 key that is pure ASCII is already its own downgrade, which is the
common case and costs only the scan.  The flag itself is written into the key
as a leading byte rather than kept alongside it, so that the byte string
"\xe2\x98\xba" and the character "\x{263A}" -- byte-identical, and distinct in
a perl hash -- stay distinct here too.*/
PERL_STATIC_INLINE void
uniq_take(pTHX_ dd_ctx *T, SV *sv, AV *out, SV *scratch,
          char *numbuf)
{
	STRLEN klen;
	bool utf8 = FALSE;
	const char *key = nk_num_pv(sv, numbuf, &klen, T->fast_nv);
	if (!key) {                             //not a bare number: perl renders it
		key  = SvPV(sv, klen);
		if (SvUTF8(sv)) {
			if (!uniq_high_byte(key, klen)) {
				utf8 = FALSE;           //pure ASCII is already its own downgrade
			} else {
				sv_setsv(scratch, sv);
				if (sv_utf8_downgrade(scratch, TRUE)) key = SvPV(scratch, klen);
				else                                  utf8 = TRUE;
			}
		}
	}
	{
		const size_t start = T->len;
		const SSize_t before = T->ng;
		dd_reserve(aTHX_ T, klen + 1);  //key points at numbuf, scratch or the
		T->buf[T->len++] = (char)utf8;  //SV, never into the arena it can move
		Copy(key, T->buf + T->len, klen, char);
		T->len += klen;
		(void)dd_intern(aTHX_ T, start, 0);   //first[] goes unused: `out` has the order
		if (out && T->ng != before) av_push(out, newSVsv(sv));
	}
}

/*The R-shaped distribution family: qnorm, pt/qt, pchisq/qchisq, pf/qf, pbinom.

These are glue, not new numerics. Every one is expressed through a routine
already in this file and already cross-validated by the test that needed it --
normal_quantile_hp() (shapiro_test), pt_upper()/qt_tail() (t_test), igam()/
igamc() (chi-square tails), pf_upper() (oneway_test, anova), bt_qbeta() and
bt_pbinom_*() (binom_test) -- so exporting them adds surface, not risk.

Two rules are followed throughout, and both are about the tail nobody watches:

- A tail is never formed as 1 - the other tail. t is symmetric, so pt(q) is
  pt_upper(-q) and qt(p) is -qt_tail(p); incbeta() and igam()/igamc() each
  take the parameter order that makes the requested tail the one they compute
  directly. Subtracting from 1 costs every digit below NV_EPSILON, which is
  exactly the range a p-value is interesting in.
- p outside [0, 1], a non-positive df, and a NaN anywhere all return NaN
  rather than a plausible number, as R does.

log.p is honest in one direction only, and the docs say so. For the q*
functions the argument is a log probability and exp() of it is exact enough to
reach quantiles the linear scale cannot name. For the p* functions the answer
is log() of the probability already computed, so a tail that underflowed to 0
logs to -Inf instead of reporting -800; R's own pt/pchisq/pf carry log_p
through the series and can. pnorm() is the exception and does carry it through
(c_pnorm's log_p), because R's Cody algorithm was ported whole.

Accuracy is bounded by those underlying routines, which converge on a relative
1e-15 term cutoff regardless of NV width -- the same situation c_pnorm's
double-precision port is already documented as having. So these agree with R to
about 1e-14 relative on a double, long-double and __float128 build alike, and
the tolerances in t/distributions.R.scipy.t are set from the worst observed
disagreement rather than from the NV width.*/

#define DIST_MAX_PAR 2

/*One shape for all eight: x (or p) first, then up to two distribution
parameters, then the two flags. par[] is in the order the signature names
them, so d_pf() reads par[0] as df1 and par[1] as df2.*/
typedef NV (*dist_fn)(NV x, const NV *par, bool lower, bool give_log);

typedef struct {
	const char *name;                          //for croak() and warn()
	const char *par_name[DIST_MAX_PAR];
	NV          par_default[DIST_MAX_PAR];
	unsigned short int npar;                   //how many parameters exist
	unsigned short int nrequired;              //how many have no default
	dist_fn fn;
} dist_spec;

static NV dist_log(NV p, bool give_log) {
	return give_log ? nv_log(p) : p;
}

static NV d_qnorm(NV p, const NV *par, bool lower, bool give_log) {
	const NV mean = par[0], sd = par[1];
	if (give_log) p = nv_exp(p);
	if (nv_isnan(p) || p < 0.0 || p > 1.0)   return NV_NAN;
	if (nv_isnan(mean) || nv_isnan(sd))      return NV_NAN;
	if (sd < 0.0)                            return NV_NAN;
	if (p == 0.0) return lower ? -NV_INF :  NV_INF;
	if (p == 1.0) return lower ?  NV_INF : -NV_INF;
	if (sd == 0.0) return mean;              //a step at the mean, as pnorm has
	/*std_qnorm() inverts the lower tail, and carries the reflection that keeps
	that accurate above p = 0.5; the standard normal is symmetric, so the
	upper-tail quantile is its negation.*/
	const NV z = std_qnorm(p);
	return mean + sd * (lower ? z : -z);
}

static NV d_pt(NV q, const NV *par, bool lower, bool give_log) {
	const NV df = par[0];
	if (nv_isnan(q) || nv_isnan(df)) return NV_NAN;
	if (!(df > 0.0))                 return NV_NAN;
	return dist_log(pt_upper(lower ? -q : q, df), give_log);
}

static NV d_qt(NV p, const NV *par, bool lower, bool give_log) {
	const NV df = par[0];
	if (give_log) p = nv_exp(p);
	if (nv_isnan(p) || p < 0.0 || p > 1.0) return NV_NAN;
	if (nv_isnan(df) || !(df > 0.0))       return NV_NAN;
	return lower ? -qt_tail(df, p) : qt_tail(df, p);
}

static NV d_pchisq(NV q, const NV *par, bool lower, bool give_log) {
	const NV df = par[0];
	if (nv_isnan(q) || nv_isnan(df)) return NV_NAN;
	if (!(df > 0.0))                 return NV_NAN;
	if (q <= 0.0)    return dist_log(lower ? 0.0 : 1.0, give_log);
	if (nv_isinf(q)) return dist_log(lower ? 1.0 : 0.0, give_log);
	return dist_log(lower ? igam(df / 2.0, q / 2.0)
	                      : igamc(df / 2.0, q / 2.0), give_log);
}

/*qchisq by safeguarded bisection on whichever tail was asked for, so the
inverse never inherits a 1 - p either.

1200 iterations and a relative stop, both for bt_qbeta()'s reason: the root of
a lower tail of 1e-300 sits that far below 1 and a bracket that starts at
[0, 1] only reaches it by halving, ~3.3 steps per decade. The 1e-15 width is
not a guess -- it is where igam()/igamc() stop being able to tell two
candidates apart, since their own series and continued fraction both cut off
at a relative 1e-15. Bisecting past that refines noise.*/
static NV qchisq_solve(NV p, NV df, bool lower) {
	NV lo = 0.0, hi = 1.0;
	while (hi < NV_MAX / 4.0) {
		const NV v = lower ? igam(df / 2.0, hi / 2.0) : igamc(df / 2.0, hi / 2.0);
		if (lower ? (v >= p) : (v <= p)) break;
		lo = hi;
		hi *= 2.0;
	}
	for (unsigned short int i = 0; i < 1200; i++) {
		const NV mid = 0.5 * (lo + hi);
		if (!(mid > lo && mid < hi)) break;      //lo and hi are neighbours
		const NV v = lower ? igam(df / 2.0, mid / 2.0) : igamc(df / 2.0, mid / 2.0);
		if (lower ? (v < p) : (v > p)) lo = mid; else hi = mid;
		if (hi - lo <= 1e-15 * hi) break;
	}
	return 0.5 * (lo + hi);
}

static NV d_qchisq(NV p, const NV *par, bool lower, bool give_log) {
	const NV df = par[0];
	if (give_log) p = nv_exp(p);
	if (nv_isnan(p) || p < 0.0 || p > 1.0) return NV_NAN;
	if (nv_isnan(df) || !(df > 0.0))       return NV_NAN;
	if (p == 0.0) return lower ? 0.0 : NV_INF;
	if (p == 1.0) return lower ? NV_INF : 0.0;
	/*Always bisect against the tail below 0.5. Above it the comparison inside
	qchisq_solve() is between two numbers near 1, which is what cost 7.3e-12
	relative at p = 1 - 2^-16 on df = 1; reflected, both sides are small and
	the only error left is the ulp that 1 - p rounds away -- the resolution the
	caller's p already had. The tail swap is exact: the chi-square quantile at
	lower-tail p is the one at upper-tail 1 - p.*/
	if (p > 0.5) return qchisq_solve(1.0 - p, df, !lower);
	return qchisq_solve(p, df, lower);
}

static NV d_pf(NV q, const NV *par, bool lower, bool give_log) {
	const NV df1 = par[0], df2 = par[1];
	if (nv_isnan(q) || nv_isnan(df1) || nv_isnan(df2))   return NV_NAN;
	if (!(df1 > 0.0) || !(df2 > 0.0))                    return NV_NAN;
	if (!lower) return dist_log(pf_upper(q, df1, df2), give_log);
	if (q <= 0.0)    return dist_log(0.0, give_log);
	if (nv_isinf(q)) return dist_log(1.0, give_log);
	const NV denom = df1 * q + df2;
	if (nv_isinf(denom)) return dist_log(1.0, give_log);  //the tail is 1 anyway
	return dist_log(incbeta(df1 / 2.0, df2 / 2.0, df1 * q / denom), give_log);
}

/*Solve I_t(a, b) = p for t, returning t AND 1 - t, each to full relative
precision, in *t_out and *comp_out.

Both are needed because every F quantile is (df2/df1) * t/(1 - t), and a t
returned alone is useless for a large quantile: bt_qbeta() gives t = 0.99999984
at p = 1 - 2^-16, and 1 - t then keeps seven digits of the fifteen the answer
wants.

So above the median the whole problem is reflected instead, using
I_t(a, b) = 1 - I_{1-t}(b, a): solving I_u(b, a) = 1 - p for u makes the SMALL
side the bisection variable, so bt_qbeta() resolves it relatively and t = 1 - u
is 1 minus something small. Reflecting costs the one ulp that 1 - p rounds
away, which is the resolution the caller's p already had -- and for a dyadic p
costs nothing at all. Bisecting for u against incbeta(a, b, 1 - u) instead
looks like it avoids that ulp but does not: forming 1 - u inside the loop
throws away exactly the low bits of u that the bisection is trying to find, and
measured 6.7e-8 relative on qf(1 - 2^-16, 1, 1) where this reflection is exact.

The branch is taken on p, not on where the root sits. Those are different
tests and only the first is right, because the bisection's own comparison is
between probabilities: with p <= 0.5 it compares small numbers, and above it
compares numbers near 1 and loses the low bits of the root. Deciding by the
root instead -- reflect when the root is above the median -- sent
qf(2^-20, 10, 100, upper) into bt_qbeta(1 - 2^-20, 5, 50), where every
comparison is against 0.99999905, for a measured 3.7e-12.

Nor do the two bad cases overlap, which is why one test is enough: a root close
enough to 1 for 1 - t to lose digits needs a p close to 1, and that p is
reflected away first.*/
static void qbeta_both(NV p, NV a, NV b,
                       NV *t_out, NV *comp_out) {
	if (p <= 0.5) {
		const NV t = bt_qbeta(p, a, b);
		*t_out    = t;
		*comp_out = 1.0 - t;
		return;
	}
	const NV u = bt_qbeta(1.0 - p, b, a);
	*t_out    = 1.0 - u;
	*comp_out = u;
}

static NV d_qf(NV p, const NV *par, bool lower, bool give_log) {
	const NV df1 = par[0], df2 = par[1];
	NV t, comp;
	if (give_log) p = nv_exp(p);
	if (nv_isnan(p) || p < 0.0 || p > 1.0)             return NV_NAN;
	if (nv_isnan(df1) || nv_isnan(df2))                return NV_NAN;
	if (!(df1 > 0.0) || !(df2 > 0.0))                  return NV_NAN;
	if (p == 0.0) return lower ? 0.0 : NV_INF;
	if (p == 1.0) return lower ? NV_INF : 0.0;
	/*F = (df2/df1) * t/(1 - t). Each tail hands qbeta_both() the parameter
	order that makes p its own probability -- the upper tail of F is
	I_t(df2/2, df1/2), which is exactly what pf_upper() computes -- so neither
	branch forms 1 - p, and qbeta_both() keeps 1 - t from being formed by
	subtraction either.*/
	if (lower) {
		qbeta_both(p, df1 / 2.0, df2 / 2.0, &t, &comp);
		if (!(comp > 0.0)) return NV_INF;
		return (df2 / df1) * t / comp;
	}
	qbeta_both(p, df2 / 2.0, df1 / 2.0, &t, &comp);
	if (!(t > 0.0)) return NV_INF;
	return (df2 / df1) * comp / t;
}

static NV d_pbinom(NV q, const NV *par, bool lower, bool give_log) {
	const NV size = par[0], prob = par[1];
	if (nv_isnan(q) || nv_isnan(size) || nv_isnan(prob))     return NV_NAN;
	if (size < 0.0 || size != nv_floor(size))                return NV_NAN;
	if (prob < 0.0 || prob > 1.0)                            return NV_NAN;
	/*floor(x + 1e-7), which is R's own fudge in nmath/pbinom.c: it keeps
	pbinom(3, ...) from answering for 2 when 3 arrived as 2.9999999999999996.*/
	const NV k = nv_floor(q + 1e-7);
	if (k < 0.0)      return dist_log(lower ? 0.0 : 1.0, give_log);
	if (k >= size)    return dist_log(lower ? 1.0 : 0.0, give_log);
	/*bt_pbinom_*() index with long. Past LONG_MAX the answer is one of the two
	constants above for anything a caller could actually pass, but say NaN
	rather than wrap the cast.*/
	if (size > (NV)LONG_MAX) return NV_NAN;
	const long kl = (long)k, nl = (long)size;
	return dist_log(lower ? bt_pbinom_lower(kl, nl, prob)
	                      : bt_pbinom_upper(kl, nl, prob), give_log);
}

/*Read one distribution call off the stack: x first, then this function's
parameters positionally or by name, then lower/log.

Positional and named are both accepted because R is called both ways --
pt(2.5, 10) and pt(2.5, df = 10) are the same call there. A positional
parameter is consumed only while one is still unfilled and the argument is not
the name of one of this function's own options, so pf(3, 2, 10) fills df1 and
df2 while pf(3, df2 => 10, df1 => 2) names them in either order.*/
static void dist_parse(pTHX_ const dist_spec *spec, SV **st,
                       Stack_off_t items, SV **x_out,
                       NV *par, bool *lower,
                       bool *give_log) {
	unsigned short int filled = 0;
	Stack_off_t i;
	bool seen[DIST_MAX_PAR];

	if (items < 1)
		croak("Usage: %s(x%s%s)", spec->name,
		      spec->npar ? ", " : "", spec->npar ? spec->par_name[0] : "");
	*x_out    = st[0];
	*lower    = TRUE;
	*give_log = FALSE;
	for (i = 0; i < (Stack_off_t)spec->npar; i++) {
		par[i]  = spec->par_default[i];
		seen[i] = FALSE;
	}

	i = 1;
	while (i < items) {
		const char *key = NULL;
		//A positional parameter: something left to fill, and not an option name
		if (filled < spec->npar && SvOK(st[i])) {
			bool is_name = FALSE;
			key = SvPV_nolen(st[i]);
			for (unsigned short int j = 0; j < spec->npar; j++)
				if (strEQ(key, spec->par_name[j])) is_name = TRUE;
			if (strEQ(key, "lower") || strEQ(key, "lower.tail")
			 || strEQ(key, "log")   || strEQ(key, "log.p")) is_name = TRUE;
			if (!is_name) {
				par[filled]  = SvNV(st[i]);
				seen[filled] = TRUE;
				filled++;
				i++;
				continue;
			}
		}
		if (i + 1 >= items)
			croak("%s: '%s' was given with no value", spec->name,
			      SvOK(st[i]) ? SvPV_nolen(st[i]) : "(undef)");
		key = SvPV_nolen(st[i]);
		if      (strEQ(key, "lower") || strEQ(key, "lower.tail"))
			*lower = SvTRUE(st[i + 1]) ? TRUE : FALSE;
		else if (strEQ(key, "log") || strEQ(key, "log.p"))
			*give_log = SvTRUE(st[i + 1]) ? TRUE : FALSE;
		else {
			bool matched = FALSE;
			for (unsigned short int j = 0; j < spec->npar; j++) {
				if (!strEQ(key, spec->par_name[j])) continue;
				par[j]  = SvNV(st[i + 1]);
				seen[j] = TRUE;
				matched = TRUE;
				if (j + 1 > filled) filled = (unsigned short int)(j + 1);
			}
			if (!matched) croak("%s: unknown argument '%s'", spec->name, key);
		}
		i += 2;
	}
	for (unsigned short int j = 0; j < spec->nrequired; j++)
		if (!seen[j])
			croak("%s: '%s' is required", spec->name, spec->par_name[j]);
}

/*Apply spec->fn over x, which is a number or an array reference, and return a
number or an array reference to match -- the shape contract pnorm() already
has. An undef element is NaN, as it is there.*/
static SV *dist_apply(pTHX_ const dist_spec *spec, SV *x,
                      const NV *par, bool lower, bool give_log) {
	if (SvROK(x) && SvTYPE(SvRV(x)) == SVt_PVAV) {
		AV *in  = (AV *)SvRV(x);
		AV *out = newAV();
		const SSize_t n = av_len(in) + 1;
		if (n > 0) av_extend(out, n - 1);
		for (SSize_t i = 0; i < n; i++) {
			SV **e = av_fetch(in, i, 0);
			const NV v = (e && *e && SvOK(*e)) ? SvNV(*e) : NV_NAN;
			av_store(out, i, newSVnv(spec->fn(v, par, lower, give_log)));
		}
		return newRV_noinc((SV *)out);
	}
	return newSVnv(spec->fn(SvOK(x) ? SvNV(x) : NV_NAN, par, lower, give_log));
}

// XS SECTION
MODULE = Stats::LikeR  PACKAGE = Stats::LikeR

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;

SV *_cols_select(df, shape, spec)
	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;
			if (rv && SvROK(rv) && SvTYPE(SvRV(rv)) == SVt_PVHV)
				inner = row_rename(aTHX_ (HV *)SvRV(rv), map_hv);
			else
				inner = row_rename(aTHX_ NULL, map_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

# Union of the column names over an AoH's rows, in first-seen order.  Same scan
# as _present_keys, but the Perl loop it replaces walked every key of every row
# through the interpreter and cost more than the de-duplication itself on a
# large frame.  As in _present_keys, a row that is not a plain (unblessed) hash
# ref contributes nothing.  The HeHASH of a key is reused so no key is hashed
# twice -- except for a UTF-8 key, where hv_store may canonicalise the bytes
# first and the stored hash would then be the wrong one.
SV *
_aoh_key_union(df)
	SV *df
  PREINIT:
	AV *src; AV *out; HV *seen; SSize_t i, R;
  CODE:
{
	src   = (AV *)SvRV(df);
	R     = av_len(src) + 1;
	out   = newAV();
	seen  = (HV *)sv_2mortal((SV *)newHV());
	for (i = 0; i < R; i++) {
		SV *rv = av_row_at(aTHX_ src, i);
		if (!rv) continue;
		HV *row = (HV *)SvRV(rv);
		if (SvOBJECT((SV *)row)) continue;
		HE *he; hv_iterinit(row);
		while ((he = hv_iternext(row))) {
			STRLEN kl; char *kp = HePV(he, kl);
			const bool u8 = cBOOL(HeUTF8(he));
			const SSize_t before = HvUSEDKEYS(seen);
			(void)hv_store(seen, kp, u8 ? -(I32)kl : (I32)kl,
			               SvREFCNT_inc_simple_NN(&PL_sv_yes), u8 ? 0 : HeHASH(he));
			if (HvUSEDKEYS(seen) != before)     //first sighting of this name
				av_push(out, newSVpvn_flags(kp, kl, u8 ? SVf_UTF8 : 0));
		}
	}
	RETVAL = newRV_noinc((SV *)out);
}
  OUTPUT:
	RETVAL

# Row-level de-duplication core for drop_duplicates().  The Perl wrapper
# validates the frame, rejects HoH, and resolves `subset` into an ordered
# list of column identifiers (integer positions for AoA, names for AoH/HoA).
#   shape: 1 = AoH, 3 = AoA, 4 = HoA
#   subset: arrayref of the columns whose cells define a row's identity
#   keep:  1 = first occurrence, -1 = last occurrence, 0 = drop every dup
# survivors are shared, not deep-copied: AoA/AoH reuse the original row refs
# (like dropna), HoA builds new column arrays over the same cell SVs.
#
# One pass over the rows interns each row key (see dd_intern) and that is all
# the bookkeeping any of the three `keep` modes needs, because groups are
# created in row order: T.first[] -- the row that first showed each distinct
# key -- therefore comes out already sorted, and IS the survivor list.
#   keep ==  1  every T.first[g], as is
#   keep == -1  the rows are walked backwards, so T.first[g] is each key's LAST
#               occurrence and the list only has to be reversed
#   keep ==  0  the groups seen exactly once, filtered in place
# So nothing is allocated per input row: the pass costs one copy of each
# distinct key plus a handful of words per distinct row.
SV *
_drop_dups_core(df, shape, subset, keep)
	SV *df
	IV shape
	SV *subset
	IV keep
  PREINIT:
	SV *retval; AV *sub_av; SSize_t ns, i, j, R = 0, nsurv = 0;
	SSize_t *surv; dd_ctx *T;
  CODE:
{
	sub_av = (AV *)SvRV(subset);
	ns = av_len(sub_av) + 1;
	ENTER;                          //everything below is freed on croak too
	Newxz(T, 1, dd_ctx);
	SAVEDESTRUCTOR_X(dd_ctx_free, T);
	T->use_cnt = (keep == 0);
	T->fast_nv = nk_fast_nv_ok(aTHX);

	if (shape == 3) { // ---- AoA ----
		AV *src = (AV *)SvRV(df);
		R = av_len(src) + 1;
		dd_presize(aTHX_ T, R);
		Newx(T->pos, ns > 0 ? ns : 1, IV);
		for (j = 0; j < ns; j++) T->pos[j] = SvIV(AvARRAY(sub_av)[j]);
		for (SSize_t r = 0; r < R; r++) {
			i = keep == -1 ? R - 1 - r : r;    //backwards == keep last
			SV *rv = av_ref_at(aTHX_ src, i, SVt_PVAV);
			AV *inner = rv ? (AV *)SvRV(rv) : NULL;
			const size_t start = T->len;
			for (j = 0; j < ns; j++)
				dd_cell(aTHX_ T, av_at(aTHX_ inner, (SSize_t)T->pos[j]));
			const SSize_t g = dd_intern(aTHX_ T, start, i);
			if (T->use_cnt) T->cnt[g]++;
		}
	} else if (shape == 1) { // ---- AoH ----
		AV *src = (AV *)SvRV(df);
		SV **names = AvARRAY(sub_av);
		R = av_len(src) + 1;
		dd_presize(aTHX_ T, R);
		for (SSize_t r = 0; r < R; r++) {
			i = keep == -1 ? R - 1 - r : r;
			SV *rv = av_row_at(aTHX_ src, i);
			HV *inner = rv ? (HV *)SvRV(rv) : NULL;
			const size_t start = T->len;
			for (j = 0; j < ns; j++) {
				HE *he = inner ? hv_fetch_ent(inner, names[j], 0, 0) : NULL;
				dd_cell(aTHX_ T, he ? HeVAL(he) : NULL);
			}
			const SSize_t g = dd_intern(aTHX_ T, start, i);
			if (T->use_cnt) T->cnt[g]++;
		}
	} else { // ---- HoA ----
		HV *src = (HV *)SvRV(df);
		HE *he; hv_iterinit(src);
		while ((he = hv_iternext(src))) { // R = longest column
			SV *v = HeVAL(he);
			if (SvROK(v) && SvTYPE(SvRV(v)) == SVt_PVAV) {
				SSize_t l = av_len((AV *)SvRV(v)) + 1;
				if (l > R) R = l;
			}
		}
		dd_presize(aTHX_ T, R);
		Newx(T->cols, ns > 0 ? ns : 1, AV *);
		for (j = 0; j < ns; j++) {
			HE *ce = hv_fetch_ent(src, AvARRAY(sub_av)[j], 0, 0);
			T->cols[j] = (ce && SvROK(HeVAL(ce)) && SvTYPE(SvRV(HeVAL(ce))) == SVt_PVAV)
			        ? (AV *)SvRV(HeVAL(ce)) : NULL;
		}
		for (SSize_t r = 0; r < R; r++) {
			i = keep == -1 ? R - 1 - r : r;
			const size_t start = T->len;
			for (j = 0; j < ns; j++) dd_cell(aTHX_ T, av_at(aTHX_ T->cols[j], i));
			const SSize_t g = dd_intern(aTHX_ T, start, i);
			if (T->use_cnt) T->cnt[g]++;
		}
	}
	//the keys have done their job; only first[]/cnt[] are still needed
	Safefree(T->buf);   T->buf   = NULL; T->len = T->cap = 0;
	Safefree(T->off);   T->off   = NULL;
	Safefree(T->khash); T->khash = NULL;
	Safefree(T->slot);  T->slot  = NULL; T->nslot = 0;
	Safefree(T->pos);   T->pos   = NULL;
	Safefree(T->cols);  T->cols  = NULL;

	// the surviving row positions, in input order
	surv  = T->first;
	nsurv = T->ng;
	if (keep == -1) {                       //rows were walked backwards
		for (i = 0, j = nsurv - 1; i < j; i++, j--) {
			const SSize_t t = surv[i]; surv[i] = surv[j]; surv[j] = t;
		}
	} else if (keep == 0) {                 //drop every duplicated row
		nsurv = 0;
		for (i = 0; i < T->ng; i++) if (T->cnt[i] == 1) surv[nsurv++] = surv[i];
	}

	// materialise the survivors back into the input's shape
	if (shape == 4) { // ---- HoA ----
		HV *src = (HV *)SvRV(df);
		HV *out = newHV();
		HE *he; hv_iterinit(src);
		while ((he = hv_iternext(src))) {
			SV *v = HeVAL(he);
			AV *col = (SvROK(v) && SvTYPE(SvRV(v)) == SVt_PVAV) ? (AV *)SvRV(v) : NULL;
			/*A tied column has no cell SVs to share: what av_at() hands back
			is the mortal PVLV the tie fetches through, so those columns are
			copied instead.  It is the one place the sharing rule below cannot
			hold, and copying is the only reading of it that can be true.*/
			const bool tied = col && cBOOL(SvRMAGICAL(col));
			AV *nc = newAV();
			if (nsurv > 0) {
				av_extend(nc, nsurv - 1);
				SV **na = AvARRAY(nc);
				/*share the surviving cells rather than copying them, which
				is what AoA/AoH already do by reusing the whole row ref: one
				refcount bump instead of an SV (and, for a numeric cell, a
				PV buffer) per surviving cell.  Mutating a cell of the result
				therefore reaches the input, exactly as mutating a kept
				AoA/AoH row does; the frame itself is still new.*/
				for (SSize_t k = 0; k < nsurv; k++) {
					SV *c = av_at(aTHX_ col, surv[k]);
					na[k] = !c    ? newSV(0)
					      : tied  ? newSVsv(c)
					              : SvREFCNT_inc_simple_NN(c);
					AvFILLp(nc) = k;	//owned from here: a croak below frees it
				}
			}
			STRLEN kl; char *kp = HePV(he, kl); I32 sk = HeUTF8(he) ? -(I32)kl : (I32)kl;
			(void)hv_store(out, kp, sk, newRV_noinc((SV *)nc), HeHASH(he));
		}
		retval = sv_2mortal(newRV_noinc((SV *)out));
	} else { // AoA / AoH
		AV *src = (AV *)SvRV(df);
		AV *out = newAV();
		if (nsurv > 0) {
			av_extend(out, nsurv - 1);
			SV **oa = AvARRAY(out);
			for (SSize_t k = 0; k < nsurv; k++) {
				/*newSVsv of the reference, not of the row: a new RV to the
				row the input holds, which is the sharing the docs promise and
				is also what un-mortalises a tied array's PVLV.*/
				SV *rv = av_at(aTHX_ src, surv[k]);
				oa[k] = newSVsv(rv ? rv : &PL_sv_undef);
				AvFILLp(out) = k;
			}
		}
		retval = sv_2mortal(newRV_noinc((SV *)out));
	}
	RETVAL = SvREFCNT_inc(retval);
	LEAVE;                                  //dd_ctx_free releases the rest
}
  OUTPUT:
	RETVAL

void anova(...)
	PROTOTYPE: $@
	PREINIT:
		SV *data;
		char *lhs = NULL, *rhs = NULL;
		HV *hoa = NULL, *result = NULL;
		HV **rows = NULL;
		AnTerm *terms = NULL;
		AnFac  *facs  = NULL;
		size_t nterms = 0, tcap = 0, nfac = 0, fcap = 0;
		bool *complete = NULL, *aliased = NULL;
		size_t *ridx = NULL, *rank_map = NULL;
		size_t n = 0, n_used = 0, p, rank;
		NV **X = NULL, *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 **lhss = NULL, **rhss = NULL;
			Newxz(lhss, nform, char*);
			Newxz(rhss, nform, char*);

			//---- parse every formula
			for (size_t fi = 0; fi < nform; fi++) {
				SV *fsv = ST(1 + fi);
				if (!(SvPOK(fsv) || SvOK(fsv))) {
					anova_free_formulas(aTHX_ lhss, rhss, nform);
					croak("anova: model argument %" UVuf " must be a formula string", (UV)(fi + 1));
				}
				if (!parse_formula(SvPV_nolen(fsv), &lhss[fi], &rhss[fi])) {
					anova_free_formulas(aTHX_ lhss, rhss, nform);
					croak("anova: could not parse formula %" UVuf " (need 'response ~ terms')", (UV)(fi + 1));
				}
			}
// ---- resolve data form + row count (response 1 length)
			if (!SvROK(data)) {
				anova_free_formulas(aTHX_ lhss, rhss, nform);
				croak("anova: first argument must be a hash or array reference");
			}
			{
				SV *rv = SvRV(data);
				if (SvTYPE(rv) == SVt_PVHV) {
					hoa = (HV*)rv;
					SV **col = hv_fetch(hoa, lhss[0], (I32)strlen(lhss[0]), 0);
					if (col && SvROK(*col) && SvTYPE(SvRV(*col)) == SVt_PVAV)
						n = (size_t)(av_len((AV*)SvRV(*col)) + 1);
					else {
						hv_iterinit(hoa);
						HE *e;
						while ((e = hv_iternext(hoa))) {
							SV *v = hv_iterval(hoa, e);
							if (SvROK(v) && SvTYPE(SvRV(v)) == SVt_PVAV) {
								size_t l = (size_t)(av_len((AV*)SvRV(v)) + 1);
								if (l > n) n = l;
							}
						}
					}
				} else if (SvTYPE(rv) == SVt_PVAV) {
					AV *top = (AV*)rv;
					n = (size_t)(av_len(top) + 1);
					Newx(rows, n ? n : 1, HV*);
					for (size_t i = 0; i < n; i++) {
						SV **ep = av_fetch(top, i, 0);
						if (!(ep && SvROK(*ep) && SvTYPE(SvRV(*ep)) == SVt_PVHV)) {
							Safefree(rows);
							anova_free_formulas(aTHX_ lhss, rhss, nform);
							croak("anova: element %" UVuf " is not a hash reference", (UV)i);
						}
						rows[i] = (HV*)SvRV(*ep);
					}
				} else {
					anova_free_formulas(aTHX_ lhss, rhss, nform);
					croak("anova: first argument must be a hash or array reference");
				}
			}
// union factor registry across all formulas
			{
				AnFac *ufacs = NULL; size_t unfac = 0, ufcap = 0;
				for (size_t fi = 0; fi < nform; fi++) {
					AnTerm *tt = NULL; size_t ntt = 0, ttcap = 0;
					anova_expand_rhs(aTHX_ rhss[fi], &tt, &ntt, &ttcap);
					for (size_t t = 0; t < ntt; t++)
						for (size_t j = 0; j < tt[t].nf; j++)
							(void)anova_fac(aTHX_ &ufacs, &unfac, &ufcap, hoa, rows, n, tt[t].factors[j]);
					anova_free_terms(aTHX_ tt, ntt);
				}
// ---- listwise completeness over the union */
				Newx(complete, n ? n : 1, bool);
				n_used = 0;
				for (size_t i = 0; i < n; i++) {
					bool ok = TRUE;
					for (size_t fi = 0; ok && fi < nform; fi++)
						if (!nv_isfinite(evaluate_term(aTHX_ hoa, rows, (unsigned)i, lhss[fi]))) ok = FALSE;
					for (size_t f = 0; ok && f < unfac; f++) {
						if (ufacs[f].is_cat) {
							char *sv = get_data_string_alloc(aTHX_ hoa, rows, i, ufacs[f].name);
							if (!sv) ok = FALSE; else Safefree(sv);
						} else if (!nv_isfinite(evaluate_term(aTHX_ hoa, rows, (unsigned)i, ufacs[f].name))) {
							ok = FALSE;
						}
					}
					complete[i] = ok;
					if (ok) n_used++;
				}
				anova_free_facs(aTHX_ ufacs, unfac);
			}

			if (n_used < 2) {
				Safefree(complete); Safefree(rows);
				anova_free_formulas(aTHX_ lhss, rhss, nform);
				croak("anova: fewer than 2 complete observations after dropping NA");
			}

			Newx(ridx, n_used, size_t);
			{ size_t r = 0; for (size_t i = 0; i < n; i++) if (complete[i]) ridx[r++] = i; }
// fit every model on the shared row set
			{
				NV *mrss = NULL; IV *mresdf = NULL;
				Newx(mrss,   nform, NV);
				Newx(mresdf, nform, IV);
				for (size_t fi = 0; fi < nform; fi++) {
					NV rss_i; size_t rank_i;
					if (!anova_fit_one(aTHX_ hoa, rows, n, complete, ridx, n_used,
					                   lhss[fi], rhss[fi], &rss_i, &rank_i)) {
						Safefree(mrss); Safefree(mresdf);
						Safefree(ridx); Safefree(complete); Safefree(rows);
						anova_free_formulas(aTHX_ lhss, rhss, nform);
						croak("anova: formula %" UVuf " has no predictor terms", (UV)(fi + 1));
					}
					mrss[fi]   = rss_i;
					mresdf[fi] = (IV)n_used - (IV)rank_i;
				}
				/*common scale = residual MS of the largest model
				(smallest residual df), exactly as R's anova.lmlist.*/
				size_t big = 0;
				for (size_t fi = 1; fi < nform; fi++)
					if (mresdf[fi] < mresdf[big]) big = fi;
				NV scale  = (mresdf[big] > 0) ? mrss[big] / (NV)mresdf[big] : NAN;
				IV df_big = mresdf[big];
				// one row per model, in supplied order
				AV *table = newAV();
				for (size_t fi = 0; fi < nform; fi++) {
					HV *row = newHV();
					(void)hv_store(row, "Res.Df", 6, newSViv(mresdf[fi]), 0);
					(void)hv_store(row, "RSS",    3, newSVnv(mrss[fi]),   0);
					(void)hv_store(row, "formula", 7,
					               newSVpvf("%s ~ %s", lhss[fi], rhss[fi]), 0);
					if (fi > 0) {
						IV ddf = mresdf[fi - 1] - mresdf[fi];
						NV dss = mrss[fi - 1] - mrss[fi];
						(void)hv_store(row, "Df", 2, newSViv(ddf), 0);
						(void)hv_store(row, "Sum of Sq", 9, newSVnv(dss), 0);
						if (ddf > 0 && nv_isfinite(scale) && scale > 0.0) {
							NV F = (dss / (NV)ddf) / scale;
							(void)hv_store(row, "F", 1, newSVnv(F), 0);
							(void)hv_store(row, "Pr(>F)", 6,
							               newSVnv(pf_upper(F, (NV)ddf, (NV)df_big)), 0);
						}
					}
					av_push(table, newRV_noinc((SV*)row));
				}

				Safefree(mrss); Safefree(mresdf);
				Safefree(ridx); Safefree(complete); Safefree(rows);
				anova_free_formulas(aTHX_ lhss, rhss, nform);

				XPUSHs(sv_2mortal(newRV_noinc((SV*)table)));
			}
		} else {// single-model Type-I table */
			if (!(SvPOK(ST(1)) || SvOK(ST(1))))
				croak("anova: second argument must be a formula string");
			if (!parse_formula(SvPV_nolen(ST(1)), &lhs, &rhs))
				croak("anova: could not parse formula (need 'response ~ terms')");
			// ---- resolve data form + row count
			if (!SvROK(data)) { safefree(lhs); safefree(rhs); croak("anova: first argument must be a hash or array reference"); }
			{
				SV *rv = SvRV(data);
				if (SvTYPE(rv) == SVt_PVHV) {
					hoa = (HV*)rv;
					SV **col = hv_fetch(hoa, lhs, (I32)strlen(lhs), 0);
					if (col && SvROK(*col) && SvTYPE(SvRV(*col)) == SVt_PVAV)
						n = (size_t)(av_len((AV*)SvRV(*col)) + 1);
					else {
// response may be an expression; fall back to longest column
						hv_iterinit(hoa);
						HE *e;
						while ((e = hv_iternext(hoa))) {
							SV *v = hv_iterval(hoa, e);
							if (SvROK(v) && SvTYPE(SvRV(v)) == SVt_PVAV) {
								size_t l = (size_t)(av_len((AV*)SvRV(v)) + 1);
								if (l > n) n = l;
							}
						}
					}
				} else if (SvTYPE(rv) == SVt_PVAV) {
					AV *top = (AV*)rv;
					n = (size_t)(av_len(top) + 1);
					Newx(rows, n ? n : 1, HV*);
					for (size_t i = 0; i < n; i++) {
						SV **ep = av_fetch(top, i, 0);
						if (!(ep && SvROK(*ep) && SvTYPE(SvRV(*ep)) == SVt_PVHV)) {
							Safefree(rows); safefree(lhs); safefree(rhs);
							croak("anova: element %" UVuf " is not a hash reference", (UV)i);
						}
						rows[i] = (HV*)SvRV(*ep);
					}
				} else {
					safefree(lhs); safefree(rhs);
					croak("anova: first argument must be a hash or array reference");
				}
			}
			//expand RHS into ordered, de-duplicated terms
			anova_expand_rhs(aTHX_ rhs, &terms, &nterms, &tcap);
			if (nterms == 0) {
				anova_free_terms(aTHX_ terms, nterms); Safefree(rows);
				safefree(lhs); safefree(rhs);
				croak("anova: formula has no predictor terms");
			}
			//factor registry + per-term factor indices
			for (size_t t = 0; t < nterms; t++) {
				Newx(terms[t].fi, terms[t].nf, size_t);
				for (size_t j = 0; j < terms[t].nf; j++)
					terms[t].fi[j] = anova_fac(aTHX_ &facs, &nfac, &fcap, hoa, rows, n, terms[t].factors[j]);
			}
			// listwise completeness
			Newx(complete, n ? n : 1, bool);
			n_used = 0;
			for (size_t i = 0; i < n; i++) {
				bool ok = nv_isfinite(evaluate_term(aTHX_ hoa, rows, (unsigned)i, lhs)) ? TRUE : FALSE;
				for (size_t f = 0; ok && f < nfac; f++) {
					if (facs[f].is_cat) {
						char *sv = get_data_string_alloc(aTHX_ hoa, rows, i, facs[f].name);
						if (!sv) ok = FALSE; else Safefree(sv);
					} else if (!nv_isfinite(evaluate_term(aTHX_ hoa, rows, (unsigned)i, facs[f].name))) {
						ok = FALSE;
					}
				}
				complete[i] = ok;
				if (ok) n_used++;
			}
			if (n_used < 2) {
				anova_free_terms(aTHX_ terms, nterms);
				anova_free_facs(aTHX_ facs, nfac);
				Safefree(complete); Safefree(rows); safefree(lhs); safefree(rhs);
				croak("anova: fewer than 2 complete observations after dropping NA");
			}
			Newx(ridx, n_used, size_t);
			{ size_t r = 0; for (size_t i = 0; i < n; i++) if (complete[i]) ridx[r++] = i; }

			//factor widths + coded columns
			for (size_t f = 0; f < nfac; f++) {
				if (facs[f].is_cat) {
					facs[f].nlv = anova_levels(aTHX_ hoa, rows, n, complete, facs[f].name, &facs[f].lv);
					facs[f].width = facs[f].nlv > 1 ? facs[f].nlv - 1 : 0;
				} else {
					facs[f].width = 1;
				}
				if (facs[f].width == 0) continue;
				Newx(facs[f].col, n_used * facs[f].width, NV);
				if (facs[f].is_cat) {
					for (size_t r = 0; r < n_used; r++) {
						char *sv = get_data_string_alloc(aTHX_ hoa, rows, ridx[r], facs[f].name);
						for (size_t j = 1; j < facs[f].nlv; j++)
							facs[f].col[r * facs[f].width + (j - 1)] =
								(sv && strcmp(sv, facs[f].lv[j]) == 0) ? 1.0 : 0.0;
						Safefree(sv);
					}
				} else {
					for (size_t r = 0; r < n_used; r++)
						facs[f].col[r] = evaluate_term(aTHX_ hoa, rows, (unsigned)ridx[r], facs[f].name);
				}
			}
			//term widths + design layout
			p = 1;
			for (size_t t = 0; t < nterms; t++) {
				size_t w = 1;
				for (size_t j = 0; j < terms[t].nf; j++) w *= facs[terms[t].fi[j]].width;
				terms[t].width = w;
				terms[t].start = p;
				p += w;
			}
			//---- build design matrix (intercept + term blocks)
			Newx(y, n_used, NV);
			Newx(X, n_used, NV*);
			for (size_t r = 0; r < n_used; r++) {
				Newx(X[r], p, NV);
				X[r][0] = 1.0;
				y[r] = evaluate_term(aTHX_ hoa, rows, (unsigned)ridx[r], lhs);
			}
			for (size_t t = 0; t < nterms; t++) {
				size_t w = terms[t].width;
				if (w == 0) continue;                    //degenerate: no columns
				for (size_t r = 0; r < n_used; r++) {
					for (size_t c = 0; c < w; c++) {
						size_t rem = c; NV v = 1.0;
						for (size_t j = 0; j < terms[t].nf; j++) {
							AnFac *fj = &facs[terms[t].fi[j]];
							size_t d = rem % fj->width; rem /= fj->width;
							v *= fj->col[r * fj->width + d];
						}
						X[r][terms[t].start + c] = v;
					}
				}
			}
			// sequential QR (X, y overwritten in place)
			Newx(aliased,  p, bool);
			Newx(rank_map, p, size_t);
			for (size_t k = 0; k < p; k++) rank_map[k] = 0;
			apply_householder_aov(X, y, n_used, p, aliased, rank_map);

			rank = 0;
			for (size_t k = 0; k < p; k++) if (!aliased[k]) rank++;
			rss = 0.0;
			for (size_t r = rank; r < n_used; r++) rss += y[r] * y[r];
			dfres = (IV)n_used - (IV)rank;
			msres = dfres > 0 ? rss / (NV)dfres : NAN;

			// assemble term-keyed table
			result = newHV();
			for (size_t t = 0; t < nterms; t++) {
				NV ss = 0.0; IV df = 0;
				for (size_t k = terms[t].start; k < terms[t].start + terms[t].width; k++)
					if (!aliased[k]) { ss += y[rank_map[k]] * y[rank_map[k]]; df++; }

				HV *in = newHV();
				(void)hv_store(in, "Df", 2, newSViv(df), 0);
				(void)hv_store(in, "Sum Sq", 6, newSVnv(ss), 0);
				if (df > 0) {
					(void)hv_store(in, "Mean Sq", 7, newSVnv(ss / (NV)df), 0);
					if (dfres > 0 && rss > 0.0) {
						NV F = (ss / (NV)df) / msres;
						(void)hv_store(in, "F value", 7, newSVnv(F), 0);
						(void)hv_store(in, "Pr(>F)", 6, newSVnv(pf_upper(F, (NV)df, (NV)dfres)), 0);
					}
				}
				(void)hv_store(result, terms[t].name, (I32)strlen(terms[t].name),
				               newRV_noinc((SV*)in), 0);
			}
			{
				HV *in = newHV();
				(void)hv_store(in, "Df", 2, newSViv(dfres), 0);
				(void)hv_store(in, "Sum Sq", 6, newSVnv(rss), 0);
				if (dfres > 0) (void)hv_store(in, "Mean Sq", 7, newSVnv(msres), 0);
				(void)hv_store(result, "Residuals", 9, newRV_noinc((SV*)in), 0);
			}
			// teardown
			for (size_t r = 0; r < n_used; r++) Safefree(X[r]);
			Safefree(X); Safefree(y);
			Safefree(aliased); Safefree(rank_map); Safefree(ridx); Safefree(complete);
			anova_free_terms(aTHX_ terms, nterms);
			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)) {
				STRLEN klen;
				const char *k = SvPV_const(a, klen);
				if ((klen == 11 && strEQ(k, "ties.method")) ||
				    (klen == 7  && strEQ(k, "na.last"))) {
					opt_start = i;
					break;
				}
			}
		}

		if (((items - opt_start) & 1) != 0)
			croak("rank: named options must be key => value pairs");

		for (int i = opt_start; i < items; i += 2) {
			STRLEN klen, vlen;
			const char *k = SvPV_const(ST(i), klen);
			SV *vsv = ST(i + 1);
			if (strEQ(k, "ties.method")) {
				if (!SvOK(vsv))
					croak("rank: ties.method cannot be undef");
				const char *v = SvPV_const(vsv, vlen);
				if      (strEQ(v, "average")) ties = RANK_AVERAGE;
				else if (strEQ(v, "first"))   ties = RANK_FIRST;
				else if (strEQ(v, "last"))    ties = RANK_LAST;
				else if (strEQ(v, "random"))  ties = RANK_RANDOM;
				else if (strEQ(v, "max"))     ties = RANK_MAX;
				else if (strEQ(v, "min"))     ties = RANK_MIN;
				else croak("rank: unknown ties.method '%s' "
				           "(average, first, last, random, max, min)", v);
			} else if (strEQ(k, "na.last")) {
				if (!SvOK(vsv)) {
					nalast = NALAST_DROP;             // undef => R's NA
				} else {
					const char *v = SvPV_const(vsv, vlen);
					if      (strEQ(v, "keep"))                       nalast = NALAST_KEEP;
					else if (strEQ(v, "na")    || strEQ(v, "NA"))    nalast = NALAST_DROP;
					else if (strEQ(v, "false") || strEQ(v, "FALSE")
					     ||  strEQ(v, "F")     || strEQ(v, "0"))     nalast = NALAST_FALSE;
					else if (strEQ(v, "true")  || strEQ(v, "TRUE")
					     ||  strEQ(v, "T")     || strEQ(v, "1"))     nalast = NALAST_TRUE;
					else croak("rank: unknown na.last '%s' "
					           "(true, false, keep, na)", v);
				}
			} else {
				croak("rank: unknown option '%s' (ties.method, na.last)", k);
			}
		}

		// count total data elements
		size_t N = 0;
		for (int i = 0; i < opt_start; i++) {
			SV *a = ST(i);
			if (SvROK(a) && SvTYPE(SvRV(a)) == SVt_PVAV)
				N += (size_t)(av_len((AV *)SvRV(a)) + 1);
			else
				N += 1;
		}
		if (N == 0) XSRETURN_EMPTY;

		// gather values, flag NAs (undef or NaN)
		char      *na    = NULL;   // 1 if element is NA
		IV        *nidx  = NULL;   // non-NA index per position, else -1
		rank_pair *pairs = NULL;   // packed non-NA values
		Newx(na,    N, char);
		Newx(nidx,  N, IV);
		Newx(pairs, N, rank_pair);

		size_t n = 0;   // number of non-NA values
		size_t p = 0;   // running position
		for (int i = 0; i < opt_start; i++) {
			SV *a = ST(i);
			if (SvROK(a) && SvTYPE(SvRV(a)) == SVt_PVAV) {
				AV *av = (AV *)SvRV(a);
				size_t len = (size_t)(av_len(av) + 1);
				for (size_t j = 0; j < len; j++) {
					SV **tv = av_fetch(av, j, 0);
					if (tv && SvOK(*tv)) {
						NV val = SvNV(*tv);
						if (val != val) {          // NaN => NA
							na[p] = 1; nidx[p] = -1;
						} else {
							na[p] = 0; nidx[p] = (IV)n;
							pairs[n].val = val;
							pairs[n].idx = (IV)n;
							n++;
						}
					} else {
						na[p] = 1; nidx[p] = -1;
					}
					p++;
				}
			} else if (SvOK(a)) {
				NV val = SvNV(a);
				if (val != val) {                  // NaN => NA
					na[p] = 1; nidx[p] = -1;
				} else {
					na[p] = 0; nidx[p] = (IV)n;
					pairs[n].val = val;
					pairs[n].idx = (IV)n;
					n++;
				}
				p++;
			} else {
				na[p] = 1; nidx[p] = -1;
				p++;
			}
		}

		// sort the non-NA values
		if (ties == RANK_RANDOM)
			for (size_t k = 0; k < n; k++) pairs[k].rnd = Drand01();

		if (n > 1) {
			if      (ties == RANK_RANDOM) qsort(pairs, n, sizeof(rank_pair), rank_cmp_rnd_asc);
			else if (ties == RANK_LAST)   qsort(pairs, n, sizeof(rank_pair), rank_cmp_idx_desc);
			else                          qsort(pairs, n, sizeof(rank_pair), rank_cmp_idx_asc);
		}

		// assign ranks (1-based) by non-NA index
		NV *rank_of = NULL;
		Newx(rank_of, n ? n : 1, NV);
		if (ties == RANK_AVERAGE || ties == RANK_MIN || ties == RANK_MAX) {
			size_t k = 0;
			while (k < n) {
				size_t j = k;
				while (j + 1 < n && pairs[j + 1].val == pairs[k].val) j++;
				NV assigned;
				if      (ties == RANK_MIN) assigned = (NV)(k + 1);
				else if (ties == RANK_MAX) assigned = (NV)(j + 1);
				else                       assigned = ((NV)(k + 1) + (NV)(j + 1)) / 2.0;
				for (size_t m = k; m <= j; m++)
					rank_of[pairs[m].idx] = assigned;
				k = j + 1;
			}
		} else {
			for (size_t k = 0; k < n; k++)
				rank_of[pairs[k].idx] = (NV)(k + 1);
		}
		Safefree(pairs); pairs = NULL;

		// emit results in original order, per na.last
		size_t nna = N - n;                          // number of NAs
		size_t M   = (nalast == NALAST_DROP) ? n : N;
		EXTEND(SP, (SSize_t)M);

		if (nalast == NALAST_DROP) {
			for (size_t q = 0; q < N; q++) {
				if (na[q]) continue;
				NV rv = rank_of[nidx[q]];
				if (rv == (NV)(IV)rv) mPUSHi((IV)rv); else mPUSHn(rv);
			}
		} else if (nalast == NALAST_KEEP) {
			for (size_t q = 0; q < N; q++) {
				if (na[q]) { PUSHs(&PL_sv_undef); continue; }
				NV rv = rank_of[nidx[q]];
				if (rv == (NV)(IV)rv) mPUSHi((IV)rv); else mPUSHn(rv);
			}
		} else if (nalast == NALAST_TRUE) {
			size_t na_rank = n;
			for (size_t q = 0; q < N; q++) {
				if (na[q]) { mPUSHi((IV)(++na_rank)); continue; }
				NV rv = rank_of[nidx[q]];
				if (rv == (NV)(IV)rv) mPUSHi((IV)rv); else mPUSHn(rv);
			}
		} else { // NALAST_FALSE
			size_t na_rank = 0;
			for (size_t q = 0; q < N; q++) {
				if (na[q]) { mPUSHi((IV)(++na_rank)); continue; }
				NV rv = rank_of[nidx[q]] + (NV)nna;
				if (rv == (NV)(IV)rv) mPUSHi((IV)rv); else mPUSHn(rv);
			}
		}

		Safefree(rank_of);
		Safefree(nidx);
		Safefree(na);

NV ptukey(q, nmeans, df, ...)
	NV q
	NV nmeans
	NV df
CODE:
{
	/*ptukey(q, nmeans, df, nranges => 1, lower_tail => 1, log_p => 0)
	Studentized range CDF, as in R's ptukey().  q may also be an
	arrayref, in which case a mortal arrayref is returned (see OUTPUT
	note below -- scalar form here, vector form handled by caller).*/
	NV nranges = 1.0;
	bool lower_tail = TRUE, log_p = FALSE;
	if ((items - 3) % 2 != 0)
		croak("ptukey: expected q, nmeans, df followed by key => value pairs");
	for (int i = 3; i < items; i += 2) {
		const char *key = SvPV_nolen(ST(i));
		SV *val = ST(i + 1);
		if      (strEQ(key, "nranges"))    nranges    = SvNV(val);
		else if (strEQ(key, "lower_tail")) lower_tail = SvTRUE(val) ? TRUE : FALSE;
		else if (strEQ(key, "lower.tail")) lower_tail = SvTRUE(val) ? TRUE : FALSE;
		else if (strEQ(key, "log_p"))      log_p      = SvTRUE(val) ? TRUE : FALSE;
		else if (strEQ(key, "log.p"))      log_p      = SvTRUE(val) ? TRUE : FALSE;
		else croak("ptukey: unknown argument '%s'", key);
	}
	NV pr = st_ptukey(q, nranges, nmeans, df);
	if (!lower_tail) pr = 1.0 - pr;
	RETVAL = log_p ? nv_log(pr) : pr;
}
OUTPUT:
	RETVAL

NV qtukey(p, nmeans, df, ...)
	NV p
	NV nmeans
	NV df
CODE:
{
	/*qtukey(p, nmeans, df, nranges => 1, lower_tail => 1, log_p => 0)
	Inverse studentized range CDF, as in R's qtukey().*/
	NV nranges = 1.0;
	bool lower_tail = TRUE, log_p = FALSE;
	if ((items - 3) % 2 != 0)
		croak("qtukey: expected p, nmeans, df followed by key => value pairs");
	for (int i = 3; i < items; i += 2) {
		const char *key = SvPV_nolen(ST(i));
		SV *val = ST(i + 1);
		if      (strEQ(key, "nranges"))    nranges    = SvNV(val);
		else if (strEQ(key, "lower_tail")) lower_tail = SvTRUE(val) ? TRUE : FALSE;
		else if (strEQ(key, "lower.tail")) lower_tail = SvTRUE(val) ? TRUE : FALSE;
		else if (strEQ(key, "log_p"))      log_p      = SvTRUE(val) ? TRUE : FALSE;
		else if (strEQ(key, "log.p"))      log_p      = SvTRUE(val) ? TRUE : FALSE;
		else croak("qtukey: unknown argument '%s'", key);
	}
	if (log_p)       p = nv_exp(p);
	if (!lower_tail) p = 1.0 - p;
	RETVAL = st_qtukey(p, nranges, nmeans, df);
}
OUTPUT:
	RETVAL

SV *aoh2hoa(data)
	SV *data
	CODE:
	{
/*aoh2hoa($aoh) -- transpose an Array-of-Hashes into a Hash-of-Arrays.
 
   in : arrayref of hashrefs (rows)  [ {a=>1,b=>2}, {a=>3} ]
   out: hashref of arrayrefs (cols)  { a=>[1,3], b=>[2,undef] }
 
 - Columns are the union of all row keys.
 - Every column has exactly scalar(@$aoh) elements; cells absent
   from a given row are undef (kept as cheap holes, not SVs).
 - Values are copied, so the result is independent of the input
   (a value that is itself a reference is copied shallowly, just
   like Perl's  $col->[$i] = $row->{$k} ).
 - A row that is not a hashref contributes undef to every column
   at its index (skipped, not fatal).*/
		AV *aoh;
		HV *out;
		SSize_t n, i;
		HE *he;

		if (!SvROK(data) || SvTYPE(SvRV(data)) != SVt_PVAV)
			croak("aoh2hoa: argument must be an arrayref of hashrefs");

		aoh = (AV *)SvRV(data);
		n   = av_len(aoh) + 1;			//number of rows
		out = newHV();

		for (i = 0; i < n; i++) {
			SV **rp = av_fetch(aoh, i, 0);
			HV  *row;

			if (!(rp && *rp && SvROK(*rp)
			           && SvTYPE(SvRV(*rp)) == SVt_PVHV))
				continue;		//non-hashref row -> all undef

			row = (HV *)SvRV(*rp);
			hv_iterinit(row);
			while ((he = hv_iternext(row))) {
				SV *ksv  = hv_iterkeysv(he);	//utf8 / SV-key safe
				HE *oute = hv_fetch_ent(out, ksv, 0, 0);
				AV *col;
				if (oute && SvROK(HeVAL(oute))
				         && SvTYPE(SvRV(HeVAL(oute))) == SVt_PVAV) {
					col = (AV *)SvRV(HeVAL(oute));
				} else {
					col = newAV();
					if (n > 0) av_extend(col, n - 1);
					(void)hv_store_ent(out, ksv,
					                   newRV_noinc((SV *)col), 0);
				}
				av_store(col, i, newSVsv(HeVAL(he)));
			}
		}
		// pad every column out to exactly n elements (trailing undefs)
		hv_iterinit(out);
		while ((he = hv_iternext(out))) {
			AV *col = (AV *)SvRV(HeVAL(he));
			if (av_len(col) < n - 1)
				av_fill(col, n - 1);
		}
		RETVAL = newRV_noinc((SV *)out);
	}
	OUTPUT:
		RETVAL

SV* binom_test(...)
CODE:
{
	if (items < 1) croak("binom_test requires at least the number of successes");

	long x = 0, n = 0;
	bool have_n = 0;
	Stack_off_t pos = 1; // index where named args begin

	SV *x_sv = ST(0);
	if (SvROK(x_sv) && SvTYPE(SvRV(x_sv)) == SVt_PVAV) {
		//x = [successes, failures]; n is derived
		AV *xa = (AV *)SvRV(x_sv);
		if (av_len(xa) != 1)
			croak("binom_test: x as an array ref must hold exactly 2 elements "
			      "(successes, failures)");
		long s = bt_check_count(aTHX_ *av_fetch(xa, 0, 0), "successes");
		long f = bt_check_count(aTHX_ *av_fetch(xa, 1, 0), "failures");
		x = s;
		n = s + f;
		have_n = 1;
	} else {
		//x = successes (scalar); n must follow positionally
		x = bt_check_count(aTHX_ x_sv, "x");
		if (items >= 2 && SvOK(ST(1)) && looks_like_number(ST(1))) {
			n = bt_check_count(aTHX_ ST(1), "n");
			have_n = 1;
			pos = 2;
		}
	}
	if (!have_n)
		croak("binom_test: number of trials n is required when x is a scalar");

	NV   p          = 0.5;
	NV   conf_level = NV_CONF_95;
	const char *alternative = "two.sided";

	for (Stack_off_t i = pos; i < items; i += 2) {
		if (i + 1 >= items) croak("binom_test: odd number of named arguments");
		const char *key = SvPV_nolen(ST(i));
		SV *val = ST(i + 1);
		if (strEQ(key, "p")) {
			p = SvNV(val);
			if (!(p >= 0.0 && p <= 1.0))
				croak("binom_test: p must be between 0 and 1");
		} else if (strEQ(key, "conf_level") || strEQ(key, "conf.level")) {
			conf_level = SvNV(val);
			if (!(conf_level > 0.0 && conf_level < 1.0))
				croak("binom_test: conf_level must be between 0 and 1");
		} else if (strEQ(key, "alternative")) {
			alternative = SvPV_nolen(val);
			if (strNE(alternative, "two.sided") && strNE(alternative, "less") &&
			    strNE(alternative, "greater"))
				croak("binom_test: alternative must be 'two.sided', 'less' or 'greater'");
		} else {
			croak("binom_test: unknown argument '%s'", key);
		}
	}
	if (n < 1) croak("binom_test: n must be a positive integer >= x");
	if (x > n) croak("binom_test: number of successes cannot exceed trials");
	// ---- p-value (switch on alternative, as R does)
	NV PVAL;
	if (strEQ(alternative, "less")) {
		PVAL = bt_pbinom_lower(x, n, p);              //P(X <= x)
	} else if (strEQ(alternative, "greater")) {
		PVAL = bt_pbinom_upper(x - 1, n, p);          //P(X >= x)
	} else {                                          //two.sided
		if (p == 0.0) {
			PVAL = (x == 0) ? 1.0 : 0.0;
		} else if (p == 1.0) {
			PVAL = (x == n) ? 1.0 : 0.0;
		} else {
			const NV relErr = 1.0 + 1e-7;
			NV d = bt_dbinom(x, n, p);
			NV m = (NV)n * p;
			if ((NV)x == m) {
				PVAL = 1.0;
			} else if ((NV)x < m) {
				long y = 0;
				for (long i = (long)nv_ceil(m); i <= n; i++)
					if (bt_dbinom(i, n, p) <= d * relErr) y++;
				PVAL = bt_pbinom_lower(x, n, p) + bt_pbinom_upper(n - y, n, p);
			} else {
				long y = 0;
				for (long i = 0; i <= (long)nv_floor(m); i++)
					if (bt_dbinom(i, n, p) <= d * relErr) y++;
				PVAL = bt_pbinom_lower(y - 1, n, p) + bt_pbinom_upper(x - 1, n, p);
			}
		}
	}
	if (PVAL > 1.0) PVAL = 1.0;
	// confidence interval (Clopper-Pearson)
	NV ci_lo, ci_hi;
	if (strEQ(alternative, "less")) {
		ci_lo = 0.0;
		ci_hi = bt_pU(1.0 - conf_level, x, n);
	} else if (strEQ(alternative, "greater")) {
		ci_lo = bt_pL(1.0 - conf_level, x, n);
		ci_hi = 1.0;
	} else {
		NV a = (1.0 - conf_level) / 2.0;
		ci_lo = bt_pL(a, x, n);
		ci_hi = bt_pU(a, x, n);
	}
	// htest-style result
	HV *ret = newHV();
	hv_stores(ret, "method",      newSVpv("Exact binomial test", 0));
	hv_stores(ret, "alternative", newSVpv(alternative, 0));
	hv_stores(ret, "statistic",   newSViv(x));             //number of successes
	hv_stores(ret, "parameter",   newSViv(n));             //number of trials
	hv_stores(ret, "estimate",    newSVnv((NV)x / (NV)n)); //probability of success
	hv_stores(ret, "null.value",  newSVnv(p));
	hv_stores(ret, "p.value",     newSVnv(PVAL));
	hv_stores(ret, "conf.level",  newSVnv(conf_level));
	AV *ci = newAV();
	av_push(ci, newSVnv(ci_lo));
	av_push(ci, newSVnv(ci_hi));
	hv_stores(ret, "conf.int",    newRV_noinc((SV *)ci));
	RETVAL = newRV_noinc((SV *)ret);
}
OUTPUT:
  RETVAL

BOOT:
	newXS("Stats::LikeR::__cs_uninit_catcher", cs_uninit_catcher, __FILE__);

void csort(...)
PREINIT:
	SV *data = NULL, *by = NULL, *output = NULL;
	cs_shape in_shape = CS_AOH, out_shape = CS_AOH;
	bool is_hoh = 0, is_code = 0;
	const char *colname = NULL;
	STRLEN collen = 0;
	IV aoa_col = 0;				// AoA: parsed non-negative column index
	const char *rowname_col = NULL;	// HoH: row-name column name
	STRLEN rowname_len = 0;
	CV *cmp_cv = NULL;
	AV *src_av = NULL;	// AoH / AoA input
	HV *src_hv = NULL;	// HoA / HoH input
	SSize_t n = 0;
	size_t *idx = NULL, *tmp = NULL;
	SV **rowrefs = NULL;	// coderef mode: row ref per index
	SV **colkeys = NULL;	// HoA: column key SVs
	AV **colavs  = NULL;	// HoA: column AVs
	size_t ncols = 0;
	SV *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);
	by     = ST(1);
	output = (items >= 3) ? ST(2) : &PL_sv_undef;
	if (items >= 4 && SvOK(ST(3)))
		rowname_col = SvPV(ST(3), rowname_len);
	else {
		rowname_col = "row.name";
		rowname_len = 8;
	}
	ENTER;    // scope for SAVEFREEPV / SAVESPTR cleanups
	SAVETMPS; // reap transient synthesized rows and mortals here
	// classify $by: coderef comparator vs column name/index
	if (SvROK(by) && SvTYPE(SvRV(by)) == SVt_PVCV) {
		is_code = 1;
		cmp_cv  = (CV *)SvRV(by);
	} else if (SvOK(by) && !SvROK(by)) {
		is_code = 0;
		colname = SvPV(by, collen);
	} else {
		croak("csort: second argument must be a column name (e.g. 'No.'), an "
		      "integer column index for an AoA, or a comparator code-ref "
		      "using $a and $b, e.g. sub { $b->{'No.'} <=> $a->{'No.'} }");
	}
	//classify $data: AoH/AoA (arrayref) vs HoA/HoH (hashref)
	if (!SvROK(data))
		croak("csort: first argument must be an array-ref (AoH or AoA) or "
		      "hash-ref (HoA or HoH); Usage: csort($df, 'column.name', 'HoA')");
	if (SvTYPE(SvRV(data)) == SVt_PVAV) {
		src_av   = (AV *)SvRV(data);
		n        = av_len(src_av) + 1;
		in_shape = CS_AOH;		//default; refine by peeking at row 0
		if (n > 0) {
			SV **rp = av_fetch(src_av, 0, 0);
			if (rp && *rp && SvROK(*rp)
			        && SvTYPE(SvRV(*rp)) == SVt_PVAV)
				in_shape = CS_AOA;	//first row is an arrayref => AoA
		}
	} else if (SvTYPE(SvRV(data)) == SVt_PVHV) {
		src_hv = (HV *)SvRV(data);
		hv_iterinit(src_hv);
		HE *he = hv_iternext(src_hv);
		if (!he) {
			in_shape = CS_HOA;	//empty hash defaults to HoA path
		} else {
			SV *val = HeVAL(he);
			if (SvROK(val) && SvTYPE(SvRV(val)) == SVt_PVHV)
				is_hoh = 1;
			else
				in_shape = CS_HOA;
		}
	} else {
		croak("csort: first argument must be an array-ref (AoH or AoA) or "
		      "hash-ref (HoA or HoH); Usage: csort($df, 'column.name', 'HoA')");
	}
	// gracefully fold HoH into a stable AoH for sorting */
	if (is_hoh) {
		n = hv_iterinit(src_hv);
		src_av = newAV();
		sv_2mortal((SV *)src_av); // cleanup on LEAVE */
		if (n > 0) {
			SV **keys;
			Newx(keys, n, SV*);
			SAVEFREEPV(keys);
			size_t i = 0;
			HE *he;
			while ((he = hv_iternext(src_hv))) {
				keys[i++] = hv_iterkeysv(he);
			}
/*Sort keys alphabetically via insertion sort to guarantee
 stable and fully deterministic row initialization*/
			for (size_t i = 1; i < (size_t)n; i++) {
				SV *k = keys[i];
				STRLEN kl; const char *kp = SvPV_const(k, kl);
				SSize_t j = i - 1;
				while (j >= 0) {
					STRLEN jl; const char *jp = SvPV_const(keys[j], jl);
					int cmp = memcmp(jp, kp, jl < kl ? jl : kl);
					if (cmp == 0) cmp = (jl > kl) - (jl < kl);
					if (cmp <= 0) break;
					keys[j + 1] = keys[j];
					j--;
				}
				keys[j + 1] = k;
			}
/*Materialize each HoH row as a fresh AoH row that also carries
 its outer key under the row-name column, so the name survives
 into either output shape.  The row *container* is a private
 copy (leaf cells are aliased/shared read-only), so injecting
 the row-name column never mutates the caller's data.*/
			for (size_t i = 0; i < (size_t)n; i++) {
				HE *entry = hv_fetch_ent(src_hv, keys[i], 0, 0);
				if (!entry) continue;
				SV *val = HeVAL(entry);
				if (!val || !SvROK(val) || SvTYPE(SvRV(val)) != SVt_PVHV)
					croak("csort: HoH row '%s' is not a hash-ref",
					      SvPV_nolen(keys[i]));

				HV *orig = (HV *)SvRV(val);
				HV *rowh = newHV();
				hv_iterinit(orig);
				HE *cell;
				while ((cell = hv_iternext(orig))) {
					SV *cv = HeVAL(cell);
					(void)hv_store_ent(rowh, hv_iterkeysv(cell),
					        cv ? SvREFCNT_inc_simple_NN(cv) : newSV(0), 0);
				}
// the outer hash key is the authoritative row name */
				(void)hv_store(rowh, rowname_col, (I32)rowname_len,
				               newSVsv(keys[i]), 0);
				av_push(src_av, newRV_noinc((SV *)rowh));
			}
		}
		in_shape = CS_AOH;	//route through the standard AoH logic hereafter
	}
// resolve requested output shape (default: match input) */
	if (!SvOK(output)) {
		out_shape = in_shape;
	} else {
		STRLEN ol;
		const char *os = SvPV(output, ol);
		if (ol == 3 && toLOWER(os[0]) == 'a' && toLOWER(os[1]) == 'o'
		    && toLOWER(os[2]) == 'h')
			out_shape = CS_AOH;
		else if (ol == 3 && toLOWER(os[0]) == 'h' && toLOWER(os[1]) == 'o'
		         && toLOWER(os[2]) == 'a')
			out_shape = CS_HOA;
		else if (ol == 3 && toLOWER(os[0]) == 'a' && toLOWER(os[1]) == 'o'
		         && toLOWER(os[2]) == 'a')
			out_shape = CS_AOA;
		else
			croak("csort: output type must be 'aoh', 'hoa', or 'aoa' "
			      "(got '%s')", os);
	}
	if (in_shape == CS_HOA) {// ---- gather HoA column metadata + validate equal lengths
		HE *he;
		SSize_t common = -2;	//-2 = unset sentinel
		hv_iterinit(src_hv);
		while ((he = hv_iternext(src_hv))) {
			SV *cv = HeVAL(he);
			if (!cv || !SvROK(cv) || SvTYPE(SvRV(cv)) != SVt_PVAV)
				croak("csort: HoA value for column '%s' is not an "
				      "array-ref", HePV(he, PL_na));
			SSize_t len = av_len((AV *)SvRV(cv)) + 1;
			if (common == -2) common = len;
			else if (len != common)
				croak("csort: HoA columns have unequal lengths "
				      "(%" IVdf " vs %" IVdf ")",
				      (IV)common, (IV)len);
			ncols++;
		}
		n = (common < 0) ? 0 : common;

		if (ncols) {
			Newx(colkeys, ncols, SV *);  SAVEFREEPV(colkeys);
			Newx(colavs,  ncols, AV *);  SAVEFREEPV(colavs);
			size_t c = 0;
			hv_iterinit(src_hv);
			while ((he = hv_iternext(src_hv))) {
				colkeys[c] = sv_2mortal(newSVsv(hv_iterkeysv(he)));
				colavs[c]  = (AV *)SvRV(HeVAL(he));
				c++;
			}
		}
	}
	if (in_shape == CS_AOA) {// ---- AoA: validate the integer column index + measure width
		if (!is_code) {
			if (collen == 0)
				croak("csort: AoA column must be a non-negative integer "
				      "index (got empty string)");
			STRLEN p = 0;
			IV v = 0;
			for (; p < collen; p++) {
				if (colname[p] < '0' || colname[p] > '9') break;
				v = v * 10 + (colname[p] - '0');
			}
			if (p != collen)
				croak("csort: AoA column must be a non-negative integer "
				      "index (got '%s')", colname);
			aoa_col = v;
		}
// widest row governs how many positional columns a transpose emits
		for (size_t i = 0; i < (size_t)n; i++) {
			SV **rp = av_fetch(src_av, (SSize_t)i, 0);
			if (rp && *rp && SvROK(*rp) && SvTYPE(SvRV(*rp)) == SVt_PVAV) {
				SSize_t w = av_len((AV *)SvRV(*rp)) + 1;
				if (w > 0 && (size_t)w > ncols) ncols = (size_t)w;
			}
		}
	}
	// ---- build the identity permutation (sorted in place below)
	Newx(idx, (size_t)(n > 0 ? n : 1), size_t);  SAVEFREEPV(idx);
	Newx(tmp, (size_t)(n > 0 ? n : 1), size_t);  SAVEFREEPV(tmp);
	for (size_t i = 0; i < (size_t)n; i++) idx[i] = i;
	if (n > 1) {
		if (is_code) {// comparator mode: prepare row refs + bind $a/$b
			Newx(rowrefs, (size_t)n, SV *);  SAVEFREEPV(rowrefs);
			if (in_shape == CS_AOH || in_shape == CS_AOA) {
				//rows are already refs (hashref or arrayref); alias them
				for (size_t i = 0; i < (size_t)n; i++) {
					SV **rp = av_fetch(src_av, (SSize_t)i, 0);
					rowrefs[i] = (rp && *rp) ? *rp : &PL_sv_undef;
				}
			} else {//HoA: synthesize a per-row hashref view of the columns;
			//cells are aliased (shared) -- read-only in a comparator
				for (size_t i = 0; i < (size_t)n; i++) {
					HV *rh = newHV();
					for (size_t c = 0; c < ncols; c++) {
						SV **cp = av_fetch(colavs[c], (SSize_t)i, 0);
						SV *cell = (cp && *cp)
						         ? SvREFCNT_inc_simple_NN(*cp) : newSV(0);
						hv_store_ent(rh, colkeys[c], cell, 0);
					}
					rowrefs[i] = sv_2mortal(newRV_noinc((SV *)rh));
				}
			}
			cs_code_ctx ctx;
			ctx.rows = rowrefs;
			ctx.cv   = cmp_cv;
			cs_bind_ab(aTHX_ cmp_cv, &ctx.a_sv, &ctx.b_sv);
/*undef-last: probe each row once; rows whose comparator touches
 an undef go to the end in stable order, the rest are sorted so
 the comparator never sees an undef (safe under fatal warnings)*/
			{
				size_t *undefs;
				Newx(undefs, (size_t)n, size_t);  SAVEFREEPV(undefs);
				size_t d = 0, u = 0;
				for (size_t i = 0; i < (size_t)n; i++) {
					if (cs_row_touches_undef(aTHX_ &ctx, i)) undefs[u++] = i;
					else                                     idx[d++]   = i;
				}
				for (size_t k = 0; k < u; k++) idx[d + k] = undefs[k];
				cs_msort(aTHX_ idx, tmp, 0, d, cs_code_cmp, &ctx);
			}
		} else {// column mode: gather cells, detect numeric, sort
			SV **vals;
			Newx(vals, (size_t)n, SV *);  SAVEFREEPV(vals);
			bool found = 0;
			unsigned short numeric = 1;
			if (in_shape == CS_AOH) {
				for (size_t i = 0; i < (size_t)n; i++) {
					SV *cell = NULL;
					SV **rp = av_fetch(src_av, (SSize_t)i, 0);
					if (rp && *rp && SvROK(*rp)
					        && SvTYPE(SvRV(*rp)) == SVt_PVHV) {
						SV **cp = hv_fetch((HV *)SvRV(*rp),
						                   colname, collen, 0);
						if (cp && *cp) { cell = *cp; found = 1; }
					}
					if (cell && SvOK(cell) && !looks_like_number(cell))
						numeric = 0;
					vals[i] = cell;
				}
			} else if (in_shape == CS_AOA) {
				for (size_t i = 0; i < (size_t)n; i++) {
					SV *cell = NULL;
					SV **rp = av_fetch(src_av, (SSize_t)i, 0);
					if (rp && *rp && SvROK(*rp)
					        && SvTYPE(SvRV(*rp)) == SVt_PVAV) {
						SV **cp = av_fetch((AV *)SvRV(*rp),
						                   (SSize_t)aoa_col, 0);
						if (cp && *cp) { cell = *cp; found = 1; }
					}
					if (cell && SvOK(cell) && !looks_like_number(cell))
						numeric = 0;
					vals[i] = cell;
				}
			} else {
				SV **colp = hv_fetch(src_hv, colname, collen, 0);
				if (!(colp && *colp && SvROK(*colp)
				        && SvTYPE(SvRV(*colp)) == SVt_PVAV))
					croak("csort: column '%s' not found in HoA", colname);
				found = 1;
				AV *col = (AV *)SvRV(*colp);
				for (size_t i = 0; i < (size_t)n; i++) {
					SV **cp = av_fetch(col, (SSize_t)i, 0);
					SV *cell = (cp && *cp) ? *cp : NULL;
					if (cell && SvOK(cell) && !looks_like_number(cell))
						numeric = 0;
					vals[i] = cell;
				}
			}
			if (!found)
				croak("csort: column '%s' not found", colname);

			cs_col_ctx ctx;
			ctx.vals    = vals;
			ctx.numeric = numeric;
			cs_msort(aTHX_ idx, tmp, 0, (size_t)n, cs_col_cmp, &ctx);
		}
	}// end if (n > 1)
// materialize the result in the requested shape
	result = cs_materialize(aTHX_ out_shape, in_shape, src_av,
	                        colkeys, colavs, ncols, idx, (size_t)n);
	FREETMPS;
	LEAVE;

	XPUSHs(sv_2mortal(result));
	XSRETURN(1);
}

SV *cfilter(data, ...)
		SV *data
	CODE:
	{
/*0. options. Exactly one of keep/remove is required; it is either an
 array ref of column names or a value predicate (CODE ref / function
 name). For a predicate, undef handling is:
   na => 'keep' (default) - the predicate sees every cell, incl undef
   na => 'omit'           - single-column funcs (sd) get defined cells
   against => 'col'       - two-column funcs (cor): the predicate gets
                            ($col, $ref) over rows defined in BOTH.*/
		SV *keep_sv = NULL, *remove_sv = NULL;
		SV *na_sv = NULL, *against_sv = NULL;
		if ((items - 1) & 1) croak("cfilter: trailing options must be name => value pairs");
		for (int oi = 1; oi < items; oi += 2) {
			STRLEN ol;
			const char *oname = SvPV(ST(oi), ol);
			SV *oval = ST(oi + 1);
			if (ol == 4 && memEQ(oname, "keep", 4)) keep_sv = oval;
			else if (ol == 6 && memEQ(oname, "remove", 6)) remove_sv = oval;
			else if (ol == 2 && memEQ(oname, "na", 2)) na_sv = oval;
			else if (ol == 7 && memEQ(oname, "against", 7)) against_sv = oval;
			else croak("cfilter: unknown option '%s'", oname);
		}
		if (keep_sv && remove_sv) croak("cfilter: give either keep or remove, not both");
		if (!keep_sv && !remove_sv) croak("cfilter: need a keep or remove argument");
		bool removing = (remove_sv != NULL);
		SV *sel = removing ? remove_sv : keep_sv;
		/* classify the selector: array ref of names, a qr// name pattern, or a
		 value predicate.*/
		bool by_name = FALSE, by_regex = FALSE;
		SV *cv_sv = NULL;
		if (SvROK(sel) && SvTYPE(SvRV(sel)) == SVt_PVAV) by_name = TRUE;
		else if (SvRXOK(sel)) by_regex = TRUE;
		else if ((SvROK(sel) && SvTYPE(SvRV(sel)) == SVt_PVCV) || (SvOK(sel) && !SvROK(sel))) {
			if (SvROK(sel)) cv_sv = SvRV(sel);
			else {
				STRLEN nl;
				const char *name = SvPV(sel, nl);
				SV *fq = strstr(name, "::") ? newSVpvn(name, nl) : newSVpvf("Stats::LikeR::%s", name);
				CV *cv = get_cv(SvPV_nolen(fq), 0);
				SvREFCNT_dec(fq);
				if (!cv) croak("cfilter: unknown function '%s'", name);
				cv_sv = (SV*)cv;
			}
		}
		else croak("cfilter: keep/remove must be an array ref of column names, a qr// regex, or a code ref / function name");
		// decode the undef policy (predicate only).
		bool na_omit = FALSE;
		if (na_sv && SvOK(na_sv)) {
			STRLEN nl;
			const char *nv = SvPV(na_sv, nl);
			if (nl == 4 && memEQ(nv, "omit", 4)) na_omit = TRUE;
			else if (nl == 4 && memEQ(nv, "keep", 4)) na_omit = FALSE;
			else croak("cfilter: na must be 'keep' or 'omit'");
		}
		if ((by_name || by_regex) && (na_sv || against_sv)) croak("cfilter: na/against only apply to a predicate selector");
		if (against_sv && na_sv) croak("cfilter: give na or against, not both");
		// 1. detect the data shape.
		if (!SvROK(data)) croak("cfilter: data must be a reference");
		SV *rv = SvRV(data);
		short int kind; // 0 = array-of-hashes, 1 = hash-of-arrays, 2 = hash-of-hashes
		if (SvTYPE(rv) == SVt_PVAV) kind = 0;
		else if (SvTYPE(rv) == SVt_PVHV) {
			HV *h = (HV*)rv;
			hv_iterinit(h);
			HE *fe = hv_iternext(h);
			if (!fe) kind = 2;
			else {
				SV *fv = hv_iterval(h, fe);
				if (SvROK(fv) && SvTYPE(SvRV(fv)) == SVt_PVAV) kind = 1;
				else if (SvROK(fv) && SvTYPE(SvRV(fv)) == SVt_PVHV) kind = 2;
				else croak("cfilter: hash values must be array refs (HoA) or hash refs (HoH)");
			}
		} else croak("cfilter: data must be an array ref or hash ref");
/*2. the column universe, and (predicate only) a row-aligned cell table
 `cellmap`: colname -> AV of length nrows, undef in the gaps. The
 alignment lets `against` pair two columns by row.*/
		HV *universe = newHV();
		AV *colnames = newAV();
		HV *cellmap = (by_name || by_regex) ? NULL : newHV();
		SSize_t nrows = 0;
		if (kind == 1) {
			HV *h = (HV*)rv;
			HE *e;
			hv_iterinit(h);
			while ((e = hv_iternext(h))) {
				SV *val = hv_iterval(h, e);
				if (!SvROK(val) || SvTYPE(SvRV(val)) != SVt_PVAV) croak("cfilter: every value must be an array ref (hash of arrays)");
				SSize_t len = av_len((AV*)SvRV(val)) + 1;
				if (len > nrows) nrows = len;
			}
			hv_iterinit(h);
			while ((e = hv_iternext(h))) {
				SV *ck = hv_iterkeysv(e);
				(void)hv_store_ent(universe, ck, newSViv(1), 0);
				av_push(colnames, newSVsv(ck));
				if (!by_name && !by_regex) {
					AV *src = (AV*)SvRV(hv_iterval(h, e)), *col = newAV();
					if (nrows > 0) av_extend(col, nrows - 1);
					for (SSize_t r = 0; r < nrows; r++) {
						SV **ep = (r <= av_len(src)) ? av_fetch(src, r, 0) : NULL;
						av_push(col, (ep && *ep && SvOK(*ep)) ? newSVsv(*ep) : newSV(0));
					}
					(void)hv_store_ent(cellmap, ck, newRV_noinc((SV*)col), 0);
				}
			}
		} else {// row-major: collect the rows in a stable order, then build per column.
			AV *rows = newAV();
			if (kind == 0) {
				AV *a = (AV*)rv;
				SSize_t n = av_len(a) + 1;
				for (SSize_t r = 0; r < n; r++) {
					SV **ep = av_fetch(a, r, 0);
					if (!ep || !*ep || !SvROK(*ep) || SvTYPE(SvRV(*ep)) != SVt_PVHV) croak("cfilter: array elements must be hash refs (array of hashes)");
					av_push(rows, newRV_inc(SvRV(*ep)));
				}
			} else {
				HV *h = (HV*)rv;
				HE *e;
				hv_iterinit(h);
				while ((e = hv_iternext(h))) {
					SV *val = hv_iterval(h, e);
					if (!SvROK(val) || SvTYPE(SvRV(val)) != SVt_PVHV) croak("cfilter: every value must be a hash ref (hash of hashes)");
					av_push(rows, newRV_inc(SvRV(val)));
				}
			}
			nrows = av_len(rows) + 1;
			{// union of columns, in first-seen order.
				HV *seen = newHV();
				for (SSize_t r = 0; r < nrows; r++) {
					HV *row = (HV*)SvRV(*av_fetch(rows, r, 0));
					HE *ie;
					hv_iterinit(row);
					while ((ie = hv_iternext(row))) {
						SV *ck = hv_iterkeysv(ie);
						if (!hv_exists_ent(seen, ck, 0)) {
							(void)hv_store_ent(seen, ck, newSViv(1), 0);
							(void)hv_store_ent(universe, ck, newSViv(1), 0);
							av_push(colnames, newSVsv(ck));
						}
					}
				}
				SvREFCNT_dec((SV*)seen);
			}
			if (!by_name && !by_regex) {
				SSize_t nc = av_len(colnames) + 1;
				for (SSize_t c = 0; c < nc; c++) {
					SV *ck = *av_fetch(colnames, c, 0);
					AV *col = newAV();
					if (nrows > 0) av_extend(col, nrows - 1);
					for (SSize_t r = 0; r < nrows; r++) {
						HV *row = (HV*)SvRV(*av_fetch(rows, r, 0));
						HE *che = hv_fetch_ent(row, ck, 0, 0);
						SV *cell = che ? HeVAL(che) : NULL;
						av_push(col, (cell && SvOK(cell)) ? newSVsv(cell) : newSV(0));
					}
					(void)hv_store_ent(cellmap, ck, newRV_noinc((SV*)col), 0);
				}
			}
			SvREFCNT_dec((SV*)rows);
		}
		// 2b. resolve the `against` reference column into its cell array.
		AV *against_av = NULL;
		if (against_sv) {
			if (!SvOK(against_sv) || SvROK(against_sv)) croak("cfilter: against must be a column name (string)");
			if (!hv_exists_ent(universe, against_sv, 0)) croak("cfilter: against column '%s' not found in data", SvPV_nolen(against_sv));
			against_av = (AV*)SvRV(HeVAL(hv_fetch_ent(cellmap, against_sv, 0, 0)));
		}
		// 3. decide which columns to keep.
		HV *keepset = newHV();
		if (by_name) {
			AV *names = (AV*)SvRV(sel);
			HV *listed = newHV();
			SSize_t n = av_len(names) + 1;
			for (SSize_t i = 0; i < n; i++) {
				SV **ep = av_fetch(names, i, 0);
				if (!ep || !*ep || !SvOK(*ep)) croak("cfilter: column list contains an undefined entry");
				if (!hv_exists_ent(universe, *ep, 0)) croak("cfilter: column '%s' not found in data", SvPV_nolen(*ep));
				(void)hv_store_ent(listed, *ep, newSViv(1), 0);
			}
			SSize_t nc = av_len(colnames) + 1;
			for (SSize_t c = 0; c < nc; c++) {
				SV *ck = *av_fetch(colnames, c, 0);
				bool in_list = cBOOL(hv_exists_ent(listed, ck, 0));
				if (removing ? !in_list : in_list) (void)hv_store_ent(keepset, ck, newSViv(1), 0);
			}
			SvREFCNT_dec((SV*)listed);
		} else if (by_regex) {
			/* name pattern: keep/drop each column by matching its name against
			 the compiled qr//. No data is inspected, so na/against don't apply.*/
			REGEXP *rx = SvRX(sel);
			SSize_t nc = av_len(colnames) + 1;
			for (SSize_t c = 0; c < nc; c++) {
				SV *ck = *av_fetch(colnames, c, 0);
				STRLEN len;
				char *s = SvPV(ck, len);
				bool match = cBOOL(pregexec(rx, s, s + len, s, 0, ck, 1));
				if (removing ? !match : match) (void)hv_store_ent(keepset, ck, newSViv(1), 0);
			}
		} else {
			/* predicate over the flat colnames list (never a live hash iterator
			 across call_sv). Apply the undef policy per column.*/
			SSize_t nc = av_len(colnames) + 1;
			for (SSize_t c = 0; c < nc; c++) {
				SV *ck = *av_fetch(colnames, c, 0);
				AV *cells = (AV*)SvRV(HeVAL(hv_fetch_ent(cellmap, ck, 0, 0)));
				bool pass;
				if (against_av) {
					// two columns, pairwise complete: rows defined in BOTH
					AV *a1 = newAV(), *a2 = newAV();
					for (SSize_t r = 0; r < nrows; r++) {
						SV **p1 = av_fetch(cells, r, 0);
						SV **p2 = av_fetch(against_av, r, 0);
						if (p1 && *p1 && SvOK(*p1) && p2 && *p2 && SvOK(*p2)) {
							av_push(a1, newSVsv(*p1));
							av_push(a2, newSVsv(*p2));
						}
					}
					pass = cf_pred(aTHX_ cv_sv, a1, a2, ck);
					SvREFCNT_dec((SV*)a1);
					SvREFCNT_dec((SV*)a2);
				} else if (na_omit) {// one column, defined cells only
					AV *a1 = newAV();
					for (SSize_t r = 0; r < nrows; r++) {
						SV **p = av_fetch(cells, r, 0);
						if (p && *p && SvOK(*p)) av_push(a1, newSVsv(*p));
					}
					pass = cf_pred(aTHX_ cv_sv, a1, NULL, ck);
					SvREFCNT_dec((SV*)a1);// one column, every cell including undef
				} else {
					pass = cf_pred(aTHX_ cv_sv, cells, NULL, ck);
				}
				if (removing ? !pass : pass) (void)hv_store_ent(keepset, ck, newSViv(1), 0);
			}
		}
		// 4. rebuild the data in its original shape with only the kept columns.
		SV *out;
		if (kind == 1) {
			HV *outh = newHV(), *h = (HV*)rv;
			HE *e;
			hv_iterinit(h);
			while ((e = hv_iternext(h))) {
				SV *ck = hv_iterkeysv(e);
				if (!hv_exists_ent(keepset, ck, 0)) continue;
				AV *src = (AV*)SvRV(hv_iterval(h, e)), *dst = newAV();
				SSize_t n = av_len(src) + 1;
				if (n > 0) av_extend(dst, n - 1);
				for (SSize_t i = 0; i < n; i++) {
					SV **ep = av_fetch(src, i, 0);
					av_push(dst, (ep && *ep) ? newSVsv(*ep) : newSV(0));
				}
				(void)hv_store_ent(outh, ck, newRV_noinc((SV*)dst), 0);
			}
			out = (SV*)outh;
		} else if (kind == 2) {
			HV *outh = newHV(), *h = (HV*)rv;
			HE *e;
			hv_iterinit(h);
			while ((e = hv_iternext(h))) {
				SV *rk = hv_iterkeysv(e);
				HV *row = (HV*)SvRV(hv_iterval(h, e)), *nr = newHV();
				HE *ie;
				hv_iterinit(row);
				while ((ie = hv_iternext(row))) {
					SV *ck = hv_iterkeysv(ie);
					if (!hv_exists_ent(keepset, ck, 0)) continue;
					(void)hv_store_ent(nr, ck, newSVsv(HeVAL(ie)), 0);
				}
				(void)hv_store_ent(outh, rk, newRV_noinc((SV*)nr), 0);
			}
			out = (SV*)outh;
		} else {
			AV *outa = newAV(), *a = (AV*)rv;
			SSize_t n = av_len(a) + 1;
			for (SSize_t r = 0; r < n; r++) {
				HV *row = (HV*)SvRV(*av_fetch(a, r, 0)), *nr = newHV();
				HE *ie;
				hv_iterinit(row);
				while ((ie = hv_iternext(row))) {
					SV *ck = hv_iterkeysv(ie);
					if (!hv_exists_ent(keepset, ck, 0)) continue;
					(void)hv_store_ent(nr, ck, newSVsv(HeVAL(ie)), 0);
				}
				av_push(outa, newRV_noinc((SV*)nr));
			}
			out = (SV*)outa;
		}
		// 5. tidy up the scratch tables (the result keeps its own copies).
		SvREFCNT_dec((SV*)universe);
		SvREFCNT_dec((SV*)colnames);
		SvREFCNT_dec((SV*)keepset);
		if (cellmap) SvREFCNT_dec((SV*)cellmap);
		RETVAL = newRV_noinc(out);
	}
	OUTPUT:
		RETVAL

SV *hoh2hoa(data, ...)
		SV *data
	CODE:
	{
		/* 0. parse trailing name => value options (done before any allocation so
		    option/usage errors can't leak). undef.val sets the fill for a
		    missing key or an undef cell (default: undef). row.names, if given,
		    adds a column of that name holding the sorted row labels.*/
		SV *fill = NULL;   // NULL => fill gaps with undef
		SV *rn_sv = NULL;  // NULL => do not emit a row-names column
		if ((items - 1) & 1) croak("hoh2hoa: trailing options must be name => value pairs");
		for (int oi = 1; oi < items; oi += 2) {
			STRLEN ol;
			const char *oname = SvPV(ST(oi), ol);
			SV *oval = ST(oi + 1);
			if (ol == 9 && memEQ(oname, "undef.val", 9)) fill = SvOK(oval) ? oval : NULL;
			else if (ol == 9 && memEQ(oname, "row.names", 9)) {
				if (SvOK(oval) && !SvROK(oval)) rn_sv = oval;
				else croak("hoh2hoa: row.names must be a column name (string)");
			}
			else croak("hoh2hoa: unknown option '%s'", oname);
		}
		// 1. the input must be a hash ref (a hash of hashes).
		if (!SvROK(data) || SvTYPE(SvRV(data)) != SVt_PVHV) croak("hoh2hoa: data must be a hash ref (hash of hashes)");
		HV *in_hv = (HV*)SvRV(data);
		// 2. these cross the section boundaries (gather -> build -> cleanup).
		HV *out_hv = newHV();    // the result: column name -> array ref
		AV *rows_av = newAV();   // outer keys, sorted into the row order
		AV *cols_av = newAV();   // union of inner keys (column names)
		HV *seen = newHV();      // membership test while taking the union
		// 3. collect the outer keys (row labels) and sort for a stable row order.
		{
			HE *e;
			hv_iterinit(in_hv);
			while ((e = hv_iternext(in_hv))) {
				SV *rv = hv_iterval(in_hv, e);
				if (!SvROK(rv) || SvTYPE(SvRV(rv)) != SVt_PVHV) croak("hoh2hoa: every value must be a hash ref (hash of hashes)");
				av_push(rows_av, newSVsv(hv_iterkeysv(e)));
			}
		}
		SSize_t nrows = av_len(rows_av) + 1;
		if (nrows > 1) qsort(AvARRAY(rows_av), (size_t)nrows, sizeof(SV*), h2h_keycmp);
		/* 4. discover the union of inner keys. Each new column gets an empty array
		    in the result straight away so step 5 can just push into it.*/
		{
			HE *e;
			hv_iterinit(in_hv);
			while ((e = hv_iternext(in_hv))) {
				HV *row = (HV*)SvRV(hv_iterval(in_hv, e));
				HE *ie;
				hv_iterinit(row);
				while ((ie = hv_iternext(row))) {
					SV *ck = hv_iterkeysv(ie);
					if (!hv_exists_ent(seen, ck, 0)) {
						(void)hv_store_ent(seen, ck, &PL_sv_yes, 0);
						av_push(cols_av, newSVsv(ck));
						(void)hv_store_ent(out_hv, ck, newRV_noinc((SV*)newAV()), 0);
					}
				}
			}
		}
		SSize_t ncols = av_len(cols_av) + 1;
		/* 5. walk the rows in sorted order; for every column push the cell (a copy)
		    or the fill value, so each column ends up exactly nrows long.*/
		for (SSize_t r = 0; r < nrows; r++) {
			SV *rk = *av_fetch(rows_av, r, 0);
			HE *rhe = hv_fetch_ent(in_hv, rk, 0, 0);
			HV *row = (HV*)SvRV(HeVAL(rhe));
			for (SSize_t c = 0; c < ncols; c++) {
				SV *ck = *av_fetch(cols_av, c, 0);
				HE *che = hv_fetch_ent(row, ck, 0, 0);
				SV *src = che ? HeVAL(che) : NULL;
				SV *cell = (src && SvOK(src)) ? newSVsv(src) : (fill ? newSVsv(fill) : newSV(0));
				HE *colhe = hv_fetch_ent(out_hv, ck, 0, 0);
				av_push((AV*)SvRV(HeVAL(colhe)), cell);
			}
		}
		// 6. optional row-names column: the sorted labels under the requested name.
		if (rn_sv) {
			if (hv_exists_ent(out_hv, rn_sv, 0)) croak("hoh2hoa: row.names column '%s' collides with an existing column", SvPV_nolen(rn_sv));
			AV *rn_av = newAV();
			for (SSize_t r = 0; r < nrows; r++) av_push(rn_av, newSVsv(*av_fetch(rows_av, r, 0)));
			(void)hv_store_ent(out_hv, rn_sv, newRV_noinc((SV*)rn_av), 0);
		}
		// 7. tidy up the scratch structures (the result keeps its own copies).
		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 *df      = ST(0);
	SV *predarg = ST(1);
	const char *otype = NULL;
	if (items == 3) {
		otype = SvPV_nolen(ST(2));
	} else if (items == 4) {
		const char *key = SvPV_nolen(ST(2));
		if (strNE(key, "output.type") && strNE(key, "out") && strNE(key, "output_type"))
			croak("filter: unknown option '%s' (expected 'output.type')", key);
		otype = SvPV_nolen(ST(3));
	} else if (items > 4) {
		croak("Usage: filter($df, $code [, 'output.type' => 'aoh'|'hoa'])");
	}
	int want = 0; // 0 = preserve input shape
	if (otype) {
		if      (strEQ(otype, "aoh")) want = FLT_AOH;
		else if (strEQ(otype, "hoa")) want = FLT_HOA;
		else croak("filter: output.type must be 'aoh' or 'hoa' (got '%s')", otype);
	}
	if (!df || !SvROK(df))
		croak("filter: first argument must be a data frame (AoH, HoA, or HoH reference)");
	/*The predicate is a CODE ref, or a col() object carrying a CODE ref in
	its {code} field; either way we end up calling a single CV per row --
	unless the col() object also carries a {plan}, which is the same test as
	data and runs in C without touching perl at all.*/
	SV *code = NULL, *plan = NULL;
	if (predarg && SvROK(predarg) && SvTYPE(SvRV(predarg)) == SVt_PVCV) {
		code = predarg;
	} else if (predarg && sv_isobject(predarg)
			&& sv_derived_from(predarg, "Stats::LikeR::col")) {
		SV **cp = hv_fetchs((HV*)SvRV(predarg), "code", 0);
		if (!cp || !*cp || !SvROK(*cp) || SvTYPE(SvRV(*cp)) != SVt_PVCV)
			croak("filter: incomplete col() predicate -- a bare column needs a comparison, e.g. col('x') > 0");
		code = *cp;
		SV **pp = hv_fetchs((HV*)SvRV(predarg), "plan", 0);
		if (pp && *pp && SvROK(*pp)) plan = *pp;
	} else {
		croak("filter: predicate must be a CODE reference or a col() expression");
	}

	SV *ref = SvRV(df);
	short int in_shape;
	HV *inhv = NULL;
	AV *inav = NULL;
	if (SvTYPE(ref) == SVt_PVAV) {
		in_shape = FLT_AOH; inav = (AV*)ref;
	} else if (SvTYPE(ref) == SVt_PVHV) {
		inhv = (HV*)ref;
		hv_iterinit(inhv);
		HE *e0 = hv_iternext(inhv);
		if (!e0) { // empty hash: ambiguous shape -> empty result of the chosen/own shape
			SV *r = (want == FLT_AOH) ? newRV_noinc((SV*)newAV())
			                                   : newRV_noinc((SV*)newHV());
			ST(0) = sv_2mortal(r);
			XSRETURN(1);
		}
		SV *v0 = HeVAL(e0);
		if (v0 && SvROK(v0) && SvTYPE(SvRV(v0)) == SVt_PVAV)      in_shape = FLT_HOA;
		else if (v0 && SvROK(v0) && SvTYPE(SvRV(v0)) == SVt_PVHV) in_shape = FLT_HOH;
		else croak("filter: hash data frame must be a hash of arrays (HoA) or a hash of hashes (HoH)");
	} else {
		croak("filter: unsupported data frame; expected AoH, HoA, or HoH");
	}
	int out_shape = want ? want : in_shape;

	SV *result = NULL;
	ENTER; SAVETMPS;
	/*A col() expression that describes itself is run in C; anything else
	(a plain sub, a ->match regex) goes through filt_call as before.*/
	flt_prog prog_buf;
	flt_prog *prog = (plan && flt_compile(aTHX_ &prog_buf, plan)) ? &prog_buf : NULL;
	if (in_shape == FLT_AOH) {
		SSize_t n = av_len(inav) + 1, i;
		/*pass 1: which rows are kept.  Knowing the count before anything is
		built lets every output array be allocated at its final size.*/
		char *keep = (char*)safemalloc(n ? (size_t)n : 1);
		SAVEFREEPV(keep);
		SSize_t kept = 0;
		/*AoH -> HoA also needs the union of the columns, taken from every row
		and not just the kept ones, so a column that only dropped rows had
		still appears (as a column of undefs) in the output.*/
		HV *out   = NULL, *reg = NULL;
		AV *order = NULL;
		if (out_shape == FLT_HOA) {
			out   = (HV*)sv_2mortal((SV*)newHV());
			reg   = (HV*)sv_2mortal((SV*)newHV());
			order = (AV*)sv_2mortal((SV*)newAV());
		}
		for (i = 0; i < n; i++) {
			SV *rv = av_row_at(aTHX_ inav, i);
			if (!rv)
				croak("filter: AoH element %ld is not a HASH reference", (long)i);
			HV *rh = (HV*)SvRV(rv);
			if (order) {
				hv_iterinit(rh); HE *e;
				while ((e = hv_iternext(rh))) {
					STRLEN kl; char *k = HePV(e, kl);
					flt_reg_col(aTHX_ reg, order, out, k, kl);
				}
			}
			char k = (prog ? flt_row_hv(aTHX_ prog, rh)
			               : filt_call(aTHX_ code, rv, sv_2mortal(newSViv(i)))) ? 1 : 0;
			keep[i] = k; kept += k;
		}
		if (out_shape == FLT_AOH) {
			AV *outa = (AV*)sv_2mortal((SV*)newAV());
			if (kept) {
				av_extend(outa, kept - 1);
				SV **d = AvARRAY(outa); SSize_t t = 0;
				for (i = 0; i < n; i++) {
					if (!keep[i]) continue;
					/*the row was a hash ref when it was tested; a predicate
					that went and emptied the frame behind us must not turn
					that into a crash*/
					SV *rv = av_row_at(aTHX_ inav, i);
					d[t++] = rv ? av_row_keep(aTHX_ rv) : newSV(0);	//share row
				}
				FLT_AV_FILLED(outa, kept);
			}
			result = newRV_inc((SV*)outa);
		} else {	// AoH -> HoA: fill column by column
			SSize_t ncn = av_len(order) + 1, j;
			SSize_t *idx = flt_kept_index(aTHX_ keep, n, kept);
			for (j = 0; j < ncn; j++) {
				SV **np = av_fetch(order, j, 0);
				STRLEN kl; char *k = SvPV(*np, kl);
				AV *o = (AV*)SvRV(*hv_fetch(out, k, kl, 0));
				if (!kept) continue;
				av_extend(o, kept - 1);
				SV **d = AvARRAY(o);
				for (SSize_t t = 0; t < kept; t++) {
					SV *rv = av_row_at(aTHX_ inav, idx[t]);
					HV *rh = rv ? (HV*)SvRV(rv) : NULL;
					SV **cp = rh ? hv_fetch(rh, k, kl, 0) : NULL;
					d[t] = newSVsv((cp && *cp) ? *cp : &PL_sv_undef);
				}
				FLT_AV_FILLED(o, kept);
			}
			result = newRV_inc((SV*)out);
		}
	} else if (in_shape == FLT_HOA) {
		U32 ncols = hv_iterinit(inhv), c;
		char   **names = (char**)safemalloc((ncols?ncols:1) * sizeof(char*));
		STRLEN  *nlens = (STRLEN*)safemalloc((ncols?ncols:1) * sizeof(STRLEN));
		AV     **cols  = (AV**)safemalloc((ncols?ncols:1) * sizeof(AV*));
		SAVEFREEPV(names); SAVEFREEPV(nlens); SAVEFREEPV(cols);
		SSize_t maxrows = 0, i; HE *e; c = 0;
		while ((e = hv_iternext(inhv)) && c < ncols) {
			SV *v = HeVAL(e);
			STRLEN kl; char *k = HePV(e, kl);
			if (!v || !SvROK(v) || SvTYPE(SvRV(v)) != SVt_PVAV)
				croak("filter: HoA column '%s' is not an ARRAY reference", k);
			AV *a = (AV*)SvRV(v);
			SSize_t len = av_len(a) + 1;
			if (len > maxrows) maxrows = len;
			names[c] = k; nlens[c] = kl; cols[c] = a; c++;
		}
		if (prog) flt_bind_hoa(aTHX_ prog, inhv);
		/*The closure path needs a row hash; the compiled path reads the
		columns straight out of the frame and never builds one.*/
		flt_rowbuf *rb = NULL;
		if (!prog) {
			rb = (flt_rowbuf*)safemalloc(sizeof(flt_rowbuf));
			SAVEFREEPV(rb);
			Zero(rb, 1, flt_rowbuf);
			rb->n = c; rb->names = names; rb->nlens = nlens;
			rb->slot = (SV**)safemalloc((c?c:1) * sizeof(SV*));
			SAVEFREEPV(rb->slot);
			SAVEDESTRUCTOR_X(flt_rb_free, rb);
			flt_rb_new(aTHX_ rb);
		}
		char *keep = (char*)safemalloc(maxrows ? (size_t)maxrows : 1);
		SAVEFREEPV(keep);
		SSize_t kept = 0;
		if (out_shape == FLT_HOA) {
			for (i = 0; i < maxrows; i++) {
				bool k;
				if (prog) {
					k = flt_row_hoa(aTHX_ prog, i);
				} else {
					for (U32 cc = 0; cc < c; cc++) {
						SV **vp = av_fetch(cols[cc], i, 0);
						sv_setsv(rb->slot[cc], (vp && *vp) ? *vp : &PL_sv_undef);
					}
					k = filt_call(aTHX_ code, rb->rv, sv_2mortal(newSViv(i)));
					if (!flt_rb_reusable(aTHX_ rb)) { flt_rb_free(aTHX_ rb); flt_rb_new(aTHX_ rb); }
				}
				keep[i] = k ? 1 : 0; kept += k ? 1 : 0;
			}
			SSize_t *idx = flt_kept_index(aTHX_ keep, maxrows, kept);
			HV *out = (HV*)sv_2mortal((SV*)newHV());
			for (U32 cc = 0; cc < c; cc++) {
				AV *o = newAV();
				hv_store(out, names[cc], nlens[cc], newRV_noinc((SV*)o), 0);
				if (!kept) continue;
				av_extend(o, kept - 1);
				SV **d = AvARRAY(o);
				AV *sa = cols[cc];
				if (SvRMAGICAL(sa)) {
					/*Tied: the cells do not exist until FETCH has run, so
					AvARRAY() would copy the wrong block.  av_fetch() also
					re-derives the block each time, which is what makes it
					safe for a FETCH that writes to the array it is reading.*/
					for (SSize_t t = 0; t < kept; t++) {
						SV **p = av_fetch(sa, idx[t], 0);
						d[t] = flt_cell_copy(aTHX_ (p && *p) ? *p : NULL);
						AvFILLp(o) = t;
					}
				} else {
					SV **src = AvARRAY(sa);
					const SSize_t srcn = AvFILLp(sa) + 1;
					if (srcn >= maxrows) {		//the usual case: no ragged tail
						for (SSize_t t = 0; t < kept; t++) {
							SV *v = src[idx[t]];
							d[t] = flt_cell_copy(aTHX_ v);
						}
					} else {
						for (SSize_t t = 0; t < kept; t++) {
							const SSize_t r = idx[t];
							d[t] = flt_cell_copy(aTHX_ (r < srcn) ? src[r] : NULL);
						}
					}
					FLT_AV_FILLED(o, kept);
				}
			}
			result = newRV_inc((SV*)out);
		} else {	// HoA -> AoH
			AV *out = (AV*)sv_2mortal((SV*)newAV());
			if (prog) {
				for (i = 0; i < maxrows; i++) {
					char k = flt_row_hoa(aTHX_ prog, i) ? 1 : 0;
					keep[i] = k; kept += k;
				}
				if (kept) {
					av_extend(out, kept - 1);
					SV **d = AvARRAY(out); SSize_t t = 0;
					for (i = 0; i < maxrows; i++) {
						if (!keep[i]) continue;
						HV *rowh = newHV();
						hv_ksplit(rowh, c ? c : 1);
						for (U32 cc = 0; cc < c; cc++) {
							SV **vp = av_fetch(cols[cc], i, 0);
							hv_store(rowh, names[cc], nlens[cc],
							         newSVsv((vp && *vp) ? *vp : &PL_sv_undef), 0);
						}
						d[t++] = newRV_noinc((SV*)rowh);
					}
					FLT_AV_FILLED(out, kept);
				}
			} else {
				for (i = 0; i < maxrows; i++) {
					for (U32 cc = 0; cc < c; cc++) {
						SV **vp = av_fetch(cols[cc], i, 0);
						sv_setsv(rb->slot[cc], (vp && *vp) ? *vp : &PL_sv_undef);
					}
					if (filt_call(aTHX_ code, rb->rv, sv_2mortal(newSViv(i)))) {
						av_push(out, rb->rv);	//the kept row IS the buffer
						rb->rv = NULL;
						flt_rb_new(aTHX_ rb);
					} else if (!flt_rb_reusable(aTHX_ rb)) {
						flt_rb_free(aTHX_ rb); flt_rb_new(aTHX_ rb);
					}
				}
			}
			result = newRV_inc((SV*)out);
		}
	} else {	// FLT_HOH
		HE *e;
		if (out_shape == FLT_HOA) {
			HV *out   = (HV*)sv_2mortal((SV*)newHV());
			HV *reg   = (HV*)sv_2mortal((SV*)newHV());
			AV *order = (AV*)sv_2mortal((SV*)newAV());
			AV *rows  = (AV*)sv_2mortal((SV*)newAV());	//the kept rows
			hv_iterinit(inhv);
			while ((e = hv_iternext(inhv))) {
				SV *v = HeVAL(e);
				STRLEN kl; char *k = HePV(e, kl);
				if (!v || !SvROK(v) || SvTYPE(SvRV(v)) != SVt_PVHV)
					croak("filter: HoH row '%s' is not a HASH reference", k);
				HV *rh = (HV*)SvRV(v);
				hv_iterinit(rh); HE *ie;	//columns come from every row ...
				while ((ie = hv_iternext(rh))) {
					STRLEN il; char *ik = HePV(ie, il);
					flt_reg_col(aTHX_ reg, order, out, ik, il);
				}
				if (prog ? flt_row_hv(aTHX_ prog, rh)		//... values only from the kept ones
				         : filt_call(aTHX_ code, v, hv_iterkeysv(e)))
					av_push(rows, SvREFCNT_inc_simple_NN(v));
			}
			SSize_t ncn = av_len(order) + 1, j;
			SSize_t kept = av_len(rows) + 1;
			for (j = 0; j < ncn; j++) {
				SV **np = av_fetch(order, j, 0);
				STRLEN kl; char *k = SvPV(*np, kl);
				AV *o = (AV*)SvRV(*hv_fetch(out, k, kl, 0));
				if (!kept) continue;
				av_extend(o, kept - 1);
				SV **d = AvARRAY(o);
				for (SSize_t t = 0; t < kept; t++) {
					HV *rh = (HV*)SvRV(AvARRAY(rows)[t]);
					SV **cp = hv_fetch(rh, k, kl, 0);
					d[t] = newSVsv((cp && *cp) ? *cp : &PL_sv_undef);
				}
				FLT_AV_FILLED(o, kept);
			}
			result = newRV_inc((SV*)out);
		} else {	// HoH -> HoH (preserve) or HoH -> AoH
			HV *outh = NULL; AV *outa = NULL;
			if (out_shape == FLT_HOH) outh = (HV*)sv_2mortal((SV*)newHV());
			else                      outa = (AV*)sv_2mortal((SV*)newAV());
			hv_iterinit(inhv);
			while ((e = hv_iternext(inhv))) {
				SV *v = HeVAL(e);
				STRLEN kl; char *k = HePV(e, kl);
				if (!v || !SvROK(v) || SvTYPE(SvRV(v)) != SVt_PVHV)
					croak("filter: HoH row '%s' is not a HASH reference", k);
				if (!(prog ? flt_row_hv(aTHX_ prog, (HV*)SvRV(v))
				           : filt_call(aTHX_ code, v, hv_iterkeysv(e)))) continue;
				if (outh) hv_store(outh, k, kl, SvREFCNT_inc_simple_NN(v), 0);
				else      av_push(outa, SvREFCNT_inc_simple_NN(v));
			}
			result = newRV_inc(outh ? (SV*)outh : (SV*)outa);
		}
	}
	FREETMPS; LEAVE;
	ST(0) = sv_2mortal(result);
	XSRETURN(1);
}

SV *col2col(data, cmd, cols = &PL_sv_undef, ...)
		SV *data
		SV *cmd
		SV *cols
	CODE:
	{
/* Only these cross the section boundaries (build -> loop -> cleanup);
  everything else is declared at its point of use just below.*/
		SV *cv_sv = NULL;
		size_t ncols = 0, nrows = 0;
		AV *names_av = newAV();
		NV **col_val = NULL;
		char **col_def = NULL;
		short int na_mode = 0;	// 0 = pairwise, 1 = omit, 2 = keep; see section 0
		bool skip_errors = TRUE;	// skip.errors (default true): trap a croaking block, store its message
/* 0. options. They may be given either as trailing name => value pairs
  (after the positional cols), or - so no placeholder is needed when
  there is no column restriction - as a single hash ref in cols's
  place, e.g. col2col($data, 'cor', { 'skip.errors' => 1 }).
  `na` controls how undef is handled when one column is paired with
  another:
    'pairwise' (default) - a row counts for the (a,b) pair only if
        BOTH columns are defined there, so the block gets two equal
        length, aligned columns. This is what paired stats (cor) want.
    'omit'   - each column independently drops its own undef values,
        so the two columns may differ in length. This is what unpaired
        tests (t_test, kruskal_test) want: a gap in one column must not
        throw away a good value in the other.
    'keep'   - every row passes through and undef reaches the block.
  rm.undef / rm.na (bool) remain as aliases: true => 'pairwise' (the
  old default), false => 'keep'.
  skip.errors (bool, default true): a block that croaks for a pair
  does not abort col2col; instead the first line of its error message
  is stored as that cell's value, so the result shows which
  (outer => inner) pair failed and why. Set it false to make a croak
  propagate and abort the whole call instead.*/
		SV *cols_eff = cols;
		bool na_set = FALSE, rm_set = FALSE;
#define C2C_DECODE_OPT(ONAME, OL, OVAL) do { \
		if ((OL) == 2 && memEQ((ONAME), "na", 2)) { \
			STRLEN vl_; const char *nv_ = SvPV((OVAL), vl_); \
			if (vl_ == 8 && memEQ(nv_, "pairwise", 8)) na_mode = 0; \
			else if (vl_ == 4 && memEQ(nv_, "omit", 4)) na_mode = 1; \
			else if (vl_ == 4 && memEQ(nv_, "keep", 4)) na_mode = 2; \
			else croak("col2col: na must be 'pairwise', 'omit' or 'keep'"); \
			na_set = TRUE; \
		} else if (((OL) == 8 && memEQ((ONAME), "rm.undef", 8)) || ((OL) == 5 && memEQ((ONAME), "rm.na", 5))) { \
			na_mode = cBOOL(SvTRUE((OVAL))) ? 0 : 2; rm_set = TRUE; \
		} else if ((OL) == 11 && memEQ((ONAME), "skip.errors", 11)) { \
			skip_errors = cBOOL(SvTRUE((OVAL))); \
		} else croak("col2col: unknown option '%s'", (ONAME)); \
		} while (0)
		if (SvROK(cols) && SvTYPE(SvRV(cols)) == SVt_PVHV) {
			// options supplied as a hash ref instead of cols: no column restriction
			HV *oh = (HV*)SvRV(cols);
			HE *he;
			if (items > 3) croak("col2col: an options hash ref must be the last argument");
			hv_iterinit(oh);
			while ((he = hv_iternext(oh))) {
				STRLEN ol;
				const char *oname = HePV(he, ol);
				SV *oval = HeVAL(he);
				C2C_DECODE_OPT(oname, ol, oval);
			}
			cols_eff = &PL_sv_undef;
		} else if (items > 3) {
			if ((items - 3) & 1) croak("col2col: trailing options must be name => value pairs");
			for (int oi = 3; oi < items; oi += 2) {
				STRLEN ol;
				const char *oname = SvPV(ST(oi), ol);
				SV *oval = ST(oi + 1);
				C2C_DECODE_OPT(oname, ol, oval);
			}
		}
		if (na_set && rm_set) croak("col2col: give na or rm.undef, not both");
#undef C2C_DECODE_OPT
		/* 1. resolve the command: a CODE block or a function name. Either way
		    we end up with the CV to call as $cv->($col_a, $col_b).*/
		if (SvROK(cmd) && SvTYPE(SvRV(cmd)) == SVt_PVCV) cv_sv = SvRV(cmd);
		else if (SvOK(cmd) && !SvROK(cmd)) {
			STRLEN nl;
			const char *name = SvPV(cmd, nl);
			SV *fq = strstr(name, "::") ? newSVpvn(name, nl) : newSVpvf("Stats::LikeR::%s", name);
			CV *cv = get_cv(SvPV_nolen(fq), 0);
			SvREFCNT_dec(fq);
			if (!cv) croak("col2col: unknown function '%s'", name);
			cv_sv = (SV*)cv;
		} else croak("col2col: command must be a CODE ref or a function name");
		// 2. detect the data shape and build per-column value/defined tables.
		if (!SvROK(data)) croak("col2col: data must be a reference");
		{
			SV *rv = SvRV(data);
			short int kind;
			if (SvTYPE(rv) == SVt_PVAV) kind = 1;
			else if (SvTYPE(rv) == SVt_PVHV) {
				HV *h = (HV*)rv;
				hv_iterinit(h);
				HE *e = hv_iternext(h);
				if (!e) croak("col2col: empty data hash");
				SV *first = hv_iterval(h, e);
				if (SvROK(first) && SvTYPE(SvRV(first)) == SVt_PVAV) kind = 0;
				else if (SvROK(first) && SvTYPE(SvRV(first)) == SVt_PVHV) kind = 2;
				else croak("col2col: hash values must be array refs (HoA) or hash refs (HoH)");
			}
			else croak("col2col: data must be an array ref or hash ref");
			if (kind == 0) { // hash of arrays: names = keys, rows = longest column.
				HV *h = (HV*)rv;
				AV **src = NULL;
				HE *e;
				hv_iterinit(h);
				while ((e = hv_iternext(h))) {
					SV *val = hv_iterval(h, e);
					if (!SvROK(val) || SvTYPE(SvRV(val)) != SVt_PVAV) continue;
					av_push(names_av, newSVsv(hv_iterkeysv(e)));
					AV *a = (AV*)SvRV(val);
					size_t len = (size_t)(av_len(a) + 1);
					if (len > nrows) nrows = len;
					Renew(src, av_len(names_av) + 1, AV*);
					src[av_len(names_av)] = a;
				}
				ncols = (size_t)(av_len(names_av) + 1);
				Newxz(col_val, ncols ? ncols : 1, NV*);
				Newxz(col_def, ncols ? ncols : 1, char*);
				for (size_t cc = 0; cc < ncols; cc++) {
					Newxz(col_val[cc], nrows ? nrows : 1, NV);
					Newxz(col_def[cc], nrows ? nrows : 1, char);
					AV *a = src[cc];
					for (size_t r = 0; r < nrows; r++) {
						NV v;
						if (c2c_num(aTHX_ av_fetch(a, (SSize_t)r, 0), &v)) { col_val[cc][r] = v; col_def[cc][r] = 1; }
					}
				}
				Safefree(src);
			} else {
				// row-major (array of hashes / hash of hashes): union of keys.
				HV **row_hv = NULL;
				if (kind == 1) {
					AV *a = (AV*)rv;
					nrows = (size_t)(av_len(a) + 1);
					Newxz(row_hv, nrows ? nrows : 1, HV*);
					for (size_t r = 0; r < nrows; r++) {
						SV **ep = av_fetch(a, (SSize_t)r, 0);
						if (ep && *ep && SvROK(*ep) && SvTYPE(SvRV(*ep)) == SVt_PVHV) row_hv[r] = (HV*)SvRV(*ep);
					}
				} else {
					HV *h = (HV*)rv;
					HE *e;
					size_t r = 0;
					nrows = (size_t)HvKEYS(h);
					Newxz(row_hv, nrows ? nrows : 1, HV*);
					hv_iterinit(h);
					while ((e = hv_iternext(h)) && r < nrows) {
						SV *val = hv_iterval(h, e);
						if (SvROK(val) && SvTYPE(SvRV(val)) == SVt_PVHV) row_hv[r] = (HV*)SvRV(val);
						r++;
					}
				}
				{
					HV *seen = newHV();
					for (size_t r = 0; r < nrows; r++) {
						if (!row_hv[r]) continue;
						HE *e;
						hv_iterinit(row_hv[r]);
						while ((e = hv_iternext(row_hv[r]))) {
							SV *knm = hv_iterkeysv(e);	// preserves the UTF-8 flag
							if (!hv_exists_ent(seen, knm, 0)) { (void)hv_store_ent(seen, knm, &PL_sv_yes, 0); av_push(names_av, newSVsv(knm)); }
						}
					}
					SvREFCNT_dec((SV*)seen);
				}
				ncols = (size_t)(av_len(names_av) + 1);
				Newxz(col_val, ncols ? ncols : 1, NV*);
				Newxz(col_def, ncols ? ncols : 1, char*);
				for (size_t cc = 0; cc < ncols; cc++) {
					SV *knm = *av_fetch(names_av, (SSize_t)cc, 0);	// keep the SV so UTF-8 keys match
					Newxz(col_val[cc], nrows ? nrows : 1, NV);
					Newxz(col_def[cc], nrows ? nrows : 1, char);
					for (size_t r = 0; r < nrows; r++) {
						NV v;
						HE *he;
						SV *cell;
						if (!row_hv[r]) continue;
						he = hv_fetch_ent(row_hv[r], knm, 0, 0);
						cell = he ? HeVAL(he) : NULL;
						if (c2c_num(aTHX_ &cell, &v)) { col_val[cc][r] = v; col_def[cc][r] = 1; }
					}
				}
				Safefree(row_hv);
			}
		}
		if (ncols == 0) croak("col2col: no usable columns found");
/* 3. gather the column-name SVs; keys are stored via hv_store_ent below
     so the UTF-8 flag rides along and non-ASCII names round-trip.*/
		SV **col_names;
		Newx(col_names, ncols, SV*);
		for (size_t cc = 0; cc < ncols; cc++) {
			col_names[cc] = *av_fetch(names_av, (SSize_t)cc, 0);
		}
/* 3b. decide which columns may be col_a (the outer/"from" side). With no
      restriction every column qualifies; a name or list narrows it.*/
		char *is_outer;
		Newxz(is_outer, ncols, char);
		if (!SvOK(cols_eff)) {
			for (size_t cc = 0; cc < ncols; cc++) is_outer[cc] = 1;
		} else if (SvROK(cols_eff) && SvTYPE(SvRV(cols_eff)) == SVt_PVAV) {
			AV *want = (AV*)SvRV(cols_eff);
			SSize_t n = av_len(want) + 1;
			for (SSize_t i = 0; i < n; i++) {
				SV **ep = av_fetch(want, i, 0);
				if (!ep || !*ep || !SvOK(*ep)) croak("col2col: column list contains an undefined entry");
				if (!c2c_mark(aTHX_ col_names, ncols, *ep, is_outer)) croak("col2col: column '%s' not found in data", SvPV_nolen(*ep));
			}
		} else if (!SvROK(cols_eff)) {
			if (!c2c_mark(aTHX_ col_names, ncols, cols_eff, is_outer)) croak("col2col: column '%s' not found in data", SvPV_nolen(cols_eff));
		} else croak("col2col: cols must be a column name or an array ref of names");
/*4. each selected column vs every other column. The two columns reach
 the block as @_ = ($col_a, $col_b); how undef is handled depends on
 na (section 0): 'pairwise' drops a row missing in either side (equal
 aligned lengths, for cor); 'omit' drops each column's own undef
 independently (lengths may differ, for t_test / kruskal_test);
 'keep' passes every row through with undef in the gaps.*/
		HV *out_hv = newHV();
		for (size_t a = 0; a < ncols; a++) {
			HV *inner;
			if (!is_outer[a]) continue;
			inner = newHV();
			for (size_t b = 0; b < ncols; b++) {
				AV *ca, *cb;
				SV *rv1, *rv2, *res;
				if (a == b) continue;
				ca = newAV();
				cb = newAV();
				if (na_mode == 0) { // pairwise complete: keep rows defined in both
					for (size_t r = 0; r < nrows; r++)
						if (col_def[a][r] && col_def[b][r]) { av_push(ca, newSVnv(col_val[a][r])); av_push(cb, newSVnv(col_val[b][r])); }
				} else if (na_mode == 1) { // omit: each column drops its own undef (lengths may differ)
					for (size_t r = 0; r < nrows; r++) if (col_def[a][r]) av_push(ca, newSVnv(col_val[a][r]));
					for (size_t r = 0; r < nrows; r++) if (col_def[b][r]) av_push(cb, newSVnv(col_val[b][r]));
				} else { // keep: every row, undef passed through
					for (size_t r = 0; r < nrows; r++) {
						av_push(ca, col_def[a][r] ? newSVnv(col_val[a][r]) : newSV(0));
						av_push(cb, col_def[b][r] ? newSVnv(col_val[b][r]) : newSV(0));
					}
				}
				rv1 = newRV_noinc((SV*)ca);
				rv2 = newRV_noinc((SV*)cb);
				if (av_len(ca) < 0 || av_len(cb) < 0) {
					res = newSV(0);	// a column had no usable values for this pair
				} else if (!skip_errors) {
					res = c2c_call(aTHX_ cv_sv, rv1, rv2);	// a croak here propagates
				} else {
					/* skip.errors: run the block under eval; on a croak keep the
					 first line of its message as this cell so the caller sees
					 which pair failed and why instead of the whole call dying.*/
					dSP;
					int n;
					ENTER; SAVETMPS;
					PUSHMARK(SP);
					XPUSHs(rv1); XPUSHs(rv2);
					PUTBACK;
					n = call_sv(cv_sv, G_SCALAR | G_EVAL);
					SPAGAIN;
					if (SvTRUE(ERRSV)) {
						STRLEN el;
						const char *ep = SvPV(ERRSV, el);
						STRLEN ll = 0;	// length of the first line only
						while (ll < el && ep[ll] != '\n' && ep[ll] != '\r') ll++;
						res = newSVpvn(ep, ll);
						if (n > 0) (void)POPs;	// discard the undef G_SCALAR leaves
					} else {
						res = (n > 0) ? newSVsv(POPs) : newSV(0);
					}
					PUTBACK;
					FREETMPS; LEAVE;
				}
				(void)hv_store_ent(inner, col_names[b], res, 0);
				SvREFCNT_dec(rv1);
				SvREFCNT_dec(rv2);
			}
			(void)hv_store_ent(out_hv, col_names[a], newRV_noinc((SV*)inner), 0);
		}
		// 5. tidy up.
		for (size_t cc = 0; cc < ncols; cc++) { Safefree(col_val[cc]); Safefree(col_def[cc]); }
		Safefree(col_val);	Safefree(col_def); Safefree(col_names);
		Safefree(is_outer);	SvREFCNT_dec((SV*)names_av);
		RETVAL = newRV_noinc((SV*)out_hv);
	}
	OUTPUT:
		RETVAL

SV *oneway_test(data_ref, ...)
	SV *data_ref
	PREINIT:
		HV          *in_hv = NULL;
		AV          *in_av = NULL;
		HE          *he;
		bool         var_equal = 0;
		const char  *formula_str = NULL;
		const char  *factor_name = "Group";
		char        *lhs = NULL, *rhs = NULL;
		NV          *flat   = NULL;
		size_t      *sizes  = NULL;
		char       **gnames = NULL;
		NV          *gmeans = NULL;
		size_t       k = 0;
		IV           total_n = 0;
		OneWayResult res;
		HV          *ret_hv;
		char         errbuf[512];
	CODE:
	{
		//parse named arguments
		for (I32 ai = 1; ai + 1 < items; ai += 2) {
			const char *key = SvPV_nolen(ST(ai));
			SV         *val = ST(ai + 1);
			if (strEQ(key, "var_equal") || strEQ(key, "var.equal"))
				var_equal = SvTRUE(val) ? 1 : 0;
			else if (strEQ(key, "formula"))
				formula_str = SvPV_nolen(val);
		}

		// validate data_ref: must be an ARRAY or HASH reference
		if (!SvROK(data_ref))
			croak("oneway_test: first argument must be a hash or array reference");
		SV *rv = SvRV(data_ref);
		if      (SvTYPE(rv) == SVt_PVHV) in_hv = (HV *)rv;
		else if (SvTYPE(rv) == SVt_PVAV) in_av = (AV *)rv;
		else croak("oneway_test: first argument must be a hash or array reference");

		if (in_av) {//---- MODE 3: array of arrays (AoA) ----
			if (formula_str != NULL)
				croak("oneway_test: formula mode is not supported with an array of arrays");

			k = (size_t)(av_len(in_av) + 1);          //+1 inside the signed math
			if (k < 2)
				croak("oneway_test: need at least 2 groups, got %" UVuf, (UV)k);
			Newx(sizes,   k, size_t);
			Newxz(gnames, k, char *);                  //zeroed: safe to free on error
			//first pass: validate, sizes, total_n, synthesised names
			for (size_t g = 0; g < k; g++) {
				SV **val = av_fetch(in_av, (I32)g, 0);
				if (!val || !*val || !SvROK(*val) || SvTYPE(SvRV(*val)) != SVt_PVAV) {
					snprintf(errbuf, sizeof errbuf, "index %zu is not an array reference", g);
					goto fail;
				}
				IV len = av_len((AV *)SvRV(*val)) + 1;
				if (len < 2) {
					snprintf(errbuf, sizeof errbuf, "index %zu has fewer than 2 observations", g);
					goto fail;
				}
				sizes[g] = (size_t)len;
				total_n += len;
				char buf[64];
				snprintf(buf, sizeof buf, "Index %zu", g);
				gnames[g] = savepv(buf);               //perl-managed copy
			}

			//second pass: fill flat, validating each cell
			Newx(flat, (size_t)total_n, NV);
			size_t offset = 0;
			for (size_t g = 0; g < k; g++) {
				AV *av = (AV *)SvRV(*av_fetch(in_av, (I32)g, 0));
				IV len = av_len(av) + 1;
				for (IV i = 0; i < len; i++) {
					SV **svp = av_fetch(av, i, 0);
					if (!svp || !*svp || !SvOK(*svp) || !looks_like_number(*svp)) {
						snprintf(errbuf, sizeof errbuf,
							"index %zu, observation %ld is undefined or non-numeric",
							g, (long)i);
						goto fail;
					}
					flat[offset++] = SvNV(*svp);
				}
			}
		}
		else if (formula_str != NULL) {
			//MODE 2: formula "response ~ factor"
			if (!parse_formula(formula_str, &lhs, &rhs))
				croak("oneway_test: cannot parse formula '%s' — expected 'response ~ factor'",
					formula_str);
			factor_name = rhs; //freed after output

			SV **resp_svp = hv_fetch(in_hv, lhs, (I32)strlen(lhs), 0);
			if (!resp_svp || !*resp_svp || !SvROK(*resp_svp)
					|| SvTYPE(SvRV(*resp_svp)) != SVt_PVAV) {
				snprintf(errbuf, sizeof errbuf,
					"formula LHS '%s' not found as an array ref in the hash", lhs);
				goto fail; //was leaking lhs/rhs
			}
			SV **fact_svp = hv_fetch(in_hv, rhs, (I32)strlen(rhs), 0);
			if (!fact_svp || !*fact_svp || !SvROK(*fact_svp)
					|| SvTYPE(SvRV(*fact_svp)) != SVt_PVAV) {
				snprintf(errbuf, sizeof errbuf,
					"formula RHS '%s' not found as an array ref in the hash", rhs);
				goto fail;                              //was leaking lhs/rhs
			}

			AV *resp_av  = (AV *)SvRV(*resp_svp);
			AV *label_av = (AV *)SvRV(*fact_svp);
			IV  n = av_len(resp_av) + 1;
			Newx(flat,  (size_t)(n > 0 ? n : 0), NV);
			Newx(sizes, (size_t)(n > 0 ? n : 0), size_t); //k <= n upper bound

			if (!build_groups_from_formula(aTHX_ resp_av, label_av,
					flat, sizes, &k, &gnames, errbuf, sizeof errbuf))
				goto fail; //errbuf already set; fail frees all

			for (size_t g = 0; g < k; g++) total_n += (IV)sizes[g];
		}
		else {
			//MODE 1: hash of groups { label => \@obs, ... }
			k = (size_t)HvUSEDKEYS(in_hv); //robust count, not iterinit's
			if (k < 2)
				croak("oneway_test: need at least 2 groups, got %" UVuf, (UV)k);

			Newx(sizes,   k, size_t);
			Newxz(gnames, k, char *);

			//first pass: validate, sizes, total_n, key strings
			hv_iterinit(in_hv);
			for (size_t g = 0; (he = hv_iternext(in_hv)) != NULL; g++) {
				SV *val = HeVAL(he);
				if (!SvROK(val) || SvTYPE(SvRV(val)) != SVt_PVAV) {
					snprintf(errbuf, sizeof errbuf,
						"value for group '%s' is not an array ref", HePV(he, PL_na));
					goto fail;
				}
				IV len = av_len((AV *)SvRV(val)) + 1;
				if (len < 2) {
					snprintf(errbuf, sizeof errbuf,
						"group '%s' has fewer than 2 observations", HePV(he, PL_na));
					goto fail;
				}
				sizes[g] = (size_t)len;
				total_n += len;
				STRLEN klen;
				const char *kstr = HePV(he, klen);
				gnames[g] = savepvn(kstr, klen); //keeps embedded NULs
			}
			//second pass: fill flat in the same iteration order, validating
			Newx(flat, (size_t)total_n, NV);
			size_t offset = 0;
			hv_iterinit(in_hv);
			while ((he = hv_iternext(in_hv)) != NULL) {
				AV *av  = (AV *)SvRV(HeVAL(he));
				IV  len = av_len(av) + 1;
				for (IV i = 0; i < len; i++) {
					SV **svp = av_fetch(av, i, 0);
					if (!svp || !*svp || !SvOK(*svp) || !looks_like_number(*svp)) {
						snprintf(errbuf, sizeof errbuf,
							"group '%s', observation %ld is undefined or non-numeric",
							HePV(he, PL_na), (long)i);
						goto fail;
					}
					flat[offset++] = SvNV(*svp);
				}
			}
		}
		// per-group means from flat (computed before the arithmetic)
		Newx(gmeans, k, NV);
		{
			size_t offset = 0;
			for (size_t g = 0; g < k; g++) {
				NV sum = 0.0;
				for (size_t i = 0; i < sizes[g]; i++) sum += flat[offset + i];
				gmeans[g] = sum / (NV)sizes[g];
				offset += sizes[g];
			}
		}
		res = c_oneway_test(flat, sizes, k, var_equal);
		Safefree(flat); flat = NULL;
		// build the return hash
		ret_hv = (HV *)sv_2mortal((SV *)newHV());
		{
			HV *g_hv = newHV();
			hv_stores(g_hv, "Df",      newSVnv(res.num_df));
			hv_stores(g_hv, "Sum Sq",  newSVnv(res.ss_between));
			hv_stores(g_hv, "Mean Sq", newSVnv(res.ms_between));
			hv_stores(g_hv, "F value", newSVnv(res.statistic));
			hv_stores(g_hv, "Pr(>F)",  newSVnv(res.p_value));
			hv_store(ret_hv, factor_name, (I32)strlen(factor_name),
				newRV_noinc((SV *)g_hv), 0);
		}
		{
			HV *r_hv = newHV();
			hv_stores(r_hv, "Df",      newSVnv(res.denom_df));
			hv_stores(r_hv, "Sum Sq",  newSVnv(res.ss_within));
			hv_stores(r_hv, "Mean Sq", newSVnv(res.ms_within));
			hv_stores(ret_hv, "Residuals", newRV_noinc((SV *)r_hv));
		}
		{
			HV *gs_hv   = newHV(), *mean_hv = newHV(), *size_hv = newHV();
			for (size_t g = 0; g < k; g++) {
				const char *gn = gnames[g];
				I32 gnl = (I32)strlen(gn);
				hv_store(mean_hv, gn, gnl, newSVnv(gmeans[g]),    0);
				hv_store(size_hv, gn, gnl, newSViv((IV)sizes[g]), 0);
			}
			hv_stores(gs_hv, "mean", newRV_noinc((SV *)mean_hv));
			hv_stores(gs_hv, "size", newRV_noinc((SV *)size_hv));
			hv_stores(ret_hv, "group.stats", newRV_noinc((SV *)gs_hv));
		}
		// normal cleanup
		Safefree(gmeans);	Safefree(sizes);
		for (size_t g = 0; g < k; g++) Safefree(gnames[g]);
		Safefree(gnames);
		if (lhs) Safefree(lhs);
		if (rhs) Safefree(rhs);

		RETVAL = newRV_inc((SV *)ret_hv);
	}
	if (0) {
	fail:
		//single cleanup point for every error after an allocation
		if (flat)   Safefree(flat);
		if (sizes)  Safefree(sizes);
		if (gnames) {
			for (size_t g = 0; g < k; g++) if (gnames[g]) Safefree(gnames[g]);
			Safefree(gnames);
		}
		if (gmeans) Safefree(gmeans);
		if (lhs) Safefree(lhs);
		if (rhs) Safefree(rhs);
		croak("oneway_test: %s", errbuf);
	}
	OUTPUT:
		RETVAL

SV* ks_test(...)
CODE:
{
	SV *x_sv = NULL, *y_sv = NULL;
	short int exact = -1;
	const char *alternative = "two.sided";
	Stack_off_t arg_idx = 0;

	//Leading positional 'x' (array ref).
	if (arg_idx < items && SvROK(ST(arg_idx)) && SvTYPE(SvRV(ST(arg_idx))) == SVt_PVAV) {
	  x_sv = ST(arg_idx);
	  arg_idx++;
	}

	/*Optional positional 'y':
	- an ARRAY ref  -> 2-sample (keys are never array refs, so safe)
	- a STRING      -> 1-sample CDF name, BUT only if consuming it leaves
	                   an even number of trailing args. Otherwise the
	                   "string" is really a named-argument key (e.g.
	                   "exact", "alternative") and must not be eaten here.
	                   (Fix #1)*/
	if (arg_idx < items) {
		if (SvROK(ST(arg_idx)) && SvTYPE(SvRV(ST(arg_idx))) == SVt_PVAV) {
			y_sv = ST(arg_idx);
			arg_idx++;
		} else if (SvPOK(ST(arg_idx)) && (((items - arg_idx) % 2) == 1)) {
			y_sv = ST(arg_idx);   //positional 1-sample CDF, e.g. "pnorm"
			arg_idx++;
		}
	}

	//Named arguments (key => value pairs).
	for (; arg_idx < items; arg_idx += 2) {
	  const char *key = SvPV_nolen(ST(arg_idx));
	  SV *val;
	  if (arg_idx + 1 >= items)      //Fix #2: no value -> would read off stack
		   croak("ks_test: argument '%s' is missing a value", key);
	  val = ST(arg_idx + 1);
	  if      (strEQ(key, "x"))           x_sv = val;
	  else if (strEQ(key, "y"))           y_sv = val;
	  else if (strEQ(key, "exact")) {
		   if (!SvOK(val)) exact = -1;
		   else exact = SvTRUE(val) ? 1 : 0;
	  }
	  else if (strEQ(key, "alternative")) alternative = SvPV_nolen(val);
	  else croak("ks_test: unknown argument '%s'", key);
	}

	if (!x_sv || !SvROK(x_sv) || SvTYPE(SvRV(x_sv)) != SVt_PVAV) {
	  croak("ks_test: 'x' is a required argument and must be an ARRAY reference");
	}

	bool is_two_sided = strEQ(alternative, "two.sided") ? 1 : 0;
	bool is_greater   = strEQ(alternative, "greater")   ? 1 : 0;
	bool is_less      = strEQ(alternative, "less")      ? 1 : 0;

	if (!is_two_sided && !is_greater && !is_less) {
	  croak("ks_test: alternative must be 'two.sided', 'less', or 'greater'");
	}

	AV *x_av = (AV *)SvRV(x_sv);
	size_t nx = (size_t)(av_len(x_av) + 1);
	if (nx == 0) croak("Not enough 'x' observations");

	/*Extract 'x' to a C array (numeric elements only). NaN is dropped along
	with undef and non-numbers, which is what R's ks.test does (x[!is.na(x)]
	drops NaN as well as NA). Letting a NaN through is not merely inaccurate:
	the merge in calc_2sample_stats() advances only on `<=`, which is false
	for every comparison against NaN, so a single NaN wedges it in an
	infinite loop.*/
	NV *x_data = (NV *)safemalloc(nx * sizeof(NV));
	size_t valid_nx = 0;
	for (size_t i = 0; i < nx; i++) {
	  SV **el = av_fetch(x_av, i, 0);
	  if (el && *el && (SvNIOK(*el) || (SvOK(*el) && looks_like_number(*el)))) {
		   NV v = SvNV(*el);                 //SvNIOK shortcut avoids string parse
		   if (nv_isnan(v)) continue;
		   x_data[valid_nx++] = v;
	  }
	}
	//Fix #4: guard before any path can divide by valid_nx.
	if (valid_nx < 1) {
	  Safefree(x_data);
	  croak("Not enough non-missing 'x' observations");
	}

	NV statistic = 0.0, p_value = 0.0;
	const char *method_desc = "";

	// TWO SAMPLE
	if (y_sv && SvROK(y_sv) && SvTYPE(SvRV(y_sv)) == SVt_PVAV) {
	  AV *y_av = (AV *)SvRV(y_sv);
	  size_t ny = (size_t)(av_len(y_av) + 1);
	  NV *y_data = (NV *)safemalloc((ny ? ny : 1) * sizeof(NV));
	  size_t valid_ny = 0;
	  for (size_t i = 0; i < ny; i++) {
		   SV **el = av_fetch(y_av, i, 0);
		   if (el && *el && (SvNIOK(*el) || (SvOK(*el) && looks_like_number(*el)))) {
		       NV v = SvNV(*el);
		       if (nv_isnan(v)) continue;   //as for 'x': R drops NaN, and a
		       y_data[valid_ny++] = v;        //NaN would hang the merge below
		   }
	  }
	  if (valid_ny < 1) {
		   Safefree(x_data); Safefree(y_data);
		   croak("Not enough non-missing observations for KS test");
	  }

	  NV d, d_plus, d_minus;
	  calc_2sample_stats(x_data, valid_nx, y_data, valid_ny, &d, &d_plus, &d_minus);
	  if (is_greater)   statistic = d_plus;
	  else if (is_less) statistic = d_minus;
	  else              statistic = d;

	  /*Decide exact vs asymptotic. Use a double product so the threshold
	  comparison itself can't overflow size_t.*/
	  double mn = (double)valid_nx * (double)valid_ny;
	  bool use_exact;
	  if      (exact == 1) use_exact = TRUE;
	  else if (exact == 0) use_exact = FALSE;
	  else                 use_exact = (mn < 10000.0);

	  //Fix #6: cap the cost of a *forced* exact run.
	  if (use_exact && mn > KS_EXACT_MAX_PRODUCT) {
		   warn("ks_test: sample sizes too large for an exact p-value; using asymptotic");
		   use_exact = FALSE;
	  }

	  /*Tie detection is only needed for the exact path. Both arrays are
	  already sorted by calc_2sample_stats(), so detect ties with an O(N)
	  merge instead of concatenate + re-sort. (Speed/RAM improvement.)*/
	  if (use_exact) {
		   bool has_ties = FALSE;
		   size_t a = 0, b = 0;
		   NV prev = 0; bool have_prev = FALSE;
		   while (a < valid_nx || b < valid_ny) {
		       NV v = (b >= valid_ny || (a < valid_nx && x_data[a] <= y_data[b]))
		              ? x_data[a++] : y_data[b++];
		       if (have_prev && v == prev) { has_ties = TRUE; break; }
		       prev = v; have_prev = TRUE;
		   }
		   if (has_ties) {
		       warn("ks_test: cannot compute exact p-value with ties; falling back to asymptotic");
		       use_exact = FALSE;
		   }
	  }

	  if (use_exact) {
		   method_desc = "Two-sample Kolmogorov-Smirnov exact test";
		   NV q = (0.5 + nv_floor(statistic * valid_nx * valid_ny - 1e-7))
		          / ((NV)valid_nx * (NV)valid_ny);
		   /*One-sided 'less' uses the D+ routine directly; correct when
		   valid_nx == valid_ny and a documented approximation otherwise.*/
		   p_value = psmirnov_exact_uniq_upper(q, valid_nx, valid_ny, is_two_sided);
	  } else {
		   method_desc = "Two-sample Kolmogorov-Smirnov test (asymptotic)";
		   //Overflow-safe scaling: cast each operand to NV before multiplying.
		   NV z = statistic * nv_sqrt(((NV)valid_nx * (NV)valid_ny)
		                           / ((NV)valid_nx + (NV)valid_ny));
		   if (is_two_sided) p_value = K2l(z, 0, 1e-9);
		   else              p_value = nv_exp(-2.0 * z * z);
	  }
	  Safefree(y_data);
	} else if (y_sv && SvPOK(y_sv)) {// 1 SAMPLE
	  const char *dist = SvPV_nolen(y_sv);
	  if (strEQ(dist, "pnorm")) {
		   qsort(x_data, valid_nx, sizeof(NV), cmp_nv3);
		   NV max_d = 0.0, max_d_plus = 0.0, max_d_minus = 0.0;
		   for (size_t i = 0; i < valid_nx; i++) {
		       NV cdf_obs_low  = (NV)i / valid_nx;
		       NV cdf_obs_high = (NV)(i + 1) / valid_nx;
		       NV cdf_theor    = approx_pnorm(x_data[i]);
		       NV diff1 = cdf_obs_low  - cdf_theor;
		       NV diff2 = cdf_obs_high - cdf_theor;
		       if (diff1 > max_d_plus)  max_d_plus  = diff1;
		       if (diff2 > max_d_plus)  max_d_plus  = diff2;
		       if (-diff1 > max_d_minus) max_d_minus = -diff1;
		       if (-diff2 > max_d_minus) max_d_minus = -diff2;
		       if (nv_fabs(diff1) > max_d) max_d = nv_fabs(diff1);
		       if (nv_fabs(diff2) > max_d) max_d = nv_fabs(diff2);
		   }
		   if (is_greater)   statistic = max_d_plus;
		   else if (is_less) statistic = max_d_minus;
		   else              statistic = max_d;

		   bool use_exact = (exact == -1) ? (valid_nx < 100) : (exact == 1);
   /*Only the two-sided exact distribution is implemented, so a
   one-sided request drops to the asymptotic formula. Clear use_exact
   here rather than inside the branch below, so that method_desc
   reports the p-value the caller actually got: the label is the only
   machine-readable record of which path ran, and saying "exact" over
   an asymptotic p-value would make it useless.*/
		   if (use_exact && !is_two_sided) {
		       warn("ks_test: exact 1-sample 1-sided KS test not implemented; using asymptotic");
		       use_exact = 0;
		   }
		   if (use_exact) {
		       method_desc = "One-sample Kolmogorov-Smirnov exact test";
		       p_value = 1.0 - K2x(valid_nx, statistic);
		   } else {
		       method_desc = "One-sample Kolmogorov-Smirnov test (asymptotic)";
		       NV z = statistic * nv_sqrt((NV)valid_nx);
		       if (is_two_sided) p_value = K2l(z, 0, 1e-6);
		       else              p_value = nv_exp(-2.0 * z * z);
		   }
	  } else {
		   Safefree(x_data);
		   croak("ks_test: Unsupported 1-sample distribution '%s'. Use arrays for 2-sample.", dist);
	  }
	} else {
	  Safefree(x_data);
	  croak("ks_test: Invalid arguments for 'y'.");
	}

	Safefree(x_data);
	if (p_value > 1.0) p_value = 1.0;
	if (p_value < 0.0) p_value = 0.0;

	HV *res = newHV();
	hv_stores(res, "statistic",   newSVnv(statistic));
	hv_stores(res, "p.value",     newSVnv(p_value));
	hv_stores(res, "method",      newSVpv(method_desc, 0));
	hv_stores(res, "alternative", newSVpv(alternative, 0));
	RETVAL = newRV_noinc((SV *)res);
}
OUTPUT:
	RETVAL

SV* wilcox_test(...)
CODE:
{
/* Follows R's wilcox.test() as of R 4.6.1, including the exact conditional
  inference in the presence of ties or zeroes that R 4.6.0 added (NEWS: "can
  now perform exact (conditional) inference in case of ties", contributed by
  Torsten Hothorn).  Two deliberate divergences:

 * R's `correct` became an integer 0:3, in which numeric 0 still applies
   the continuity correction and only FALSE turns it off.  Here `correct`
   stays a plain boolean -- 0 is off, as it is for every other flag in this
   module and as R itself documented before 4.6.0 -- and the Edgeworth
   series R reaches through correct = 1, 2, 3 is spelled
   `edgeworth => 1, 2, 3` instead.
 * With exact => 0 and every observation tied the variance is zero; R
   divides by it and reports NaN, while this warns and reports p = 1.*/
	SV *x_sv = NULL, *y_sv = NULL;
	bool paired = FALSE, correct = TRUE, want_cint = FALSE;
	short int exact = -1;               /* -1 = decide from the sample sizes */
	unsigned short int edgeworth = 0;   /* Edgeworth terms wanted: 0 .. 3 */
	NV mu = 0.0, conf_level = NV_CONF_95, digits_rank = NV_INF, tol_root = 1e-4;
	const char *alt_str = "two.sided";
	Stack_off_t arg_idx = 0;
	/* 1. Shift the first positional argument as 'x' if it is an array reference */
	if (arg_idx < items && SvROK(ST(arg_idx)) && SvTYPE(SvRV(ST(arg_idx))) == SVt_PVAV) {
		x_sv = ST(arg_idx);
		arg_idx++;
	}
	/* 2. Shift the second positional argument as 'y' if it is an array reference */
	if (arg_idx < items && SvROK(ST(arg_idx)) && SvTYPE(SvRV(ST(arg_idx))) == SVt_PVAV) {
		y_sv = ST(arg_idx);
		arg_idx++;
	}
	if ((items - arg_idx) % 2 != 0)
		croak("Usage: wilcox_test(\\@x, [\\@y], key => value, ...)");
	for (; arg_idx < items; arg_idx += 2) {
		const char *key = SvPV_nolen(ST(arg_idx));
		SV *val = ST(arg_idx + 1);
		if      (strEQ(key, "x"))           x_sv = val;
		else if (strEQ(key, "y"))           y_sv = val;
		else if (strEQ(key, "paired"))      paired = SvTRUE(val) ? TRUE : FALSE;
		else if (strEQ(key, "correct"))     correct = SvTRUE(val) ? TRUE : FALSE;
		else if (strEQ(key, "mu"))          mu = SvNV(val);
		else if (strEQ(key, "exact")) {
			if (!SvOK(val)) exact = -1;
			else exact = SvTRUE(val) ? 1 : 0;
		}
		else if (strEQ(key, "alternative")) alt_str = SvPV_nolen(val);
		else if (strEQ(key, "conf.int") || strEQ(key, "conf_int"))
			want_cint = SvTRUE(val) ? TRUE : FALSE;
		else if (strEQ(key, "conf.level") || strEQ(key, "conf_level"))
			conf_level = SvNV(val);
		else if (strEQ(key, "digits.rank") || strEQ(key, "digits_rank"))
			digits_rank = SvOK(val) ? SvNV(val) : NV_INF;
		else if (strEQ(key, "tol.root") || strEQ(key, "tol_root"))
			tol_root = SvNV(val);
		else if (strEQ(key, "edgeworth")) {
			IV e = SvIV(val);
			if (e < 0 || e > 3) croak("wilcox_test: 'edgeworth' must be 0, 1, 2 or 3");
			edgeworth = (unsigned short int)e;
		}
		else croak("wilcox_test: unknown argument '%s'", key);
	}
	/* alt: 0 = two.sided, 1 = less, 2 = greater. Kept as a code so the tail
	  selection below is a comparison rather than a string compare per branch. */
	short int alt;
	if      (strEQ(alt_str, "two.sided")) alt = 0;
	else if (strEQ(alt_str, "less"))      alt = 1;
	else if (strEQ(alt_str, "greater"))   alt = 2;
	else croak("wilcox_test: 'alternative' must be one of 'two.sided', 'less', 'greater'");

	if (!x_sv || !SvROK(x_sv) || SvTYPE(SvRV(x_sv)) != SVt_PVAV)
		croak("wilcox_test: 'x' is a required argument and must be an ARRAY reference");
	if (y_sv && (!SvROK(y_sv) || SvTYPE(SvRV(y_sv)) != SVt_PVAV)) {
	// An explicit undef is R's NULL: no second sample at all
		if (SvOK(y_sv)) croak("wilcox_test: 'y' must be an ARRAY reference");
		y_sv = NULL;
	}
	/* R: stop("'mu' must be a single number") -- an infinite or NaN mu turns
	  every difference into NaN or +/-Inf and quietly poisons the ranking. */
	if (!nv_isfinite(mu)) croak("wilcox_test: 'mu' must be a finite number");
	if (want_cint && !(nv_isfinite(conf_level) && conf_level > 0.0 && conf_level < 1.0))
		croak("wilcox_test: 'conf.level' must be a single number between 0 and 1");
	if (!(tol_root > 0.0)) croak("wilcox_test: 'tol.root' must be positive");

	AV *x_av = (AV *)SvRV(x_sv);
	AV *y_av = y_sv ? (AV *)SvRV(y_sv) : NULL;
	size_t nx_raw = (size_t)(av_top_index(x_av) + 1);
	size_t ny_raw = y_av ? (size_t)(av_top_index(y_av) + 1) : 0;

	const bool round_ranks = nv_isfinite(digits_rank);
/* R drops NA before anything else and NaN is NA to R, so both go; +/-Inf is
  neither, and a rank test has no trouble with it.  Letting NaN through is
  what used to make wilcox.test's own regression case -- a paired test whose
  Inf - Inf differences R discards -- come back with a different p-value, and
  it also fed cmp_nv3 a comparison that is never true, leaving qsort without
  the strict weak ordering it is entitled to.*/
	NV *restrict xv = NULL, *restrict yv = NULL;
	size_t n_x = 0, n_y = 0;
	Newx(xv, nx_raw ? nx_raw : 1, NV);
	SAVEFREEPV(xv);
	if (paired) {
		if (!y_av) croak("wilcox_test: 'y' is missing for paired test");
		if (nx_raw != ny_raw)
			croak("'x' and 'y' must have the same length for paired test");
		for (size_t i = 0; i < nx_raw; i++) {
			SV **xe = av_fetch(x_av, i, 0);
			SV **ye = av_fetch(y_av, i, 0);
			if (!xe || !SvOK(*xe) || !looks_like_number(*xe)) continue;
			if (!ye || !SvOK(*ye) || !looks_like_number(*ye)) continue;
			NV a = SvNV(*xe), b = SvNV(*ye);
			if (nv_isnan(a) || nv_isnan(b)) continue;
			NV d = a - b;
			if (nv_isnan(d)) continue;         /* Inf - Inf */
			xv[n_x++] = d;
		}
		y_av = NULL;                             /* now a one-sample problem */
	} else {
		for (size_t i = 0; i < nx_raw; i++) {
			SV **xe = av_fetch(x_av, i, 0);
			if (!xe || !SvOK(*xe) || !looks_like_number(*xe)) continue;
			NV a = SvNV(*xe);
			if (nv_isnan(a)) continue;
			xv[n_x++] = a;
		}
		if (y_av) {
			Newx(yv, ny_raw ? ny_raw : 1, NV);
			SAVEFREEPV(yv);
			for (size_t i = 0; i < ny_raw; i++) {
				SV **ye = av_fetch(y_av, i, 0);
				if (!ye || !SvOK(*ye) || !looks_like_number(*ye)) continue;
				NV b = SvNV(*ye);
				if (nv_isnan(b)) continue;
				yv[n_y++] = b;
			}
		}
	}
	if (n_x < 1) croak("not enough (non-missing) 'x' observations");
/* An empty second sample used to fall through to the one-sample branch and
  silently answer a different question; R stops instead.*/
	if (yv && n_y < 1) croak("not enough 'y' observations");

	NV statistic = 0.0, p_value = 0.0;
	const char *method_desc = "";
	const char *stat_name = yv ? "W" : "V";
	NV estimate = NV_NAN, ci_lo = NV_NAN, ci_hi = NV_NAN, achieved_level = conf_level;
	bool have_cint = FALSE;
	const NV alpha0 = 1.0 - conf_level;
	const NV toler = 10.0 * NV_EPSILON;
	WilcoxDist D;
	D.d = NULL; D.total = 0.0; D.len = 0; D.base = 0; D.scale = 1; D.symmetric = FALSE;

	if (yv) {
/* TWO SAMPLE (Wilcoxon rank sum / Mann-Whitney) */
		size_t total_n = n_x + n_y;
		RankInfo *ri;
		Newx(ri, total_n, RankInfo);
		SAVEFREEPV(ri);
		for (size_t i = 0; i < n_x; i++) {
			NV v = xv[i] - mu;                   /* R subtracts mu from x */
			ri[i].val = round_ranks ? nv_signif(v, digits_rank) : v;
			ri[i].idx = 1;
		}
		for (size_t i = 0; i < n_y; i++) {
			NV v = yv[i];
			ri[n_x + i].val = round_ranks ? nv_signif(v, digits_rank) : v;
			ri[n_x + i].idx = 2;
		}
		bool has_ties = FALSE;
		NV tie_adj = rank_and_count_ties(ri, total_n, &has_ties);
		NV rank_sum = 0.0;
		for (size_t i = 0; i < total_n; i++)
			if (ri[i].idx == 1) rank_sum += ri[i].rank;
		statistic = rank_sum - (NV)n_x * (n_x + 1.0) / 2.0;

		bool use_exact = (exact < 0) ? (n_x < 50 && n_y < 50) : (exact == 1);
		if (use_exact) {
			method_desc = "Wilcoxon rank sum exact test";
			if (has_ties) {
/* Condition on the observed ranks -- R's dpermdist2 path.  rank_and_count_ties
  has already left ri sorted ascending, which is the order the shift algorithm
  wants, and a tie group of odd size is what makes a rank half-integral and
  the scale 2.*/
				unsigned short int scale = 1;
				for (size_t i = 0; i < total_n; i++)
					if (ri[i].rank != nv_floor(ri[i].rank)) { scale = 2; break; }
				UV *restrict z;
				Newx(z, total_n, UV);
				SAVEFREEPV(z);
				for (size_t i = 0; i < total_n; i++)
					z[i] = (UV)nv_round((NV)scale * ri[i].rank);
				wdist_ranksum_perm(aTHX_ &D, z, total_n, n_x, scale);
			} else {
				wdist_ranksum(aTHX_ &D, n_x, n_y);
			}
			SAVEFREEPV(D.d);
			NV p_lo = wdist_tail(&D, statistic, TRUE);
			NV p_hi = wdist_tail(&D, statistic - 0.25, FALSE);
			p_value = (alt == 1) ? p_lo : (alt == 2) ? p_hi
			        : ((p_lo < p_hi ? p_lo : p_hi) * 2.0);
		} else {
			method_desc = correct ? "Wilcoxon rank sum test with continuity correction"
			                      : "Wilcoxon rank sum test";
			NV mean_w = (NV)n_x * (NV)n_y / 2.0;
			NV var = ((NV)n_x * (NV)n_y / 12.0)
			       * ((NV)total_n + 1.0 - tie_adj / ((NV)total_n * ((NV)total_n - 1.0)));
			NV z = statistic - mean_w;
	// The Edgeworth series is derived for untied ranks
			unsigned short int k = has_ties ? 0 : edgeworth;
			NV corr = 0.0;
			if (correct)
				corr = (alt == 1) ? -0.5 : (alt == 2) ? 0.5
				     : (z > 0.0) ? 0.5 : (z < 0.0) ? -0.5 : 0.0;
			if (!(var > 0.0)) {
				warn("wilcox_test: zero variance (all values tied); p-value is undefined");
				p_value = 1.0;
			} else {
				z = (z - corr) / nv_sqrt(var);
				if      (alt == 1) p_value = wilcox_edge_two(z, (NV)n_x, (NV)n_y, k, TRUE);
				else if (alt == 2) p_value = wilcox_edge_two(z, (NV)n_x, (NV)n_y, k, FALSE);
				else if (k == 0)   p_value = 2.0 * approx_pnorm(-nv_fabs(z));
				else {
					/* R: 2 * min(p, 1 - p) with p the lower-tail value. */
					NV p_lo = wilcox_edge_two(z, (NV)n_x, (NV)n_y, k, TRUE);
					NV p_hi = 1.0 - p_lo;
					p_value = 2.0 * (p_lo < p_hi ? p_lo : p_hi);
				}
			}
		}

		if (want_cint) {
			have_cint = TRUE;
/* The m * n pairwise differences carry both exact intervals and the
  Hodges-Lehmann estimate, but the asymptotic interval is a root search that
  never looks at them -- so they are built only when they are wanted, and a
  sample pair too large to hold them can still have an asymptotic interval. */
			size_t nd = 0;
			NV *restrict diffs = NULL;
			if (use_exact) {
				nd = wilcox_cells(aTHX_ n_x, n_y);
				Newx(diffs, nd, NV);
				SAVEFREEPV(diffs);
				for (size_t i = 0; i < n_x; i++)
					for (size_t j = 0; j < n_y; j++)
						diffs[i * n_y + j] = xv[i] - yv[j];
				nv_heapsort(diffs, nd);
			}
			if (use_exact && !has_ties) {// R's .wilcox_test_two_cint_exact, the qwilcox branch: the interval is a pair of order statistics of the m*n pairwise differences
				estimate = nv_sorted_median(diffs, nd);
				NV a = (alt == 0) ? alpha0 / 2.0 : alpha0;
				NV qu = wdist_quantile(&D, a);
				if (wdist_tail(&D, qu, TRUE) <= a + toler) qu += 1.0;
				if (qu <= 0.0) {
					achieved_level = 1.0;
					ci_lo = -NV_INF; ci_hi = NV_INF;
				} else {
					if (qu > (NV)nd) qu = (NV)nd;
					size_t iu = (size_t)qu;
					size_t il = nd - iu;
					NV ach = wdist_tail(&D, nv_trunc(qu) - 1.0, TRUE);
					achieved_level = 1.0 - (alt == 0 ? 2.0 * ach : ach);
					ci_lo = (alt == 1) ? -NV_INF : diffs[iu - 1];
					ci_hi = (alt == 2) ?  NV_INF : diffs[il];
				}
			} else if (use_exact) {
/* Ties: R walks the sorted differences and asks, at the midpoint between each
  consecutive pair, whether the conditional tail probability has grown past
  alpha yet.  Every step rebuilds the permutation distribution, so the tables
  are freed as we go rather than left on the save stack.*/
				estimate = nv_sorted_median(diffs, nd);
				RankInfo *cri;
				Newx(cri, total_n, RankInfo);
				SAVEFREEPV(cri);
				UV *restrict cz;
				Newx(cz, total_n, UV);
				SAVEFREEPV(cz);
				WilcoxDist S;
				S.d = NULL; S.total = 0.0; S.len = 0; S.base = 0; S.scale = 1; S.symmetric = FALSE;
				NV a_side = (alt == 0) ? alpha0 / 2.0 : alpha0;
				NV a = a_side + toler;
				NV lo_pi = 0.0, hi_pi = 0.0;
				NV lo_mu = -NV_INF, hi_mu = NV_INF;
				if (alt != 1) {                  /* need a lower limit */
					if (!(wilcox_two_ptail(aTHX_ &S, cri, cz, xv, n_x, yv, n_y,
					                       diffs[0] - 1.0, FALSE) > a)) {
						for (size_t k = 0; k + 1 < nd; k++) {
							NV p = wilcox_two_ptail(aTHX_ &S, cri, cz, xv, n_x, yv, n_y,
							                        (diffs[k] + diffs[k + 1]) / 2.0, FALSE);
							if (p > a) { lo_mu = diffs[k]; break; }
							lo_pi = p;
						}
						if (!nv_isfinite(lo_mu)) lo_mu = diffs[nd - 1];
					}
				}
				if (alt != 2) {                  /* need an upper limit */
					if (!(wilcox_two_ptail(aTHX_ &S, cri, cz, xv, n_x, yv, n_y,
					                       diffs[nd - 1] + 1.0, TRUE) > a)) {
						for (size_t k = nd - 1; k-- > 0; ) {
							NV p = wilcox_two_ptail(aTHX_ &S, cri, cz, xv, n_x, yv, n_y,
							                        (diffs[k] + diffs[k + 1]) / 2.0, TRUE);
							if (p > a) { hi_mu = diffs[k + 1]; break; }
							hi_pi = p;
						}
						if (!nv_isfinite(hi_mu)) hi_mu = diffs[0];
					}
				}
				ci_lo = (alt == 1) ? -NV_INF : lo_mu;
				ci_hi = (alt == 2) ?  NV_INF : hi_mu;
				achieved_level = 1.0 - ((alt == 0) ? lo_pi + hi_pi
				                      : (alt == 1) ? hi_pi : lo_pi);
			} else {
/* R's .wilcox_test_two_cint_asymp: root the standardised statistic, as a
  function of the trial shift, against the normal quantiles.*/
				RankInfo *cri;
				Newx(cri, total_n, RankInfo);
				SAVEFREEPV(cri);
				WilcoxCiCtx C;
				C.x = xv; C.y = yv; C.scratch = cri;
				C.n_x = n_x; C.n_y = n_y;
				C.digits_rank = digits_rank; C.zq = 0.0;
				C.alt = alt; C.correct = correct; C.tied = FALSE;
				NV xmin = xv[0], xmax = xv[0], ymin = yv[0], ymax = yv[0];
				for (size_t i = 1; i < n_x; i++) {
					if (xv[i] < xmin) xmin = xv[i];
					if (xv[i] > xmax) xmax = xv[i];
				}
				for (size_t i = 1; i < n_y; i++) {
					if (yv[i] < ymin) ymin = yv[i];
					if (yv[i] > ymax) ymax = yv[i];
				}
				NV mumin = xmin - ymax, mumax = xmax - ymin;
				NV w_lo = wilcox_ci_W(mumin, &C), w_hi = wilcox_ci_W(mumax, &C);
				if (C.tied) {
					warn("wilcox_test: cannot compute confidence interval when all observations are tied");
					ci_lo = (alt == 1) ? -NV_INF : NV_NAN;
					ci_hi = (alt == 2) ?  NV_INF : NV_NAN;
					achieved_level = 0.0;
					estimate = (mumin + mumax) / 2.0;
				} else {
					if (alt != 1)
						ci_lo = wilcox_ci_root(&C, mumin, mumax, w_lo, w_hi,
						                       std_qnorm(1.0 - (alt == 0 ? alpha0 / 2.0 : alpha0)),
						                       tol_root);
					else ci_lo = -NV_INF;
					if (alt != 2)
						ci_hi = wilcox_ci_root(&C, mumin, mumax, w_lo, w_hi,
						                       std_qnorm(alt == 0 ? alpha0 / 2.0 : alpha0),
						                       tol_root);
					else ci_hi = NV_INF;
					/* R drops the continuity correction for the point estimate. */
					C.correct = FALSE;
					NV e_lo = wilcox_ci_W(mumin, &C), e_hi = wilcox_ci_W(mumax, &C);
					estimate = wilcox_ci_root(&C, mumin, mumax, e_lo, e_hi, 0.0, tol_root);
				}
			}
		}
	} else {// ONE SAMPLE / PAIRED (signed rank)
		size_t n_obs = n_x; /* R's n: zeroes included */
		bool use_exact = (exact < 0) ? (n_obs < 50) : (exact == 1);
		RankInfo *ri;
		Newx(ri, n_obs, RankInfo);
		SAVEFREEPV(ri);
		bool has_zero = 0, has_ties = 0;
		NV tie_adj = 0.0;
		size_t n_eff = 0;                /* non-zero differences */
		for (size_t i = 0; i < n_obs; i++) if (xv[i] - mu == 0.0) has_zero = 1;

		if (use_exact) {
/* The exact branch ranks |x - mu| over every observation and only afterwards
  drops the zeroes' ranks, because the permutation distribution is the one
  conditional on the ranks actually observed.  The asymptotic branch below
  drops the zeroes first and ranks what is left, so V genuinely differs
  between the two whenever a zero is present -- that is R's behaviour too.*/
			for (size_t i = 0; i < n_obs; i++) {
				NV d = xv[i] - mu;
				NV a = round_ranks ? nv_signif(d, digits_rank) : d;
				ri[i].val = nv_fabs(a);
				ri[i].idx = (d > 0.0) ? 1 : (d < 0.0) ? 2 : 0;   /* 0 = exact zero */
			}
			(void)rank_and_count_ties(ri, n_obs, &has_ties);
			statistic = 0.0;
			for (size_t i = 0; i < n_obs; i++) {
				if (ri[i].idx == 1) statistic += ri[i].rank;
				if (ri[i].idx != 0) n_eff++;
			}
			method_desc = "Wilcoxon signed rank exact test";
			if (has_ties || has_zero) {
				unsigned short int scale = 1;
				for (size_t i = 0; i < n_obs; i++)
					if (ri[i].rank != nv_floor(ri[i].rank)) { scale = 2; break; }
				UV *restrict z;
				Newx(z, n_eff ? n_eff : 1, UV);
				SAVEFREEPV(z);
				size_t nz = 0;
				for (size_t i = 0; i < n_obs; i++)
					if (ri[i].idx != 0) z[nz++] = (UV)nv_round((NV)scale * ri[i].rank);
				wdist_signrank_perm(aTHX_ &D, z, nz, scale);
			} else {
				wdist_signrank(aTHX_ &D, n_obs);
			}
			SAVEFREEPV(D.d);
			NV p_lo = wdist_tail(&D, statistic, TRUE);
			NV p_hi = wdist_tail(&D, statistic - 0.25, FALSE);
			p_value = (alt == 1) ? p_lo : (alt == 2) ? p_hi
			        : ((p_lo < p_hi ? p_lo : p_hi) * 2.0);
		} else {
			for (size_t i = 0; i < n_obs; i++) {
				NV d = xv[i] - mu;
				if (d == 0.0) continue;          /* Wilcoxon's own rule: drop them */
				NV a = round_ranks ? nv_signif(d, digits_rank) : d;
				ri[n_eff].val = nv_fabs(a);
				ri[n_eff].idx = (d > 0.0);
				n_eff++;
			}
			tie_adj = rank_and_count_ties(ri, n_eff, &has_ties);
			statistic = 0.0;
			for (size_t i = 0; i < n_eff; i++) if (ri[i].idx) statistic += ri[i].rank;
			method_desc = correct ? "Wilcoxon signed rank test with continuity correction"
			                      : "Wilcoxon signed rank test";
			NV mean_v = (NV)n_eff * (n_eff + 1.0) / 4.0;
			NV var = (NV)n_eff * (n_eff + 1.0) * (2.0 * (NV)n_eff + 1.0) / 24.0
			       - tie_adj / 48.0;
			NV z = statistic - mean_v;
			/* R also switches the Edgeworth series off when zeroes were dropped. */
			unsigned short int k = (has_ties || has_zero) ? 0 : edgeworth;
			NV corr = 0.0;
			if (correct)
				corr = (alt == 1) ? -0.5 : (alt == 2) ? 0.5
				     : (z > 0.0) ? 0.5 : (z < 0.0) ? -0.5 : 0.0;
			if (!(var > 0.0)) {
				warn("wilcox_test: zero variance (all values tied); p-value is undefined");
				p_value = 1.0;
			} else {
				z = (z - corr) / nv_sqrt(var);
				if      (alt == 1) p_value = wilcox_edge_one(z, (NV)n_eff, k, TRUE);
				else if (alt == 2) p_value = wilcox_edge_one(z, (NV)n_eff, k, FALSE);
				else if (k == 0)   p_value = 2.0 * approx_pnorm(-nv_fabs(z));
				else {
					NV p_lo = wilcox_edge_one(z, (NV)n_eff, k, TRUE);
					NV p_hi = 1.0 - p_lo;
					p_value = 2.0 * (p_lo < p_hi ? p_lo : p_hi);
				}
			}
		}

		if (want_cint) {
			have_cint = TRUE;
			if (use_exact) {
/* The Walsh averages (x_i + x_j)/2 over i <= j; their order statistics carry
  the exact interval and their median is the Hodges-Lehmann pseudomedian.*/
				size_t nd = wilcox_triangle(aTHX_ n_obs);
				NV *restrict walsh;
				Newx(walsh, nd, NV);
				SAVEFREEPV(walsh);
				size_t w = 0;
				for (size_t i = 0; i < n_obs; i++)
					for (size_t j = i; j < n_obs; j++)
						walsh[w++] = (xv[i] + xv[j]) / 2.0;
				nv_heapsort(walsh, nd);
				estimate = nv_sorted_median(walsh, nd);
				if (!has_ties && !has_zero) {
					NV a = (alt == 0) ? alpha0 / 2.0 : alpha0;
					NV qu = wdist_quantile(&D, a);
					if (wdist_tail(&D, qu, TRUE) <= a + toler) qu += 1.0;
					if (qu <= 0.0) {
						achieved_level = 1.0;
						ci_lo = -NV_INF; ci_hi = NV_INF;
					} else {
						if (qu > (NV)nd) qu = (NV)nd;
						size_t iu = (size_t)qu;
						size_t il = nd - iu;
						NV ach = wdist_tail(&D, nv_trunc(qu) - 1.0, TRUE);
						achieved_level = 1.0 - (alt == 0 ? 2.0 * ach : ach);
						ci_lo = (alt == 1) ? -NV_INF : walsh[iu - 1];
						ci_hi = (alt == 2) ?  NV_INF : walsh[il];
					}
				} else {
					RankInfo *cri;
					Newx(cri, n_obs, RankInfo);
					SAVEFREEPV(cri);
					UV *restrict cz;
					Newx(cz, n_obs, UV);
					SAVEFREEPV(cz);
					WilcoxDist S;
					S.d = NULL; S.total = 0.0; S.len = 0; S.base = 0; S.scale = 1; S.symmetric = FALSE;
					NV a_side = (alt == 0) ? alpha0 / 2.0 : alpha0;
					NV a = a_side + toler;
					NV lo_pi = 0.0, hi_pi = 0.0;
					NV lo_mu = -NV_INF, hi_mu = NV_INF;
					if (alt != 1) {
						if (!(wilcox_one_ptail(aTHX_ &S, cri, cz, xv, n_obs,
						                       walsh[0] - 1.0, FALSE) > a)) {
							for (size_t k = 0; k + 1 < nd; k++) {
								NV p = wilcox_one_ptail(aTHX_ &S, cri, cz, xv, n_obs,
								                        (walsh[k] + walsh[k + 1]) / 2.0, FALSE);
								if (p > a) { lo_mu = walsh[k]; break; }
								lo_pi = p;
							}
							if (!nv_isfinite(lo_mu)) lo_mu = walsh[nd - 1];
						}
					}
					if (alt != 2) {
						if (!(wilcox_one_ptail(aTHX_ &S, cri, cz, xv, n_obs,
						                       walsh[nd - 1] + 1.0, TRUE) > a)) {
							for (size_t k = nd - 1; k-- > 0; ) {
								NV p = wilcox_one_ptail(aTHX_ &S, cri, cz, xv, n_obs,
								                        (walsh[k] + walsh[k + 1]) / 2.0, TRUE);
								if (p > a) { hi_mu = walsh[k + 1]; break; }
								hi_pi = p;
							}
							if (!nv_isfinite(hi_mu)) hi_mu = walsh[0];
						}
					}
					ci_lo = (alt == 1) ? -NV_INF : lo_mu;
					ci_hi = (alt == 2) ?  NV_INF : hi_mu;
					achieved_level = 1.0 - ((alt == 0) ? lo_pi + hi_pi
					                      : (alt == 1) ? hi_pi : lo_pi);
				}
			} else {
/* R's .wilcox_test_one_cint_asymp, including its alpha-doubling search for a
  level the data can actually support and the warning when the requested one
  is not among them.*/
				RankInfo *cri;
				Newx(cri, n_obs, RankInfo);
				SAVEFREEPV(cri);
				WilcoxCiCtx C;
				C.x = xv; C.y = NULL; C.scratch = cri;
				C.n_x = n_obs; C.n_y = 0;
				C.digits_rank = digits_rank; C.zq = 0.0;
				C.alt = alt; C.correct = correct; C.tied = FALSE;
				NV mumin = xv[0], mumax = xv[0];
				for (size_t i = 1; i < n_obs; i++) {
					if (xv[i] < mumin) mumin = xv[i];
					if (xv[i] > mumax) mumax = xv[i];
				}
				NV w_lo = wilcox_ci_W(mumin, &C);
				NV w_hi = C.tied ? NV_NAN : wilcox_ci_W(mumax, &C);
				if (C.tied || !nv_isfinite(w_lo) || !nv_isfinite(w_hi)) {
					warn("wilcox_test: cannot compute confidence interval when all observations are zero or tied");
					ci_lo = (alt == 1) ? -NV_INF : NV_NAN;
					ci_hi = (alt == 2) ?  NV_INF : NV_NAN;
					achieved_level = 0.0;
					estimate = (mumin + mumax) / 2.0;
				} else {
/* R doubles alpha until the bracket [W(min x), W(max x)] actually contains the
  quantiles the limits root against.  The quantile it tests against differs by
  alternative, and not symmetrically: "greater" tests at alpha while "less"
  tests at alpha/2 even though it roots at alpha.  Mirrored as-is. */
					NV alpha = alpha0;
					for (;;) {
						bool widen = FALSE;
						if (alt == 0) {
							if (w_lo - std_qnorm(1.0 - alpha / 2.0) < 0.0) widen = TRUE;
							if (w_hi - std_qnorm(alpha / 2.0) > 0.0)       widen = TRUE;
						} else if (alt == 2) {
							if (w_lo - std_qnorm(1.0 - alpha) < 0.0)       widen = TRUE;
						} else {
							if (w_hi - std_qnorm(alpha / 2.0) > 0.0)       widen = TRUE;
						}
						if (!widen) break;
						alpha *= 2.0;
						if (alpha >= 1.0) break;
					}
					if (alpha >= 1.0 || alpha0 < alpha * 0.75) {
						achieved_level = 1.0 - (alpha < 1.0 ? alpha : 1.0);
						warn("wilcox_test: requested conf.level not achievable");
					}
					if (alpha < 1.0) {
						NV a = (alt == 0) ? alpha / 2.0 : alpha;
						ci_lo = (alt == 1) ? -NV_INF
						      : wilcox_ci_root(&C, mumin, mumax, w_lo, w_hi,
						                       std_qnorm(1.0 - a), tol_root);
						ci_hi = (alt == 2) ?  NV_INF
						      : wilcox_ci_root(&C, mumin, mumax, w_lo, w_hi,
						                       std_qnorm((alt == 0) ? alpha / 2.0 : alpha),
						                       tol_root);
					} else {
						NV *med;
						Newx(med, n_obs, NV);
						SAVEFREEPV(med);
						Copy(xv, med, n_obs, NV);
						nv_heapsort(med, n_obs);
						NV m = nv_sorted_median(med, n_obs);
						ci_lo = (alt == 1) ? -NV_INF : m;
						ci_hi = (alt == 2) ?  NV_INF : m;
					}
					C.correct = FALSE;
					NV e_lo = wilcox_ci_W(mumin, &C), e_hi = wilcox_ci_W(mumax, &C);
					estimate = wilcox_ci_root(&C, mumin, mumax, e_lo, e_hi, 0.0, tol_root);
				}
			}
		}
	}
	if (p_value > 1.0) p_value = 1.0;
	HV *res = newHV();
	hv_stores(res, "statistic",      newSVnv(statistic));
	hv_stores(res, "statistic.name", newSVpv(stat_name, 0));
	hv_stores(res, "p.value",        newSVnv(p_value));
	hv_stores(res, "method",         newSVpv(method_desc, 0));
	hv_stores(res, "alternative",    newSVpv(alt_str, 0));
	hv_stores(res, "null.value",     newSVnv(mu));
	hv_stores(res, "null.value.name",
	          newSVpv((paired || yv) ? "location shift" : "location", 0));
	if (have_cint) {
		AV *ci = newAV();
		av_push(ci, newSVnv(ci_lo));
		av_push(ci, newSVnv(ci_hi));
		hv_stores(res, "conf.int",   newRV_noinc((SV *)ci));
		hv_stores(res, "conf.level", newSVnv(achieved_level));
		hv_stores(res, "estimate",   newSVnv(estimate));
	}
	RETVAL = newRV_noinc((SV *)res);
}
OUTPUT:
	RETVAL

SV* chisq_test(...)
CODE:
{
	if (items < 1) croak("chisq_test requires at least a data reference");
	SV *data_ref = ST(0);
/* Named options, mirroring R's chisq.test(x, correct =, p =, rescale.p =).
  'correct' defaults on, as in R, but only ever applies to a 2x2 table.
  'p' supplies the null probabilities of the goodness-of-fit test -- without
  it the test is against a uniform distribution, which is what "Chi-squared
  test for given probabilities" has always meant here.*/
	bool correct   = 1;
	SV  *p_sv      = NULL;
	bool rescale_p = 0;
	for (Stack_off_t i = 1; i < (unsigned int)items; i += 2) {
		if (i + 1 >= (unsigned int)items) croak("chisq_test: odd number of named arguments");
		const char *key = SvPV_nolen(ST(i));
		SV *val = ST(i + 1);
		if (strEQ(key, "correct")) correct = SvTRUE(val) ? TRUE : FALSE;
		else if (strEQ(key, "p")) p_sv = SvOK(val) ? val : NULL;
		else if (strEQ(key, "rescale.p") || strEQ(key, "rescale_p")) rescale_p = SvTRUE(val) ? TRUE : FALSE;
		else croak("chisq_test: unknown argument '%s'", key);
	}

	if (!SvROK(data_ref)) {// 1. Input Validation & Data Matrix Construction
		croak("Input must be a reference");
	}
	svtype input_type = SvTYPE(SvRV(data_ref));
	if (input_type != SVt_PVAV && input_type != SVt_PVHV) {
		croak("Input must be an array reference or a hash reference");
	}
/* The table is read into one flat row-major r x c buffer, whatever the input
  shape: a 1D input is simply r == 1.  is_2d records the *nesting* of the
  input, and is used only to give 'expected' the same shape the caller passed
  in; it does not decide which test runs (see 'gof' below).
  Everything allocated here is handed to SAVEFREEPV so that a croak from
  deep inside the parse -- a ragged row, a negative count -- unwinds without
  leaking; the AVs of keys are mortal for the same reason.*/
	NV *restrict obs = NULL;
	AV *row_keys = NULL;
	AV *col_keys = NULL;
	unsigned int r = 0, c = 0;
	bool is_2d = 0;
	if (input_type == SVt_PVAV) {
		AV *obs_av = (AV *)SvRV(data_ref);
		unsigned int n0 = (unsigned int)(av_top_index(obs_av) + 1);
		if (n0 == 0) croak("Empty data structure");
		SV **first_elem = av_fetch(obs_av, 0, 0);
		if (first_elem && SvROK(*first_elem) && SvTYPE(SvRV(*first_elem)) == SVt_PVAV) {
			is_2d = 1;
			r = n0;
			c = (unsigned int)(av_top_index((AV *)SvRV(*first_elem)) + 1);
			if (c == 0) croak("Empty data structure");
			obs = (NV *)safemalloc((size_t)r * c * sizeof(NV));
			SAVEFREEPV(obs);
			for (unsigned int i = 0; i < r; i++) {
				SV **row_sv = av_fetch(obs_av, i, 0);
				if (!row_sv || !SvROK(*row_sv) || SvTYPE(SvRV(*row_sv)) != SVt_PVAV)
					croak("chisq_test: row %u is not an array reference", i + 1);
				AV *row_av = (AV *)SvRV(*row_sv);
				if ((unsigned int)(av_top_index(row_av) + 1) != c)
					croak("chisq_test: all rows must have the same number of columns (row 1 has %u, row %u has %u)",
						c, i + 1, (unsigned int)(av_top_index(row_av) + 1));
				for (unsigned int j = 0; j < c; j++)
					obs[i * c + j] = ct_cell(aTHX_ ct_av_get(aTHX_ row_av, j),
						SvPV_nolen(sv_2mortal(newSVpvf("cell [%u][%u]", i, j))));
			}
		} else {
			r = 1;
			c = n0;
			obs = (NV *)safemalloc((size_t)c * sizeof(NV));
			SAVEFREEPV(obs);
			for (unsigned int j = 0; j < c; j++)
				obs[j] = ct_cell(aTHX_ ct_av_get(aTHX_ obs_av, j),
					SvPV_nolen(sv_2mortal(newSVpvf("element [%u]", j))));
		}
	} else {
		HV *obs_hv = (HV *)SvRV(data_ref);
		if (HvUSEDKEYS(obs_hv) == 0) croak("Empty data structure");
		row_keys = (AV *)sv_2mortal((SV *)newAV());
		col_keys = (AV *)sv_2mortal((SV *)newAV());
/* Keys are laid out in sorted order, as fisher_test does, so the table --
  the nesting it is read as, the cell it complains about, everything -- is
  the same on every run regardless of Perl's hash randomization.  Reading
  any of that off whichever key hv_iternext() happened to hand back first
  made the diagnosis of a malformed hash a coin toss.*/
		HE *entry;
		hv_iterinit(obs_hv);
		while ((entry = hv_iternext(obs_hv))) {
			av_push(row_keys, newSVsv(hv_iterkeysv(entry)));
			r++;
		}
		sortsv(AvARRAY(row_keys), (size_t)r, Perl_sv_cmp);
		HE *first_he = hv_fetch_ent(obs_hv, *av_fetch(row_keys, 0, 0), 0, 0);
		SV *first_val = first_he ? HeVAL(first_he) : NULL;

		if (SvROK(first_val) && SvTYPE(SvRV(first_val)) == SVt_PVHV) {
			is_2d = 1;
/* The column set is taken from the first row and every other row must
  carry exactly it.  Filling a missing key with an implicit zero (as this
  used to) turns a typo into a silently different table.*/
			HV *first_inner = (HV *)SvRV(first_val);
			HE *col_entry;
			hv_iterinit(first_inner);
			while ((col_entry = hv_iternext(first_inner))) {
				av_push(col_keys, newSVsv(hv_iterkeysv(col_entry)));
				c++;
			}
			if (c == 0) croak("Empty data structure");
			sortsv(AvARRAY(col_keys), (size_t)c, Perl_sv_cmp);

			obs = (NV *)safemalloc((size_t)r * c * sizeof(NV));
			SAVEFREEPV(obs);
			for (unsigned int i = 0; i < r; i++) {
				SV **row_key_sv = av_fetch(row_keys, i, 0);
				HE *inner_he = hv_fetch_ent(obs_hv, *row_key_sv, 0, 0);
				SV *inner_sv = inner_he ? HeVAL(inner_he) : NULL;
				if (!inner_sv || !SvROK(inner_sv) || SvTYPE(SvRV(inner_sv)) != SVt_PVHV)
					croak("chisq_test: row '%s' is not a hash reference", SvPV_nolen(*row_key_sv));
				HV *inner_hv = (HV *)SvRV(inner_sv);
				if ((unsigned int)HvUSEDKEYS(inner_hv) != c)
					croak("chisq_test: every row must have the same %u column key(s); row '%s' has %u",
						c, SvPV_nolen(*row_key_sv), (unsigned int)HvUSEDKEYS(inner_hv));
				for (unsigned int j = 0; j < c; j++) {
					SV **col_key_sv = av_fetch(col_keys, j, 0);
					HE *val_he = hv_fetch_ent(inner_hv, *col_key_sv, 0, 0);
					if (!val_he)
						croak("chisq_test: row '%s' has no column '%s'",
							SvPV_nolen(*row_key_sv), SvPV_nolen(*col_key_sv));
					obs[i * c + j] = ct_cell(aTHX_ HeVAL(val_he),
						SvPV_nolen(sv_2mortal(newSVpvf("cell {%s}{%s}",
							SvPV_nolen(*row_key_sv), SvPV_nolen(*col_key_sv)))));
				}
			}
		} else {// 1D Hash Handling: the keys already collected are the cells
			col_keys = row_keys;
			c = r;
			r = 1;
			obs = (NV *)safemalloc((size_t)c * sizeof(NV));
			SAVEFREEPV(obs);
			for (unsigned int j = 0; j < c; j++) {
				SV **col_key_sv = av_fetch(col_keys, j, 0);
				HE *val_he = hv_fetch_ent(obs_hv, *col_key_sv, 0, 0);
				obs[j] = ct_cell(aTHX_ val_he ? HeVAL(val_he) : NULL,
					SvPV_nolen(sv_2mortal(newSVpvf("element {%s}", SvPV_nolen(*col_key_sv)))));
			}
		}
	}
	if (r == 0 || c == 0) croak("Empty data structure");
/* A table with a single row or a single column is not a contingency table:
  R drops it to a vector ("if (min(dim(x)) == 1L) x <- as.vector(x)") and
  runs the goodness-of-fit test, and so does this.  Treating it as r x c
  instead gives df == 0 and the vacuous p-value 1.*/
	bool gof = (!is_2d || r == 1 || c == 1);
	unsigned int k = r * c;

	ct_acc_t total_acc = 0.0;
	for (unsigned int idx = 0; idx < k; idx++) total_acc += obs[idx];
	NV grand_total = (NV)total_acc;
	if (grand_total == 0.0) croak("chisq_test: at least one entry of 'x' must be positive");
	if (gof && k < 2) croak("chisq_test: 'x' must at least have 2 elements");
/* Null probabilities for the goodness-of-fit test.  They are matched to the
  data by position for an array and by key for a hash, so the caller never
  has to know the order Perl happens to hand back the keys in.*/
	NV *restrict probs = NULL;
	if (p_sv) {
		if (!gof)
			croak("chisq_test: 'p' applies to the goodness-of-fit test only, not to an %ux%u contingency table", r, c);
		if (!SvROK(p_sv)) croak("chisq_test: 'p' must be an array reference or a hash reference");
		probs = (NV *)safemalloc((size_t)k * sizeof(NV));
		SAVEFREEPV(probs);
		svtype p_type = SvTYPE(SvRV(p_sv));
		if (p_type == SVt_PVAV) {
			if (input_type == SVt_PVHV)
				croak("chisq_test: 'p' must be a hash reference keyed like 'x' when 'x' is a hash reference");
			AV *p_av = (AV *)SvRV(p_sv);
			if ((unsigned int)(av_top_index(p_av) + 1) != k)
				croak("chisq_test: 'x' and 'p' must have the same number of elements");
			for (unsigned int j = 0; j < k; j++)
				probs[j] = ct_prob(aTHX_ ct_av_get(aTHX_ p_av, j),
					SvPV_nolen(sv_2mortal(newSVpvf("p[%u]", j))));
		} else if (p_type == SVt_PVHV) {
			if (input_type != SVt_PVHV)
				croak("chisq_test: 'p' must be an array reference when 'x' is an array reference");
			// for a collapsed 1 x k or k x 1 hash the cells are named by whichever axis is not 1
			AV *key_av = (is_2d && c == 1) ? row_keys : col_keys;
			HV *p_hv = (HV *)SvRV(p_sv);
			if ((unsigned int)HvUSEDKEYS(p_hv) != k)
				croak("chisq_test: 'x' and 'p' must have the same number of elements");
			for (unsigned int j = 0; j < k; j++) {
				SV **key_sv = av_fetch(key_av, j, 0);
				HE *p_he = hv_fetch_ent(p_hv, *key_sv, 0, 0);
				if (!p_he) croak("chisq_test: 'p' has no entry for '%s'", SvPV_nolen(*key_sv));
				probs[j] = ct_prob(aTHX_ HeVAL(p_he),
					SvPV_nolen(sv_2mortal(newSVpvf("p{%s}", SvPV_nolen(*key_sv)))));
			}
		} else {
			croak("chisq_test: 'p' must be an array reference or a hash reference");
		}
		NV p_sum = 0.0;
		for (unsigned int j = 0; j < k; j++) p_sum += probs[j];
/* R's tolerance on the sum is sqrt(.Machine$double.eps), and it is a
  double there whatever the NV width is here.*/
		if (nv_fabs(p_sum - 1.0) > nv_sqrt((NV)DBL_EPSILON)) {
			if (!rescale_p) croak("chisq_test: probabilities must sum to 1");
			if (p_sum <= 0.0) croak("chisq_test: probabilities must sum to a positive value to be rescaled");
			for (unsigned int j = 0; j < k; j++) probs[j] /= p_sum;
		}
	}
	NV *restrict expect = (NV *)safemalloc((size_t)k * sizeof(NV));
	SAVEFREEPV(expect);
	ct_acc_t stat_acc = 0.0;
	unsigned int df = 0;
	bool yates = 0;

	if (gof) {
/* R's default p is rep(1/k, k) and its E is n * p, so the uniform
  expectation is n * (1/k) and not n / k: the two differ by an ulp for
  most k, and that ulp is visible in the statistic.*/
		NV unif = 1.0 / (NV)k;
		for (unsigned int idx = 0; idx < k; idx++) {
			NV E = probs ? grand_total * probs[idx] : grand_total * unif;
			NV d = obs[idx] - E;
			expect[idx] = E;
			stat_acc += (d * d) / E;
		}
		df = k - 1;
	} else {
		NV *restrict row_sum = (NV *)safemalloc(r * sizeof(NV));
		SAVEFREEPV(row_sum);
		NV *restrict col_sum = (NV *)safemalloc(c * sizeof(NV));
		SAVEFREEPV(col_sum);
		// one accumulator per margin, as R's rowSums()/colSums() do
		for (unsigned int i = 0; i < r; i++) {
			ct_acc_t acc = 0.0;
			for (unsigned int j = 0; j < c; j++) acc += obs[i * c + j];
			row_sum[i] = (NV)acc;
		}
		for (unsigned int j = 0; j < c; j++) {
			ct_acc_t acc = 0.0;
			for (unsigned int i = 0; i < r; i++) acc += obs[i * c + j];
			col_sum[j] = (NV)acc;
		}
		for (unsigned int i = 0; i < r; i++)
			for (unsigned int j = 0; j < c; j++)
				expect[i * c + j] = (row_sum[i] * col_sum[j]) / grand_total;
/* Yates' correction is one number for the whole table -- R's
  min(0.5, abs(x - E)) minimises over every cell before subtracting --
  not a per-cell min.  On an exact 2x2 the four |O - E| are equal in
  theory, but not always in the last bits, so taking the minimum first
  is what reproduces R.  A table that already sits exactly on its
  expectation gives a correction of 0, and R reports that as a plain
  Pearson test rather than a corrected one ("if (YATES > 0)"), so the
  method string follows the correction actually applied, not the request.*/
		NV y_corr = 0.0;
		if (correct && r == 2 && c == 2) {
			y_corr = 0.5;
			for (unsigned int idx = 0; idx < k; idx++) {
				NV a = nv_fabs(obs[idx] - expect[idx]);
				if (a < y_corr) y_corr = a;
			}
			yates = (y_corr > 0.0) ? 1 : 0;
		}
		for (unsigned int idx = 0; idx < k; idx++) {
			NV d = nv_fabs(obs[idx] - expect[idx]) - y_corr;
			stat_acc += (d * d) / expect[idx];
		}
		df = (r - 1) * (c - 1);
	}
	/* R warns whenever any expected count is below 5, the usual rule of thumb
	 for the chi-squared approximation being trustworthy.*/
	for (unsigned int idx = 0; idx < k; idx++) {
		if (expect[idx] < 5.0) {
			warn("chisq_test: Chi-squared approximation may be incorrect");
			break;
		}
	}
	// 'expected' is rebuilt in whatever shape the caller passed in
	SV *expected_ref = NULL;
	if (input_type == SVt_PVAV) {
		AV *expected_av = newAV();
		if (is_2d) {
			for (unsigned int i = 0; i < r; i++) {
				AV *exp_row = newAV();
				for (unsigned int j = 0; j < c; j++) av_push(exp_row, newSVnv(expect[i * c + j]));
				av_push(expected_av, newRV_noinc((SV *)exp_row));
			}
		} else {
			for (unsigned int j = 0; j < c; j++) av_push(expected_av, newSVnv(expect[j]));
		}
		expected_ref = newRV_noinc((SV *)expected_av);
	} else {
		HV *expected_hv = newHV();
		if (is_2d) {
			for (unsigned int i = 0; i < r; i++) {
				HV *exp_row = newHV();
				for (unsigned int j = 0; j < c; j++)
					hv_store_ent(exp_row, *av_fetch(col_keys, j, 0), newSVnv(expect[i * c + j]), 0);
				hv_store_ent(expected_hv, *av_fetch(row_keys, i, 0), newRV_noinc((SV *)exp_row), 0);
			}
		} else {
			for (unsigned int j = 0; j < c; j++)
				hv_store_ent(expected_hv, *av_fetch(col_keys, j, 0), newSVnv(expect[j]), 0);
		}
		expected_ref = newRV_noinc((SV *)expected_hv);
	}
	NV stat = (NV)stat_acc;
	NV p_val = get_p_value(stat, df);
	// 3. Build the top-level results Hash (mimicking R's htest structure)
	HV*results = newHV();
	HV*statistic_hv = newHV();
	hv_store(statistic_hv, "X-squared", 9, newSVnv(stat), 0);
	hv_store(results, "statistic", 9, newRV_noinc((SV*)statistic_hv), 0);
	HV*parameter_hv = newHV();
	hv_store(parameter_hv, "df", 2, newSViv(df), 0);
	hv_store(results, "parameter", 9, newRV_noinc((SV*)parameter_hv), 0);
	hv_store(results, "p.value", 7, newSVnv(p_val), 0);
	hv_store(results, "expected", 8, expected_ref, 0);
	hv_store(results, "observed", 8, SvREFCNT_inc(data_ref), 0);
	if (input_type == SVt_PVAV) {
		hv_store(results, "data.name", 9, newSVpv("Perl ArrayRef", 0), 0);
	} else {
		hv_store(results, "data.name", 9, newSVpv("Perl HashRef", 0), 0);
	}
	if (!gof) {
		if (yates) {
			hv_store(results, "method", 6, newSVpv("Pearson's Chi-squared test with Yates' continuity correction", 0), 0);
		} else {
			hv_store(results, "method", 6, newSVpv("Pearson's Chi-squared test", 0), 0);
		}
	} else {
		hv_store(results, "method", 6, newSVpv("Chi-squared test for given probabilities", 0), 0);
	}
	RETVAL = newRV_noinc((SV*)results);
}
OUTPUT:
	RETVAL

PROTOTYPES: ENABLE

void write_table(...)
PPCODE:
{
	SV *data_sv = NULL;
	SV *file_sv = NULL;
	Stack_off_t 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++;
		}
	}
/* Only consume a positional file argument if it is a plain string that is
  NOT one of the named option keys. Otherwise write_table(data=>..., file=>...)
  would grab the literal string "data" as the filename.*/
	if (arg_idx < items) {
		SV *cand = ST(arg_idx);
		if (SvOK(cand) && !SvROK(cand)) {
			const char *k = SvPV_nolen(cand);
			if (!(strEQ(k, "data") || strEQ(k, "file") || strEQ(k, "col.names") ||
				  strEQ(k, "row.names") || strEQ(k, "sep") || strEQ(k, "delim") ||
				  strEQ(k, "undef.val") || strEQ(k, "tex") ||
				  strEQ(k, "tex.col.align") || strEQ(k, "tex.size") ||
				  strEQ(k, "tex.comment") || strEQ(k, "tex.bold.1st.col") ||
				  strEQ(k, "tex.format") || strEQ(k, "tex.longtable") ||
				  strEQ(k, "tex.longtable.head") ||
				  strEQ(k, "xlsx") || strEQ(k, "xlsx.sheet") ||
				  strEQ(k, "xlsx.comment") || strEQ(k, "xlsx.freeze.rows") ||
				  strEQ(k, "xlsx.freeze.cols"))) {
				file_sv = cand;
				arg_idx++;
			}
		}
	}
	const char *sep = ",";
	bool explicit_sep = 0; // Track if delimiter was manually specified
/* default undef cells to a true empty value ("") instead of NULL.
  With print_string_row emitting zero-length fields bare (no quotes), an
  undef cell now prints as nothing at all: a,,c -- not a,'',c or a,"",c.
  'undef.val' => 'NA' (etc.) still overrides this.*/
	const char *undef_val = "";
	SV *row_names_sv = sv_2mortal(newSViv(0));
	SV *col_names_sv = NULL;
/* LaTeX tabular output. 'tex' selects LaTeX for the main output file; the
  remaining tex.* keys tune the rendering. tex_opt is tri-state: -1 = not
  given (auto-detect from a ".tex" file name), 0 = off, 1 = on.*/
	short int tex_opt = -1;
	const char *tex_align = "c";  // per-column alignment: c / l / r
	const char *tex_size  = NULL; // optional size directive, e.g. \small
	SV *tex_comment = NULL; // string or array ref of % comment lines
	bool tex_bold1  = 1;    // bold the first column of each data row
	bool tex_format = 0;    // %.4g-format numeric cells
	bool tex_longtable = 0; // body only, for \input into a longtable
/* Generate longtable's own repeat-header machinery (\endfirsthead / \endhead /
  \endfoot) instead of a plain header row. A non-numeric value is the caption
  used on continuation pages. Implies tex.longtable.*/
	SV *tex_longtable_head = NULL;
	/* .xlsx (Excel) output, dependency-free. xlsx_opt is tri-state like tex_opt:
	 -1 = auto-detect from a ".xlsx" file name, 0 = off, 1 = on.*/
	short int xlsx_opt = -1;
	const char *xlsx_sheet = "Sheet1"; // worksheet name
	SV *xlsx_comment = NULL;            // extra comment line(s) appended after the provenance
	IV xlsx_freeze_rows = 0;                     // leading rows to freeze (0 = none)
	IV xlsx_freeze_cols = 0;                     // leading columns to freeze (0 = none)
	// Read the remaining Hash-style arguments
	for (; arg_idx < items; arg_idx += 2) {
		if (arg_idx + 1 >= items) croak("write_table: Odd number of arguments passed");
		const char *key = SvPV_nolen(ST(arg_idx));
		SV *val = ST(arg_idx + 1);
		if (strEQ(key, "data")) data_sv = val;
		else if (strEQ(key, "col.names")) col_names_sv = val;
		else if (strEQ(key, "file")) file_sv = val;
		else if (strEQ(key, "row.names")) row_names_sv = val;
		// Check for either "sep" or "delim" and mark as explicitly provided
		else if (strEQ(key, "sep") || strEQ(key, "delim")) {
			sep = SvPV_nolen(val);
			explicit_sep = 1;
		}
		else if (strEQ(key, "undef.val")) undef_val = SvOK(val) ? SvPV_nolen(val) : "";
		else if (strEQ(key, "tex"))              tex_opt     = SvTRUE(val) ? 1 : 0;
		else if (strEQ(key, "tex.col.align"))  { if (SvOK(val)) tex_align = SvPV_nolen(val); }
		else if (strEQ(key, "tex.size"))         tex_size    = SvOK(val) ? SvPV_nolen(val) : NULL;
		else if (strEQ(key, "tex.comment"))      tex_comment = SvOK(val) ? val : NULL;
		else if (strEQ(key, "tex.bold.1st.col")) tex_bold1   = SvTRUE(val) ? 1 : 0;
		else if (strEQ(key, "tex.format"))       tex_format  = SvTRUE(val) ? 1 : 0;
		else if (strEQ(key, "tex.longtable"))    tex_longtable = SvTRUE(val) ? 1 : 0;
		else if (strEQ(key, "tex.longtable.head")) tex_longtable_head = SvOK(val) ? val : NULL;
		else if (strEQ(key, "xlsx"))             xlsx_opt    = SvTRUE(val) ? 1 : 0;
		else if (strEQ(key, "xlsx.sheet"))     { if (SvOK(val)) xlsx_sheet = SvPV_nolen(val); }
		else if (strEQ(key, "xlsx.comment"))     xlsx_comment = SvOK(val) ? val : NULL;
		else if (strEQ(key, "xlsx.freeze.rows")) {
			if (SvOK(val)) {
				xlsx_freeze_rows = SvIV(val);
				if (xlsx_freeze_rows < 0)
					croak("write_table: 'xlsx.freeze.rows' must be a non-negative integer\n");
			}
		}
		else if (strEQ(key, "xlsx.freeze.cols")) {
			if (SvOK(val)) {
				xlsx_freeze_cols = SvIV(val);
				if (xlsx_freeze_cols < 0)
					croak("write_table: 'xlsx.freeze.cols' must be a non-negative integer\n");
			}
		}
		else croak("write_table: Unknown arguments passed: %s", key);
	}
	if (!data_sv || !SvROK(data_sv)) {
		croak("write_table: 'data' must be a HASH or ARRAY reference\n");
	}
	SV *data_ref = SvRV(data_sv);
	if (SvTYPE(data_ref) != SVt_PVHV && SvTYPE(data_ref) != SVt_PVAV) {
		croak("write_table: 'data' must be a HASH or ARRAY reference\n");
	}
	if (!file_sv || !SvOK(file_sv)) croak("write_table: file name missing\n");
	const char *file = SvPV_nolen(file_sv);
	/* Decide LaTeX vs delimited. A ".tex" file name turns LaTeX on by default;
	 an explicit tex => 0/1 always wins (so tex => 0 forces a delimited file
	 even when it is named *.tex, and tex => 1 forces LaTeX for any name).*/
	bool tex = 0;
	if (tex_opt == -1) {
		size_t file_len = strlen(file);
		if (file_len >= 4) {
			const char *ext = file + file_len - 4;
			if (strEQ(ext, ".tex") || strEQ(ext, ".TEX")) tex = 1;
		}
	} else {
		tex = tex_opt ? 1 : 0;
	}
/* Requesting a longtable body is a LaTeX request; force 'tex' on even for
  a non-".tex" file name or tex => 0. (tex.longtable only affects the
  LaTeX renderer, so without this it would be silently ignored.)
  'tex.longtable.head' only has meaning inside a longtable body, so asking for
  it is asking for one.*/
	if (tex_longtable_head && SvTRUE(tex_longtable_head)) tex_longtable = 1;
	if (tex_longtable) tex = 1;
/* .xlsx decision, mirroring the tex logic: a ".xlsx" file name turns it on
  unless an explicit xlsx => 0/1 says otherwise.*/
	bool xlsx = 0;
	if (xlsx_opt == -1) {
		size_t file_len = strlen(file);
		if (file_len >= 5) {
			const char *ext = file + file_len - 5;
			if (strEQ(ext, ".xlsx") || strEQ(ext, ".XLSX")) xlsx = 1;
		}
	} else {
		xlsx = xlsx_opt ? 1 : 0;
	}
	if (tex && xlsx)
		croak("write_table: 'tex' and 'xlsx' output are mutually exclusive\n");
/* LaTeX and xlsx are both rendered from collected rows, not streamed to a
  delimited file handle.*/
	bool collect = tex || xlsx;
	if (!explicit_sep) {// Auto-detect separator from file extension if not overridden
		size_t file_len = strlen(file);
		if (file_len >= 4) {
			const char *ext = file + file_len - 4;
			if (strEQ(ext, ".tsv") || strEQ(ext, ".TSV")) {
				sep = "\t";
			} else if (strEQ(ext, ".csv") || strEQ(ext, ".CSV")) {
				sep = ",";
			}
		}
	}
	if (col_names_sv && SvOK(col_names_sv)) {
		if (!SvROK(col_names_sv) || SvTYPE(SvRV(col_names_sv)) != SVt_PVAV) {
			croak("write_table: 'col.names' must be an ARRAY reference\n");
		}
	}
	bool is_hoh = 0, is_hoa = 0, is_aoh = 0, is_flat_hash = 0, is_aoa = 0;
	AV *rows_av = NULL;
// Validate Input Structures & Homogeneity
	if (SvTYPE(data_ref) == SVt_PVHV) {
		HV *hv = (HV*)data_ref;
		if (hv_iterinit(hv) == 0) XSRETURN_EMPTY;
		HE *entry = hv_iternext(hv);
		SV *first_val = hv_iterval(hv, entry);

		if (!first_val) {
			croak("write_table: Invalid hash entry\n");
		}
// Check if top level values are scalars (Flat Hash)
		if (!SvROK(first_val)) {
			is_flat_hash = 1;
		} else {
			int first_type = SvTYPE(SvRV(first_val));
			if (first_type != SVt_PVHV && first_type != SVt_PVAV) {
				croak("write_table: Data values must be either all HASHes, all ARRAYs, or all scalars\n");
			}
			is_hoh = (first_type == SVt_PVHV);
			is_hoa = (first_type == SVt_PVAV);
		}
		hv_iterinit(hv);
		while ((entry = hv_iternext(hv))) {
			SV *val = hv_iterval(hv, entry);
			if (is_flat_hash) {
				if (val && SvROK(val)) {
					croak("write_table: Mixed data types detected. Ensure all values are scalars for a flat hash.\n");
				}
			} else {
				if (!val || !SvROK(val) || SvTYPE(SvRV(val)) != (is_hoh ? SVt_PVHV : SVt_PVAV)) {
					croak("write_table: Mixed data types detected. Ensure all values are %s references.\n", is_hoh ? "HASH" : "ARRAY");
				}
			}
		}
		if (is_hoh) { // Rows are only explicitly pre-gathered for HOH
			rows_av = newAV();
			hv_iterinit(hv);
			while ((entry = hv_iternext(hv))) {
				av_push(rows_av, newSVsv(hv_iterkeysv(entry)));
			}
		}
	} else {
		AV *av = (AV*)data_ref;
		if (av_len(av) < 0) XSRETURN_EMPTY;
		SV **first_ptr = av_fetch(av, 0, 0);
		if (first_ptr && *first_ptr && SvROK(*first_ptr)
				&& SvTYPE(SvRV(*first_ptr)) == SVt_PVAV) {
// Array of Arrays: every element must be an ARRAY reference.
			for (SSize_t i = 0; i <= av_len(av); i++) {
				SV **ptr = av_fetch(av, i, 0);
				if (!ptr || !*ptr || !SvROK(*ptr) || SvTYPE(SvRV(*ptr)) != SVt_PVAV) {
					croak("write_table: Mixed data types detected in Array of Arrays. All elements must be ARRAY references.\n");
				}
			}
			is_aoa = 1;
		} else {
			if (!first_ptr || !*first_ptr || !SvROK(*first_ptr) || SvTYPE(SvRV(*first_ptr)) != SVt_PVHV) {
				if (first_ptr && *first_ptr && SvROK(*first_ptr))
					croak("write_table: For ARRAY data, every element must be a HASH reference "
						  "(Array of Hashes) or all ARRAY references (Array of Arrays); element 0 is a reference of type '%s'\n",
						  sv_reftype(SvRV(*first_ptr), 0));
				else if (first_ptr && *first_ptr && SvOK(*first_ptr))
					croak("write_table: For ARRAY data, every element must be a HASH reference "
						  "(Array of Hashes) or all ARRAY references (Array of Arrays); element 0 is a non-reference scalar (value: '%s')\n",
						  SvPV_nolen(*first_ptr));
				else
					croak("write_table: For ARRAY data, every element must be a HASH reference "
						  "(Array of Hashes) or all ARRAY references (Array of Arrays); element 0 is undef\n");
			}
// FIX: i was size_t while av_len() returns SSize_t; keep both signed.
			for (SSize_t i = 0; i <= av_len(av); i++) {
				SV **ptr = av_fetch(av, i, 0);
				if (!ptr || !*ptr || !SvROK(*ptr) || SvTYPE(SvRV(*ptr)) != SVt_PVHV) {
					croak("write_table: Mixed data types detected in Array of Hashes. All elements must be HASH references.\n");
				}
			}
			is_aoh = 1;
		}
	}
/* With 'tex' or 'xlsx' on, the main file receives the rendered output, written
  once the rows have been collected; no delimited handle is opened here (fh
  stays NULL and print_string_row() collects each record without emitting it).*/
	PerlIO *fh = collect ? NULL : PerlIO_open(file, "w");
	if (!collect && !fh) {
		if (rows_av) SvREFCNT_dec(rows_av);
		croak("write_table: Could not open '%s' for writing", file);
	}
	AV *headers_av = newAV();
/* row.names is off unless asked for, in every format -- delimited, LaTeX and
  .xlsx alike. R's write.table() defaults it on, and this used to follow suit,
  but a label column nobody asked for is the wrong default here: the common
  case is a frame whose rows are already identified by one of its own columns,
  and the leading empty header cell it produces (",gene,n") is a well known
  nuisance to read back. row.names => 1 opts in and gives the old behaviour;
  row.names => 'col' uses that column's values as the labels.*/
	bool inc_rownames = (row_names_sv && SvTRUE(row_names_sv)) ? 1 : 0;
	const char *rownames_col = NULL;
/* When 'tex' or 'xlsx' is on, collect every record here (as an AV of AVs of
  SVs) so the renderer can build the output afterwards. Mortal => reclaimed
  automatically if any of the croak paths below fire.*/
	AV *collect_av = collect ? (AV*)sv_2mortal((SV*)newAV()) : NULL;
	if (is_hoh) {// ----- Hash of Hashes -----
		if (col_names_sv && SvOK(col_names_sv)) {
			AV *c_av = (AV*)SvRV(col_names_sv);
			for (SSize_t i = 0; i <= av_len(c_av); i++) {
				SV **c = av_fetch(c_av, i, 0);
				if (c && SvOK(*c)) av_push(headers_av, newSVsv(*c));
			}
		} else {
			HV *col_map = newHV();
			hv_iterinit((HV*)data_ref);
			HE *entry;
			while ((entry = hv_iternext((HV*)data_ref))) {
				HV *inner = (HV*)SvRV(hv_iterval((HV*)data_ref, entry));
				hv_iterinit(inner);
				HE *inner_entry;
				while ((inner_entry = hv_iternext(inner))) {
					hv_store_ent(col_map, hv_iterkeysv(inner_entry), newSViv(1), 0);
				}
			}
			unsigned num_cols = hv_iterinit(col_map);
			for (unsigned i = 0; i < num_cols; i++) {
				HE *ce = hv_iternext(col_map);
				av_push(headers_av, newSVsv(hv_iterkeysv(ce)));
			}
			if (num_cols > 1)
				sortsv(AvARRAY(headers_av), num_cols, Perl_sv_cmp);
			SvREFCNT_dec(col_map);
		}
		size_t num_headers = (size_t)(av_len(headers_av) + 1);
		const char **header_row = safemalloc((num_headers + 1) * sizeof(char*));
		size_t h_idx = 0;
		if (inc_rownames) header_row[h_idx++] = "";
		for (size_t i = 0; i < num_headers; i++) {
			SV **h_ptr = av_fetch(headers_av, (SSize_t)i, 0);
			header_row[h_idx++] = (h_ptr && SvOK(*h_ptr)) ? SvPV_nolen(*h_ptr) : "";
		}
		print_string_row(aTHX_ fh, header_row, h_idx, sep, collect_av);
		safefree(header_row);
		size_t num_rows = (size_t)(av_len(rows_av) + 1);
		sortsv(AvARRAY(rows_av), num_rows, Perl_sv_cmp);
		HV *data_hv = (HV*)data_ref;
		const char **row_data = safemalloc((num_headers + 1) * sizeof(char*));
		for (size_t i = 0; i < num_rows; i++) {
			size_t d_idx = 0;
			SV *row_key_sv = *av_fetch(rows_av, (SSize_t)i, 0);
			if (inc_rownames) row_data[d_idx++] = SvPV_nolen(row_key_sv);
			HE *inner_he = hv_fetch_ent(data_hv, row_key_sv, 0, 0);
			SV *inner_sv = inner_he ? HeVAL(inner_he) : NULL;
			HV *inner_hv = (inner_sv && SvROK(inner_sv)) ? (HV*)SvRV(inner_sv) : NULL;
			for (size_t j = 0; j < num_headers; j++) {
				SV **h_ptr = av_fetch(headers_av, (SSize_t)j, 0);
				SV *h_sv = (h_ptr && SvOK(*h_ptr)) ? *h_ptr : NULL;
				// FIX (UTF-8/NUL safety): fetch by SV, not by raw bytes
				HE *cell_he = (inner_hv && h_sv) ? hv_fetch_ent(inner_hv, h_sv, 0, 0) : NULL;
				SV *cell_sv = cell_he ? HeVAL(cell_he) : NULL;
				if (cell_sv && SvOK(cell_sv)) {
					if (SvROK(cell_sv)) {
						if (fh) PerlIO_close(fh);
						safefree(row_data);
						if (headers_av) SvREFCNT_dec(headers_av);
						if (rows_av) SvREFCNT_dec(rows_av);
						croak("write_table: Cannot write nested reference types to table\n");
					}
					row_data[d_idx++] = SvPV_nolen(cell_sv);
				} else {
					row_data[d_idx++] = undef_val;
				}
			}
			print_string_row(aTHX_ fh, row_data, d_idx, sep, collect_av);
		}
		safefree(row_data);
	} else if (is_flat_hash) {// Flat Hash
		HV *data_hv = (HV*)data_ref;
		if (col_names_sv && SvOK(col_names_sv)) {
			AV *c_av = (AV*)SvRV(col_names_sv);
			for (SSize_t i = 0; i <= av_len(c_av); i++) {
				SV **c = av_fetch(c_av, i, 0);
				if (c && SvOK(*c)) av_push(headers_av, newSVsv(*c));
			}
		} else {
/* UTF-8 safety: keep the key SVs (flags intact) and sort
  them with sv_cmp instead of round-tripping through char*.*/
			unsigned int num_cols = hv_iterinit(data_hv);
			for (unsigned int i = 0; i < num_cols; i++) {
				HE *ce = hv_iternext(data_hv);
				av_push(headers_av, newSVsv(hv_iterkeysv(ce)));
			}
			if (num_cols > 1)
				sortsv(AvARRAY(headers_av), num_cols, Perl_sv_cmp);
		}
		size_t num_headers = (size_t)(av_len(headers_av) + 1);
		const char **header_row = safemalloc((num_headers + 1) * sizeof(char*));
		size_t h_idx = 0;
		if (inc_rownames) header_row[h_idx++] = "";
		for (size_t i = 0; i < num_headers; i++) {
			SV **h_ptr = av_fetch(headers_av, (SSize_t)i, 0);
			header_row[h_idx++] = (h_ptr && SvOK(*h_ptr)) ? SvPV_nolen(*h_ptr) : "";
		}
		print_string_row(aTHX_ fh, header_row, h_idx, sep, collect_av);
		safefree(header_row);
		const char **row_data = safemalloc((num_headers + 1) * sizeof(char*));
		size_t d_idx = 0;
// Give the single row a default numeric identifier if row names are on
		if (inc_rownames) row_data[d_idx++] = "1";
		for (size_t j = 0; j < num_headers; j++) {
			SV **h_ptr = av_fetch(headers_av, (SSize_t)j, 0);
			SV *h_sv = (h_ptr && SvOK(*h_ptr)) ? *h_ptr : NULL;
			HE *val_he = h_sv ? hv_fetch_ent(data_hv, h_sv, 0, 0) : NULL;
			SV *val_sv = val_he ? HeVAL(val_he) : NULL;
			if (val_sv && SvOK(val_sv)) {
				if (SvROK(val_sv)) {
					if (fh) PerlIO_close(fh);
					safefree(row_data);
					if (headers_av) SvREFCNT_dec(headers_av);
					croak("write_table: Cannot write nested reference types to table\n");
				}
				row_data[d_idx++] = SvPV_nolen(val_sv);
			} else {
				row_data[d_idx++] = undef_val;
			}
		}
		print_string_row(aTHX_ fh, row_data, d_idx, sep, collect_av);
		safefree(row_data);
	} else if (is_hoa) {// Hash of Arrays
		HV *data_hv = (HV*)data_ref;
		size_t max_rows = 0;
		hv_iterinit(data_hv);
		HE *entry;
		while ((entry = hv_iternext(data_hv))) {
			AV *arr = (AV*)SvRV(hv_iterval(data_hv, entry));
			size_t len = (size_t)(av_len(arr) + 1);
			if (len > max_rows) max_rows = len;
		}
		if (col_names_sv && SvOK(col_names_sv)) {
			AV *c_av = (AV*)SvRV(col_names_sv);
			for (SSize_t i = 0; i <= av_len(c_av); i++) {
				SV **c = av_fetch(c_av, i, 0);
				if (c && SvOK(*c)) av_push(headers_av, newSVsv(*c));
			}
		} else {
			unsigned int num_cols = hv_iterinit(data_hv);
			for (unsigned int i = 0; i < num_cols; i++) {
				HE *ce = hv_iternext(data_hv);
				av_push(headers_av, newSVsv(hv_iterkeysv(ce)));
			}
			if (num_cols > 1)
				sortsv(AvARRAY(headers_av), num_cols, Perl_sv_cmp);
		}
		if (av_len(headers_av) < 0) {
			if (fh) PerlIO_close(fh);
			SvREFCNT_dec(headers_av);
			croak("Could not get headers in write_table");
		}
		if (inc_rownames && contains_nondigit(aTHX_ row_names_sv)) {
			rownames_col = SvPV_nolen(row_names_sv);
			AV *filtered_headers = newAV();
			for (SSize_t i = 0; i <= av_len(headers_av); i++) {
				SV **h_ptr = av_fetch(headers_av, i, 0);
				if (!h_ptr || !*h_ptr) continue;
				SV *h_sv = *h_ptr;
				if (!sv_eq(h_sv, row_names_sv)) {
					av_push(filtered_headers, newSVsv(h_sv));
				}
			}
			SvREFCNT_dec(headers_av);
			headers_av = filtered_headers;
		}
		size_t num_headers = (size_t)(av_len(headers_av) + 1);
		const char **header_row = safemalloc((num_headers + 1) * sizeof(char*));
		size_t h_idx = 0;
		if (inc_rownames) header_row[h_idx++] = "";
		for (size_t i = 0; i < num_headers; i++) {
			SV **h_ptr = av_fetch(headers_av, (SSize_t)i, 0);
			header_row[h_idx++] = (h_ptr && SvOK(*h_ptr)) ? SvPV_nolen(*h_ptr) : "";
		}
		print_string_row(aTHX_ fh, header_row, h_idx, sep, collect_av);
		safefree(header_row);
		const char **row_data = safemalloc((num_headers + 1) * sizeof(char*));
		char rn_buf[32];
		for (size_t i = 0; i < max_rows; i++) {
			size_t d_idx = 0;
			if (inc_rownames) {
				if (rownames_col) {
					HE *rn_arr_he = hv_fetch_ent(data_hv, row_names_sv, 0, 0);
					SV *rn_arr_sv = rn_arr_he ? HeVAL(rn_arr_he) : NULL;
					if (rn_arr_sv && SvROK(rn_arr_sv)) {
						AV *rn_arr = (AV*)SvRV(rn_arr_sv);
						SV **rn_val_ptr = av_fetch(rn_arr, (SSize_t)i, 0);
						if (rn_val_ptr && SvOK(*rn_val_ptr)) {
							if (SvROK(*rn_val_ptr)) {
								if (fh) PerlIO_close(fh);
								safefree(row_data);
								if (headers_av) SvREFCNT_dec(headers_av);
								croak("write_table: Cannot write nested reference types to table\n");
							}
							row_data[d_idx++] = SvPV_nolen(*rn_val_ptr);
						} else {
							row_data[d_idx++] = undef_val;
						}
					} else {
						row_data[d_idx++] = undef_val;
					}
				} else {
					snprintf(rn_buf, sizeof(rn_buf), "%lu", (unsigned long)(i + 1));
					row_data[d_idx++] = rn_buf;
				}
			}
			for (size_t j = 0; j < num_headers; j++) {
				SV **h_ptr = av_fetch(headers_av, (SSize_t)j, 0);
				SV *h_sv = (h_ptr && SvOK(*h_ptr)) ? *h_ptr : NULL;
				HE *arr_he = h_sv ? hv_fetch_ent(data_hv, h_sv, 0, 0) : NULL;
				SV *arr_sv = arr_he ? HeVAL(arr_he) : NULL;
				if (arr_sv && SvROK(arr_sv)) {
					AV *arr = (AV*)SvRV(arr_sv);
					SV **cell_ptr = av_fetch(arr, (SSize_t)i, 0);
					if (cell_ptr && SvOK(*cell_ptr)) {
						if (SvROK(*cell_ptr)) {
							if (fh) PerlIO_close(fh);
							safefree(row_data);
							if (headers_av) SvREFCNT_dec(headers_av);
							croak("write_table: Cannot write nested reference types to table\n");
						}
						row_data[d_idx++] = SvPV_nolen(*cell_ptr);
					} else {
						row_data[d_idx++] = undef_val;
					}
				} else {
					row_data[d_idx++] = undef_val;
				}
			}
			print_string_row(aTHX_ fh, row_data, d_idx, sep, collect_av);
		}
		safefree(row_data);
	} else if (is_aoh) { // Array of Hashes
		AV *data_av = (AV*)data_ref;
		size_t num_rows = (size_t)(av_len(data_av) + 1);
		if (col_names_sv && SvOK(col_names_sv)) {
			AV *c_av = (AV*)SvRV(col_names_sv);
			for (SSize_t i = 0; i <= av_len(c_av); i++) {
				SV **c = av_fetch(c_av, i, 0);
				if (c && SvOK(*c)) av_push(headers_av, newSVsv(*c));
			}
		} else {
			HV *col_map = newHV();
			for (size_t i = 0; i < num_rows; i++) {
				SV **row_ptr = av_fetch(data_av, (SSize_t)i, 0);
				if (row_ptr && SvROK(*row_ptr)) {
					HV *row_hv = (HV*)SvRV(*row_ptr);
					hv_iterinit(row_hv);
					HE *entry;
					while ((entry = hv_iternext(row_hv))) {
						hv_store_ent(col_map, hv_iterkeysv(entry), newSViv(1), 0);
					}
				}
			}
			unsigned num_cols = hv_iterinit(col_map);
/* UTF-8 safety: keep the key SVs (flags intact) and sort
  them with sv_cmp instead of round-tripping through char*.*/
			for (unsigned int i = 0; i < num_cols; i++) {
				HE *ce = hv_iternext(col_map);
				av_push(headers_av, newSVsv(hv_iterkeysv(ce)));
			}
			if (num_cols > 1)
				sortsv(AvARRAY(headers_av), num_cols, Perl_sv_cmp);
			SvREFCNT_dec(col_map);
		}
		if (inc_rownames && contains_nondigit(aTHX_ row_names_sv)) {
			rownames_col = SvPV_nolen(row_names_sv);
			AV *filtered_headers = newAV();
			for (SSize_t i = 0; i <= av_len(headers_av); i++) {
				SV **h_ptr = av_fetch(headers_av, i, 0);
				if (!h_ptr || !*h_ptr) continue;
				SV *h_sv = *h_ptr;
				if (!sv_eq(h_sv, row_names_sv)) {
					av_push(filtered_headers, newSVsv(h_sv));
				}
			}
			SvREFCNT_dec(headers_av);
			headers_av = filtered_headers;
		}
		size_t num_headers = (size_t)(av_len(headers_av) + 1);
		const char **header_row = safemalloc((num_headers + 1) * sizeof(char*));
		size_t h_idx = 0;
		if (inc_rownames) header_row[h_idx++] = "";
		for (size_t i = 0; i < num_headers; i++) {
			SV **h_ptr = av_fetch(headers_av, (SSize_t)i, 0);
			header_row[h_idx++] = (h_ptr && SvOK(*h_ptr)) ? SvPV_nolen(*h_ptr) : "";
		}
		print_string_row(aTHX_ fh, header_row, h_idx, sep, collect_av);
		safefree(header_row);
		const char **row_data = safemalloc((num_headers + 1) * sizeof(char*));
		char rn_buf[32];
		for (size_t i = 0; i < num_rows; i++) {
			size_t d_idx = 0;
			SV **row_ptr = av_fetch(data_av, (SSize_t)i, 0);
			HV *row_hv = (row_ptr && SvROK(*row_ptr)) ? (HV*)SvRV(*row_ptr) : NULL;
			if (inc_rownames) {
				if (rownames_col) {
					HE *rn_he = row_hv ? hv_fetch_ent(row_hv, row_names_sv, 0, 0) : NULL;
					SV *rn_sv = rn_he ? HeVAL(rn_he) : NULL;
					if (rn_sv && SvOK(rn_sv)) {
						if (SvROK(rn_sv)) {
							if (fh) PerlIO_close(fh);
							safefree(row_data);
							if (headers_av) SvREFCNT_dec(headers_av);
							croak("write_table: Cannot write nested reference types to table\n");
						}
						row_data[d_idx++] = SvPV_nolen(rn_sv);
					} else {
						row_data[d_idx++] = undef_val;
					}
				} else {
					snprintf(rn_buf, sizeof(rn_buf), "%lu", (unsigned long)(i + 1));
					row_data[d_idx++] = rn_buf;
				}
			}
			for (size_t j = 0; j < num_headers; j++) {
				SV **h_ptr = av_fetch(headers_av, (SSize_t)j, 0);
				SV *h_sv = (h_ptr && SvOK(*h_ptr)) ? *h_ptr : NULL;
				HE *cell_he = (row_hv && h_sv) ? hv_fetch_ent(row_hv, h_sv, 0, 0) : NULL;
				SV *cell_sv = cell_he ? HeVAL(cell_he) : NULL;
				if (cell_sv && SvOK(cell_sv)) {
					if (SvROK(cell_sv)) {
						if (fh) PerlIO_close(fh);
						safefree(row_data);
						if (headers_av) SvREFCNT_dec(headers_av);
						croak("write_table: Cannot write nested reference types to table\n");
					}
					row_data[d_idx++] = SvPV_nolen(cell_sv);
				} else {
					row_data[d_idx++] = undef_val;
				}
			}
			print_string_row(aTHX_ fh, row_data, d_idx, sep, collect_av);
		}
		safefree(row_data);
	} else if (is_aoa) {// ----- Array of Arrays 
		AV *data_av = (AV*)data_ref;
		SSize_t last = av_len(data_av);   // index of last element
		SSize_t data_start = 0;            // first data-row index
/* Headers: explicit col.names, else the first inner array (which is
  then consumed as the header rather than emitted as data).*/
		if (col_names_sv && SvOK(col_names_sv)) {
			AV *c_av = (AV*)SvRV(col_names_sv);
			for (SSize_t i = 0; i <= av_len(c_av); i++) {
				SV **c = av_fetch(c_av, i, 0);
				if (c && SvOK(*c)) av_push(headers_av, newSVsv(*c));
			}
		} else {
			SV **h0 = av_fetch(data_av, 0, 0);
			AV *h_av = (h0 && *h0 && SvROK(*h0)) ? (AV*)SvRV(*h0) : NULL;
			if (h_av) {
				for (SSize_t i = 0; i <= av_len(h_av); i++) {
					SV **c = av_fetch(h_av, i, 0);
					av_push(headers_av, (c && *c && SvOK(*c)) ? newSVsv(*c) : newSVpvs(""));
				}
			}
			data_start = 1;
		}
		size_t num_headers = (size_t)(av_len(headers_av) + 1);
		const char **header_row = safemalloc((num_headers + 1) * sizeof(char*));
		size_t h_idx = 0;
		if (inc_rownames) header_row[h_idx++] = "";
		for (size_t i = 0; i < num_headers; i++) {
			SV **h_ptr = av_fetch(headers_av, (SSize_t)i, 0);
			header_row[h_idx++] = (h_ptr && *h_ptr && SvOK(*h_ptr)) ? SvPV_nolen(*h_ptr) : "";
		}
		print_string_row(aTHX_ fh, header_row, h_idx, sep, collect_av);
		safefree(header_row);
		const char **row_data = safemalloc((num_headers + 1) * sizeof(char*));
		char rn_buf[32]; // numeric row labels, printed before reuse (see HoA)
		unsigned long rn = 0;
		for (SSize_t r = data_start; r <= last; r++) {
			size_t d_idx = 0;
			if (inc_rownames) {
				snprintf(rn_buf, sizeof(rn_buf), "%lu", ++rn);
				row_data[d_idx++] = rn_buf;
			}
			SV **row_ptr = av_fetch(data_av, r, 0);
			AV *row_av = (row_ptr && *row_ptr && SvROK(*row_ptr)) ? (AV*)SvRV(*row_ptr) : NULL;
			for (size_t j = 0; j < num_headers; j++) {
				SV **cell_ptr = row_av ? av_fetch(row_av, (SSize_t)j, 0) : NULL;
				if (cell_ptr && *cell_ptr && SvOK(*cell_ptr)) {
					if (SvROK(*cell_ptr)) {
						if (fh) PerlIO_close(fh);
						safefree(row_data);
						if (headers_av) SvREFCNT_dec(headers_av);
						croak("write_table: Cannot write nested reference types to table\n");
					}
					row_data[d_idx++] = SvPV_nolen(*cell_ptr);
				} else {
					row_data[d_idx++] = undef_val;
				}
			}
			print_string_row(aTHX_ fh, row_data, d_idx, sep, collect_av);
		}
		safefree(row_data);
	}
	if (headers_av) SvREFCNT_dec(headers_av);
	if (rows_av) SvREFCNT_dec(rows_av);
	if (fh) PerlIO_close(fh);
/* Delimited output is already on disk by the time the handle closes, so this
  is where csv/tsv announces itself. Guarded on 'fh' rather than on '!collect'
  so the line is printed only when a file was actually opened and written.*/
	if (fh) write_table_announce(aTHX_ file);
/* LaTeX output: render the collected table to the main file now that the
  rows are gathered. With 'tex' on nothing was written above, so this is
  the only writer of 'file'.*/
	if (tex && collect_av && av_len(collect_av) >= 0) {
		write_tex_tabular(aTHX_ collect_av, file, tex_align,
			tex_bold1, tex_format, tex_size, tex_comment, tex_longtable,
			tex_longtable_head);
		write_table_announce(aTHX_ file);
	}
/* .xlsx output: build the workbook from the collected rows. The provenance
  line goes into the workbook's document "comments" property (dc:description),
  with any user-supplied xlsx.comment line(s) appended after it.*/
	if (xlsx && collect_av && av_len(collect_av) >= 0) {
		SV *prov = xlsx_written_by(aTHX);
		if (xlsx_comment && SvOK(xlsx_comment)) {
			if (SvROK(xlsx_comment) && SvTYPE(SvRV(xlsx_comment)) == SVt_PVAV) {
				AV *ca = (AV*)SvRV(xlsx_comment);
				for (SSize_t i = 0; i <= av_len(ca); i++) {
					SV **c = av_fetch(ca, i, 0);
					if (c && *c && SvOK(*c)) { SV_CATLIT(prov, "\n"); sv_catsv(prov, *c); }
				}
			} else if (!SvROK(xlsx_comment)) {
				SV_CATLIT(prov, "\n"); sv_catsv(prov, xlsx_comment);
			}
		}
		write_xlsx_workbook(aTHX_ collect_av, file, xlsx_sheet, prov,
			(unsigned)xlsx_freeze_rows, (unsigned)xlsx_freeze_cols);
		write_table_announce(aTHX_ file);
	}
	XSRETURN_EMPTY;
}

SV* _parse_csv_file(char* file, const char* sep_str, const char* comment_str, SV* callback = &PL_sv_undef)
PREINIT:
	PerlIO *fp;
	AV *data = NULL;
	AV *current_row = NULL;
	SV *field = NULL;
	SV *line_sv = NULL;
	bool in_quotes = 0, post_quote = 0, use_cb = 0;
	size_t sep_len, comment_len;
	char sep0 = 0;
CODE:
	if (SvOK(callback)) {
		if (SvROK(callback) && SvTYPE(SvRV(callback)) == SVt_PVCV)
			use_cb = 1;
		else
			croak("_parse_csv_file: callback must be a CODE reference");
	}
	sep_len = sep_str ? strlen(sep_str) : 0;
	comment_len = comment_str ? strlen(comment_str) : 0;
	sep0 = sep_len ? sep_str[0] : 0;
	fp = PerlIO_open(file, "r");
	if (!fp)
		croak("Could not open file '%s'", file);
	ENTER;
	SAVEDESTRUCTOR_X(S_pclose, fp);
	line_sv = newSV(128);
	SAVEFREESV(line_sv);
	field = newSVpvs("");
	SAVEFREESV(field);
	if (!use_cb)
		data = newAV();
	current_row = newAV();
	while (sv_gets(line_sv, fp, 0) != NULL) {
		char *line = SvPVX(line_sv);
		size_t len = SvCUR(line_sv);
		if (len && line[len-1] == '\n') {
			len--;
			if (len && line[len-1] == '\r')
				len--;
		}
		if (!in_quotes) {
			size_t k = 0;
			while (k < len && (line[k] == ' ' || line[k] == '\t'))
				k++;
			if (k == len)
				continue;
/*A line is a comment only when the marker is followed by whitespace
 or end-of-line: "# prose" and a bare "#" are skipped, but "#id,val"
 (marker hugging content) is treated as content so a "#"-prefixed
 header survives to read_table for stripping.*/
			if (comment_len && len >= comment_len
					&& memcmp(line, comment_str, comment_len) == 0
					&& (len == comment_len
						|| line[comment_len] == 0x20 || line[comment_len] == 0x09))
				continue;
		}
		{
		size_t i = 0;
		while (i < len) {
			if (in_quotes) {
				const char *q = (const char *)memchr(line + i, '"', len - i);
				if (!q) {
					sv_catpvn(field, line + i, len - i);
					i = len;
					break;
				}
				{
					size_t run = (size_t)(q - (line + i));
					if (run)
						sv_catpvn(field, line + i, run);
					i += run;
				}
				if (i + 1 < len && line[i+1] == '"') {
					sv_catpvn(field, "\"", 1);
					i += 2;
				} else {
					in_quotes = 0;
					post_quote = 1;
					i += 1;
				}
			} else {
				size_t start = i;
				while (i < len) {
					const char c = line[i];
					if (c == '"' || c == '\r')
						break;
					if (c == sep0 && sep_len && (len - i) >= sep_len
							&& (sep_len == 1
								|| memcmp(line + i, sep_str, sep_len) == 0))
						break;
					i++;
				}
				if (i > start)
					sv_catpvn(field, line + start, i - start);
				if (i >= len)
					break;
				{
					const char c = line[i];
					if (c == '"') {
						if (!post_quote)
							in_quotes = 1;
						i++;
					} else if (c == '\r') {
						i++;
					} else {
						av_push(current_row, newSVsv(field));
						sv_setpvs(field, "");
						post_quote = 0;
						i += sep_len;
					}
				}
			}
		}
		}
		if (in_quotes) {
			sv_catpvn(field, "\n", 1);
		} else {
			post_quote = 0;
			S_emit_row(aTHX_ &current_row, field, use_cb, callback, data);
		}
	}
	if (in_quotes) {
		S_emit_row(aTHX_ &current_row, field, use_cb, callback, data);
	}
	SvREFCNT_dec((SV*)current_row);
	LEAVE;
	if (use_cb) {
		RETVAL = newSV(0);
	} else {
		RETVAL = newRV_noinc((SV*)data);
	}
OUTPUT:
	RETVAL

SV* cov(SV* x_sv, SV* y_sv, const char* method = "pearson")
	CODE:
	{
	// 1. Validate inputs are Array References
		if (!SvROK(x_sv) || SvTYPE(SvRV(x_sv)) != SVt_PVAV) {
			croak("cov: first argument 'x' must be an ARRAY reference");
		}
		if (!SvROK(y_sv) || SvTYPE(SvRV(y_sv)) != SVt_PVAV) {
			croak("cov: second argument 'y' must be an ARRAY reference");
		}
	/*2. Validate the method argument, and resolve it to a number here rather
	than re-running strcmp() at each branch below.*/
		short int meth;		// 0 = pearson, 1 = spearman, 2 = kendall
		if      (strEQ(method, "pearson"))  meth = 0;
		else if (strEQ(method, "spearman")) meth = 1;
		else if (strEQ(method, "kendall"))  meth = 2;
		else croak("cov: unknown method '%s' (use 'pearson', 'spearman', or 'kendall')", method);
		AV *x_av = (AV*)SvRV(x_sv);
		AV *y_av = (AV*)SvRV(y_sv);
		size_t nx = av_len(x_av) + 1, ny = av_len(y_av) + 1;
		if (nx != ny) {
			croak("cov: incompatible dimensions (x has %" UVuf ", y has %" UVuf ")",
				   (UV)nx, (UV)ny);
		}
	// 3. Extract Valid Pairwise Data Allocate temporary C arrays for numeric processing
		NV *x_val, *y_val;
		Newx(x_val, nx, NV);
		Newx(y_val, nx, NV);
		size_t n = 0;

		/* Extract numeric values, defaulting to NaN for missing/invalid data,
		then compact to the pairwise complete observations (skips NAs
		seamlessly like R).  The compaction reads and writes the same buffers,
		which is safe because it never runs ahead of itself: n <= i always. */
		av_extract_or_nan(aTHX_ x_av, (SSize_t)nx, x_val);
		av_extract_or_nan(aTHX_ y_av, (SSize_t)nx, y_val);
		for (size_t i = 0; i < nx; i++) {
			if (!nv_isnan(x_val[i]) && !nv_isnan(y_val[i])) {
				 x_val[n] = x_val[i];
				 y_val[n] = y_val[i];
				 n++;
			}
		}
		// 4. Handle edge cases where data is too sparse
		if (n < 2) {
			Safefree(x_val);	Safefree(y_val);
			RETVAL = newSVnv(NV_NAN);
		} else {
			NV ans = 0.0;
			// 5. Algorithm routing
			if (meth == 2) {
				// R's default cov(..., method="kendall") iterates the full n x n space
				for (size_t i = 0; i < n; i++) {
				  for (size_t j = 0; j < n; j++) {
						int sx = (x_val[i] > x_val[j]) - (x_val[i] < x_val[j]);
						int sy = (y_val[i] > y_val[j]) - (y_val[i] < y_val[j]);
						ans += (NV)(sx * sy);
				  }
				}
			} else {
				// Unbiased sample covariance (N - 1) for Pearson & Spearman
				if (meth == 1) {
				  // Spearman: Rank the data first, then run standard covariance
				  NV *rx, *ry;
				  Newx(rx, n, NV);
				  Newx(ry, n, NV);
				  rank_data(x_val, rx, n);
				  rank_data(y_val, ry, n);
				  ans = nv_cov2(rx, ry, n);
				  Safefree(rx); Safefree(ry);
				} else {
				  ans = nv_cov2(x_val, y_val, n);
				}
			}
			Safefree(x_val); Safefree(y_val);
			RETVAL = newSVnv(ans);
		}
	}
	OUTPUT:
		RETVAL

SV *predict(...)
	CODE:
	{
		SV   *model_sv   = NULL;
		SV   *newdata_sv  = NULL;
		const char *type  = "response";
		HV   *model = NULL, *coef_hv = NULL, *xlevels_hv = NULL;
		HV   *dummy_hv = NULL;
		SV  **svp = NULL;
		bool  is_binomial = FALSE, want_response = TRUE;
		HV   *data_hoa = NULL;
		HV  **row_hashes = NULL;
		char **row_names = NULL;
		const char **fbase = NULL; //factor base column names (borrowed)
		AV  **flev = NULL;         //factor level lists      (borrowed)
		size_t nbase = 0, scratch_cap = 16,  n = 0, ncoef = 0, i, j, kk;
		char  *scratch = NULL;     //buffer for "base"."level"
		const char **cterm = NULL; //non-dummy, non-factor-interaction coef terms (borrowed)
		NV   *cbeta = NULL;
		SV   *ref = NULL;
		HV   *out_hv = NULL;
		HE   *he = NULL;

		//factor-bearing interaction terms, parsed into components
		char  **icopy   = NULL;       //writable "GroupB:Sexmale" copies (split in place)
		NV     *ibeta   = NULL;       //their betas
		size_t  nint = 0;
		bool        *cf_isfac = NULL; //per flat component: is it a factor dummy?
		int         *cf_base  = NULL; //component's factor base index (into fbase/flev)
		const char **cf_lvl   = NULL; //component's level string (borrowed into icopy)
		const char **cf_term  = NULL; //component's continuous term string (borrowed into icopy)
		size_t      *ic_off   = NULL; //per interaction: offset into flat component arrays
		size_t      *ic_cnt   = NULL; //per interaction: component count
		char       **raw_lv   = NULL; //per-row raw level string per factor base

		if (items < 1)
			croak("Usage: predict($model, $newdata, type => 'response')");
		model_sv = ST(0);
		if (items >= 2) newdata_sv = ST(1);
		if (items > 2) {
			if ((items - 2) % 2 != 0)
				croak("predict: options after newdata must be name => value pairs");
			for (unsigned short a = 2; a < items; a += 2) {
				const char *key = SvPV_nolen(ST(a));
				if (strEQ(key, "type")) type = SvPV_nolen(ST(a + 1));
				else croak("predict: unknown argument '%s'", key);
			}
		}
		if (strNE(type, "response") && strNE(type, "link"))
			croak("predict: type must be 'response' or 'link'");
		want_response = strEQ(type, "response");

		if (!SvROK(model_sv) || SvTYPE(SvRV(model_sv)) != SVt_PVHV)
			croak("predict: model must be a fitted lm/glm hashref");
		model = (HV*)SvRV(model_sv);

		svp = hv_fetch(model, "family", 6, 0);
		if (svp && *svp && SvOK(*svp))
			is_binomial = (strcmp(SvPV_nolen(*svp), "binomial") == 0);

		if (!newdata_sv || !SvOK(newdata_sv)) {
			//no newdata -> hand back the stored fitted values unchanged
			svp = hv_fetch(model, "fitted.values", 13, 0);
			if (!svp || !*svp || !SvROK(*svp))
				croak("predict: no newdata given and model has no 'fitted.values'");
			RETVAL = newRV_inc(SvRV(*svp));
		} else {
			if (!SvROK(newdata_sv))
				croak("predict: newdata must be a HoA/HoH/AoH or a flat hashref");

			svp = hv_fetch(model, "coefficients", 12, 0);
			if (!svp || !*svp || !SvROK(*svp) || SvTYPE(SvRV(*svp)) != SVt_PVHV)
				croak("predict: model has no 'coefficients' hashref");
			coef_hv = (HV*)SvRV(*svp);

			svp = hv_fetch(model, "xlevels", 7, 0);
			if (svp && *svp && SvROK(*svp) && SvTYPE(SvRV(*svp)) == SVt_PVHV)
				xlevels_hv = (HV*)SvRV(*svp);

			ENTER; SAVETMPS;

			// resolve newdata: HoA / HoH / AoH / flat single-row hash
			ref = SvRV(newdata_sv);
			if (SvTYPE(ref) == SVt_PVHV) {
				HV *hv = (HV*)ref;
				HE *e;
				SV *v0;
				if (hv_iterinit(hv) == 0)
					croak("predict: newdata hash is empty");
				e  = hv_iternext(hv);
				v0 = HeVAL(e);
				if (SvROK(v0) && SvTYPE(SvRV(v0)) == SVt_PVAV) { //HoA
					static const char *const rn_keys[] =
						{ "row.names", "_row", "rownames", ".rownames" };
					AV *rn_av = NULL;
					data_hoa = hv;
					n = (size_t)(av_len((AV*)SvRV(v0)) + 1);
					Newx(row_names, n ? n : 1, char*); SAVEFREEPV(row_names);
					for (kk = 0; kk < sizeof rn_keys / sizeof rn_keys[0]; kk++) {
						SV **rn = hv_fetch(hv, rn_keys[kk], (I32)strlen(rn_keys[kk]), 0);
						if (rn && *rn && SvROK(*rn) && SvTYPE(SvRV(*rn)) == SVt_PVAV) {
							rn_av = (AV*)SvRV(*rn); break;
						}
					}
					for (i = 0; i < n; i++) {
						SV **nm = rn_av ? av_fetch(rn_av, (SSize_t)i, 0) : NULL;
						if (nm && *nm && SvOK(*nm)) {
							STRLEN l; const char *s = SvPV(*nm, l);
							row_names[i] = savepvn(s, l);
						} else {
							char buf[32];
							snprintf(buf, sizeof(buf), "%lu", (unsigned long)(i + 1));
							row_names[i] = savepv(buf);
						}
						SAVEFREEPV(row_names[i]);
					}
				} else if (SvROK(v0) && SvTYPE(SvRV(v0)) == SVt_PVHV) { //HoH
					n = (size_t)HvUSEDKEYS(hv);
					Newx(row_names,  n ? n : 1, char*); SAVEFREEPV(row_names);
					Newx(row_hashes, n ? n : 1, HV*);   SAVEFREEPV(row_hashes);
					hv_iterinit(hv);
					i = 0;
					while ((e = hv_iternext(hv))) {
						I32 klen;
						row_names[i]  = savepv(hv_iterkey(e, &klen)); SAVEFREEPV(row_names[i]);
						row_hashes[i] = (HV*)SvRV(HeVAL(e));
						i++;
					}
				} else { //flat single row
					n = 1;
					Newx(row_names,  1, char*); SAVEFREEPV(row_names);
					Newx(row_hashes, 1, HV*);   SAVEFREEPV(row_hashes);
					row_names[0]  = savepv("1"); SAVEFREEPV(row_names[0]);
					row_hashes[0] = hv;
				}
			} else if (SvTYPE(ref) == SVt_PVAV) { //AoH
				static const char *const rn_keys[] =
					{ "row.names", "_row", "rownames", ".rownames" };
				AV *av = (AV*)ref;
				n = (size_t)(av_len(av) + 1);
				Newx(row_names,  n ? n : 1, char*); SAVEFREEPV(row_names);
				Newx(row_hashes, n ? n : 1, HV*);   SAVEFREEPV(row_hashes);
				for (i = 0; i < n; i++) {
					SV **vp = av_fetch(av, (SSize_t)i, 0);
					HV  *rh;
					SV **nm = NULL;
					if (!vp || !SvROK(*vp) || SvTYPE(SvRV(*vp)) != SVt_PVHV)
						croak("predict: AoH values must be hashrefs");
					rh = (HV*)SvRV(*vp);
					row_hashes[i] = rh;
					for (kk = 0; kk < sizeof rn_keys / sizeof rn_keys[0]; kk++) {
						nm = hv_fetch(rh, rn_keys[kk], (I32)strlen(rn_keys[kk]), 0);
						if (nm && *nm && SvOK(*nm)) break;
						nm = NULL;
					}
					if (nm && *nm && SvOK(*nm)) {
						STRLEN l; const char *s = SvPV(*nm, l);
						row_names[i] = savepvn(s, l);
					} else {
						char buf[32];
						snprintf(buf, sizeof(buf), "%lu", (unsigned long)(i + 1));
						row_names[i] = savepv(buf);
					}
					SAVEFREEPV(row_names[i]);
				}
			} else {
				croak("predict: newdata must be a HoA/HoH/AoH or a flat hashref");
			}
			// factor bases from xlevels, plus the dummy-name set
			if (xlevels_hv && HvUSEDKEYS(xlevels_hv) > 0) {
				nbase = (size_t)HvUSEDKEYS(xlevels_hv);
				Newx(fbase, nbase, const char*); SAVEFREEPV(fbase);
				Newx(flev,  nbase, AV*);         SAVEFREEPV(flev);
				dummy_hv = newHV(); SAVEFREESV((SV*)dummy_hv);
				hv_iterinit(xlevels_hv);
				kk = 0;
				while ((he = hv_iternext(xlevels_hv))) {
					I32 blen;
					SV *lv = HeVAL(he);
					if (!SvROK(lv) || SvTYPE(SvRV(lv)) != SVt_PVAV) continue;
					fbase[kk] = hv_iterkey(he, &blen);          //borrowed
					flev[kk]  = (AV*)SvRV(lv);
					{
						size_t blen2 = strlen(fbase[kk]);
						SSize_t nl = av_len(flev[kk]) + 1, l1;
						/*Every level, not just levels[1..]. A factor coded in
						full -- one in a model with no intercept, or one whose
						margin is absent -- also has a column for its first
						level, and without it registered here that column
						would be mistaken for a continuous term and looked up
						as a data column. A reduced-coded model simply never
						names the extra entry.*/
						for (l1 = 0; l1 < nl; l1++) {
							SV **ls = av_fetch(flev[kk], l1, 0);
							if (ls && *ls && SvOK(*ls)) {
								STRLEN ll; const char *lp = SvPV(*ls, ll);
								if (blen2 + ll + 1 > scratch_cap) scratch_cap = blen2 + ll + 1;
								char *dn = (char*)safemalloc(blen2 + ll + 1);
								memcpy(dn, fbase[kk], blen2);
								memcpy(dn + blen2, lp, ll);
								dn[blen2 + ll] = '\0';
								/*CHANGED: store the base index so interaction parsing can
								recover (base, level) from a dummy name in O(1)*/
								hv_store(dummy_hv, dn, (I32)(blen2 + ll), newSViv((IV)kk), 0);
								Safefree(dn);
							}
						}
					}
					kk++;
				}
				nbase = kk;
				Newx(scratch, scratch_cap, char); SAVEFREEPV(scratch);
			}
			// cache coef terms; route factor-bearing interactions aside
			{
				I32 nk = (I32)HvUSEDKEYS(coef_hv);
				Newx(cterm, nk ? nk : 1, const char*); SAVEFREEPV(cterm);
				Newx(cbeta, nk ? nk : 1, NV);          SAVEFREEPV(cbeta);
				Newx(icopy, nk ? nk : 1, char*);       SAVEFREEPV(icopy);   //NEW
				Newx(ibeta, nk ? nk : 1, NV);          SAVEFREEPV(ibeta);   //NEW
				hv_iterinit(coef_hv);
				ncoef = 0;
				while ((he = hv_iternext(coef_hv))) {
					I32 klen;
					const char *t = hv_iterkey(he, &klen);
					NV b = SvNV(HeVAL(he));
					if (nv_isnan(b)) continue;                         //aliased -> drop
					if (dummy_hv && hv_exists(dummy_hv, t, klen)) continue;  //main-effect factor

					/*an interaction with >=1 factor component needs special handling;
					pure-continuous interactions (e.g. x:z) stay on the evaluate_term path*/
					if (strchr(t, ':')) {
						char tbuf[512];
						snprintf(tbuf, sizeof(tbuf), "%s", t);
						bool has_factor = FALSE;
						char *restrict cp = tbuf;
						while (cp) {
							char *cl = strchr(cp, ':');
							if (cl) *cl = '\0';
							if (dummy_hv && hv_exists(dummy_hv, cp, (I32)strlen(cp)))
								has_factor = TRUE;
							cp = cl ? cl + 1 : NULL;
						}
						if (has_factor) {
							icopy[nint] = savepv(t); SAVEFREEPV(icopy[nint]);
							ibeta[nint] = b;
							nint++;
							continue;
						}
					}
					cterm[ncoef] = t;     //continuous term or pure-continuous interaction
					cbeta[ncoef] = b;
					ncoef++;
				}
			}
	// parse factor-bearing interactions into flat components
			{
				size_t total_comp = 0, k, pos = 0;
				for (k = 0; k < nint; k++) {
					const char *restrict s = icopy[k];
					total_comp++;
					for (; *s; s++) if (*s == ':') total_comp++;
				}
				Newx(cf_isfac, total_comp ? total_comp : 1, bool);        SAVEFREEPV(cf_isfac);
				Newx(cf_base,  total_comp ? total_comp : 1, int);         SAVEFREEPV(cf_base);
				Newx(cf_lvl,   total_comp ? total_comp : 1, const char*); SAVEFREEPV(cf_lvl);
				Newx(cf_term,  total_comp ? total_comp : 1, const char*); SAVEFREEPV(cf_term);
				Newx(ic_off,   nint ? nint : 1, size_t);                  SAVEFREEPV(ic_off);
				Newx(ic_cnt,   nint ? nint : 1, size_t);                  SAVEFREEPV(ic_cnt);
				for (k = 0; k < nint; k++) {
					char *comp = icopy[k];   //split in place on ':'
					ic_off[k] = pos;
					while (comp) {
						char *colon = strchr(comp, ':');
						if (colon) *colon = '\0';
						SV **dv = dummy_hv ? hv_fetch(dummy_hv, comp, (I32)strlen(comp), 0) : NULL;
						if (dv && *dv && SvOK(*dv)) {
							int bidx = (int)SvIV(*dv);
							cf_isfac[pos] = TRUE;
							cf_base[pos]  = bidx;
							cf_lvl[pos]   = comp + strlen(fbase[bidx]);  //level part of base.level
							cf_term[pos]  = NULL;
						} else {
							cf_isfac[pos] = FALSE;
							cf_base[pos]  = -1;
							cf_lvl[pos]   = NULL;
							cf_term[pos]  = comp;
							//validate a simple continuous component up front (parity with main terms)
							if (strNE(comp, "Intercept") && strncmp(comp, "I(", 2) != 0) {
								bool okc = data_hoa
									? (hv_exists(data_hoa, comp, (I32)strlen(comp)) ? TRUE : FALSE)
									: (n > 0 ? (hv_exists(row_hashes[0], comp, (I32)strlen(comp)) ? TRUE : FALSE) : TRUE);
								if (!okc)
									croak("predict: newdata is missing column '%s' (in interaction)", comp);
							}
						}
						pos++;
						comp = colon ? colon + 1 : NULL;
					}
					ic_cnt[k] = pos - ic_off[k];
				}
			}

			// validate required columns are present (clean die, not NaN)
			for (kk = 0; kk < nbase; kk++) {
				const char *b = fbase[kk];
				bool ok = data_hoa ? (hv_exists(data_hoa, b, (I32)strlen(b)) ? TRUE : FALSE)
				        : (n > 0 ? (hv_exists(row_hashes[0], b, (I32)strlen(b)) ? TRUE : FALSE) : TRUE);
				if (!ok) croak("predict: newdata is missing factor column '%s'", b);
			}
			for (j = 0; j < ncoef; j++) {
				const char *t = cterm[j];
				if (strEQ(t, "Intercept")) continue;
				if (strchr(t, ':') || strncmp(t, "I(", 2) == 0) continue;  //interaction/transform
				bool ok = data_hoa ? (hv_exists(data_hoa, t, (I32)strlen(t)) ? TRUE : FALSE)
				        : (n > 0 ? (hv_exists(row_hashes[0], t, (I32)strlen(t)) ? TRUE : FALSE) : TRUE);
				if (!ok) croak("predict: newdata is missing column '%s'", t);
			}
			//per-row raw level scratch
			if (nbase) { Newx(raw_lv, nbase, char*); SAVEFREEPV(raw_lv); }
			// per row: linear predictor, then inverse link
			out_hv = newHV(); SAVEFREESV((SV*)out_hv); //freed on croak; ref taken before LEAVE on success
			for (i = 0; i < n; i++) {
				NV   eta = 0.0, pred;
				bool ok  = 1;
				for (kk = 0; kk < nbase; kk++) raw_lv[kk] = NULL;
				//read each factor's raw level once; reused by main effects + interactions
				for (kk = 0; ok && kk < nbase; kk++) {
					char *raw = get_data_string_alloc(aTHX_ data_hoa, row_hashes, (unsigned int)i, fbase[kk]);
					SSize_t nl, l1, found = -1;
					if (!raw) { ok = FALSE; break; }             //missing value -> NaN row
					nl = av_len(flev[kk]) + 1;
					for (l1 = 0; l1 < nl; l1++) {
						SV **ls = av_fetch(flev[kk], l1, 0);
						if (ls && *ls && SvOK(*ls) && strcmp(SvPV_nolen(*ls), raw) == 0) { found = l1; break; }
					}
					if (found < 0) {
						char base_cpy[256], lvl_cpy[256];
						size_t z;
						snprintf(base_cpy, sizeof(base_cpy), "%s", fbase[kk]);
						snprintf(lvl_cpy,  sizeof(lvl_cpy),  "%s", raw);
						Safefree(raw);
						for (z = 0; z < kk; z++) if (raw_lv[z]) Safefree(raw_lv[z]);
						croak("predict: factor '%s' has unseen level '%s'", base_cpy, lvl_cpy);
					}
					raw_lv[kk] = raw;                            //keep; freed at row end
	/*Look the level's dummy up whatever its position. A factor
	coded by contrasts has no coefficient for its reference
	level, so the fetch simply misses and contributes nothing;
	one coded in full does have that column, and skipping it
	on the strength of found == 0 would score every reference
	row as if the term were absent.*/
					snprintf(scratch, scratch_cap, "%s%s", fbase[kk], raw);
					svp = hv_fetch(coef_hv, scratch, (I32)strlen(scratch), 0);
					if (svp && *svp) {
						NV b = SvNV(*svp);
						if (!nv_isnan(b)) eta += b;
					}
				}
				//non-factor terms via the same engine used at fit time
				for (j = 0; ok && j < ncoef; j++) {
					NV v;
					if (strEQ(cterm[j], "Intercept")) v = 1.0;
					else v = evaluate_term(aTHX_ data_hoa, row_hashes, (unsigned int)i, cterm[j]);
					if (nv_isnan(v)) { ok = FALSE; break; }
					eta += cbeta[j] * v;
				}
				//factor-bearing interactions — product of component values
				for (size_t k = 0; ok && k < nint; k++) {
					NV prod = 1.0;
					size_t off = ic_off[k], cnt = ic_cnt[k], m;
					for (m = off; m < off + cnt; m++) {
						if (cf_isfac[m]) {
							int bidx = cf_base[m];
							//indicator: 1 iff this row's level for that base equals the dummy's level
							prod *= (raw_lv[bidx] && strcmp(raw_lv[bidx], cf_lvl[m]) == 0) ? 1.0 : 0.0;
						} else {
							NV v = evaluate_term(aTHX_ data_hoa, row_hashes, (unsigned int)i, cf_term[m]);
							if (nv_isnan(v)) { ok = FALSE; break; }
							prod *= v;
						}
					}
					if (!ok) break;
					eta += ibeta[k] * prod;
				}
				for (kk = 0; kk < nbase; kk++)
					if (raw_lv[kk]) { Safefree(raw_lv[kk]); raw_lv[kk] = NULL; }

				pred = (!ok) ? NAN
				     : (is_binomial && want_response) ? (1.0 / (1.0 + nv_exp(-eta)))
				     : eta;
				hv_store(out_hv, row_names[i], (I32)strlen(row_names[i]), newSVnv(pred), 0);
			}

			RETVAL = newRV_inc((SV*)out_hv);   //+1 -> survives the SAVEFREESV decrement at LEAVE
			FREETMPS; LEAVE;
		}
	}
	OUTPUT:
		RETVAL

SV *glm(...)
	CODE:
	{
	const char *formula  = NULL;
	SV *data_sv = NULL;
	const char *family_str = "gaussian";
	char *f_cpy = NULL;
	char *lhs = NULL, *rhs = NULL;

	char **terms = NULL, **uniq_terms = NULL;
	LmDesign *design = NULL;
	unsigned int num_terms = 0, num_uniq = 0, p = 0;
	size_t n = 0, valid_n = 0, i;
	bool has_intercept = TRUE, converged = FALSE, boundary = FALSE;
	unsigned int iter = 0, max_iter = 25, final_rank = 0, df_res = 0;
	NV deviance_old = 0.0, deviance_new = 0.0, null_dev = 0.0, aic = 0.0;
	NV dispersion = 0.0, epsilon = 1e-8;
	NV theta = 0.0, conf_level = NV_CONF_95;
	bool theta_given = FALSE;

	char **row_names = NULL;
	char **valid_row_names = NULL;
	HV **row_hashes = NULL;
	HV *data_hoa = NULL;

	NV *X = NULL, *Y = NULL, *mu = NULL, *eta = NULL;
	NV *W = NULL, *Z = NULL, *beta = NULL, *beta_old = NULL;
	bool *aliased = NULL;
	NV *XtWX = NULL, *XtWZ = NULL;

	HV *res_hv, *coef_hv, *fitted_hv, *resid_hv, *summary_hv;
	HV *xlevels_hv = NULL;
	AV *terms_av;

	if (items % 2 != 0) croak("Usage: glm(formula => 'am ~ wt + hp', data => \\%mtcars)");
	for (Stack_off_t i_arg = 0; i_arg < items; i_arg += 2) {
	  const char *key = SvPV_nolen(ST(i_arg));
	  SV *val = ST(i_arg + 1);
	  if      (strEQ(key, "formula")) formula = SvPV_nolen(val);
	  else if (strEQ(key, "data"))    data_sv = val;
	  else if (strEQ(key, "family"))  family_str = SvPV_nolen(val);
	  else if (strEQ(key, "theta"))   { theta = SvNV(val); theta_given = TRUE; }
	  else if (strEQ(key, "conf.level") || strEQ(key, "conf_level")) conf_level = SvNV(val);
	  else croak("glm: unknown argument '%s'", key);
	}
	if (!formula) croak("glm: formula is required");
	if (!data_sv || !SvROK(data_sv)) croak("glm: data is required and must be a reference");
	if (conf_level <= 0.0 || conf_level >= 1.0) croak("glm: conf.level must be between 0 and 1");

	bool is_binomial = (strcmp(family_str, "binomial") == 0);
	bool is_gaussian = (strcmp(family_str, "gaussian") == 0);
	bool is_poisson  = (strcmp(family_str, "poisson")  == 0);
	bool is_negbin   = (strcmp(family_str, "negbin") == 0
		|| strcmp(family_str, "negative.binomial") == 0 || strcmp(family_str, "nb") == 0);
	if (!is_binomial && !is_gaussian && !is_poisson && !is_negbin)
		croak("glm: unsupported family '%s' (gaussian, binomial, poisson, negbin)", family_str);
	bool log_link = is_poisson || is_negbin;
	if (theta_given && theta <= 0.0) croak("glm: theta must be positive");
	if (theta_given && !is_negbin)
		warn("glm: 'theta' is only used by the negbin family; ignoring");
	/*negbin without a supplied theta: seed with a large theta so the first
	IRLS pass is effectively Poisson (matching MASS::glm.nb, which seeds the
	theta ML from a Poisson fit's fitted means); theta is then re-estimated
	by ML after each pass.*/
	if (is_negbin && !theta_given) theta = 1e6;

	/*Split the formula before touching the data: a malformed one croaks with
	nothing else allocated. '.' needs the columns, so the term list has to
	wait until after the rows are read.*/
	f_cpy = lm_formula_split(aTHX_ formula, "glm", &lhs, &rhs, &has_intercept);
	n = lm_read_rows(aTHX_ data_sv, "glm", f_cpy, &data_hoa, &row_hashes, &row_names);
	lm_formula_terms(aTHX_ rhs, lhs, data_hoa, row_hashes, n, has_intercept, "glm",
	                 &terms, &num_terms, &uniq_terms, &num_uniq);
	xlevels_hv = newHV(); sv_2mortal((SV*)xlevels_hv);
	design = lm_design_build(aTHX_ data_hoa, row_hashes, n,
	                         uniq_terms, (unsigned int)num_uniq, has_intercept,
	                         xlevels_hv);
	p = design->ncol;

	Newx(X, n * (p ? p : 1), NV); Newx(Y, n, NV);
	Newx(valid_row_names, n, char*);

	for (size_t i = 0; i < n; i++) {
		NV y_val = evaluate_term(aTHX_ data_hoa, row_hashes, i, lhs);
		if (nv_isnan(y_val)) { Safefree(row_names[i]); continue; }

		if (!lm_design_row(aTHX_ design, data_hoa, row_hashes, i,
		                   X + valid_n * (size_t)p)) {
			Safefree(row_names[i]); continue;
		}
		Y[valid_n] = y_val;
		valid_row_names[valid_n] = row_names[i];
		valid_n++;
	}
	Safefree(row_names);
	if (valid_n < p) {
	  for (i = 0; i < num_terms; i++) Safefree(terms[i]); Safefree(terms);
	  for (i = 0; i < num_uniq; i++) Safefree(uniq_terms[i]); Safefree(uniq_terms);
	  lm_design_free(aTHX_ design);
	  for (i = 0; i < valid_n; i++) Safefree(valid_row_names[i]);
	  Safefree(X); Safefree(Y); Safefree(valid_row_names); if (row_hashes) Safefree(row_hashes);
	  Safefree(f_cpy);
	  croak("glm: 0 degrees of freedom (too many NAs or parameters > observations)");
	}
	//lhs was the last thing pointing into the formula copy.
	Safefree(f_cpy); f_cpy = NULL;
	mu = (NV*)safemalloc(valid_n * sizeof(NV)); eta = (NV*)safemalloc(valid_n * sizeof(NV));
	W = (NV*)safemalloc(valid_n * sizeof(NV)); Z = (NV*)safemalloc(valid_n * sizeof(NV));
	beta = (NV*)safemalloc(p * sizeof(NV)); beta_old = (NV*)safemalloc(p * sizeof(NV));
	aliased = (bool*)safemalloc(p * sizeof(bool));
	XtWX = (NV*)safemalloc(p * p * sizeof(NV)); XtWZ = (NV*)safemalloc(p * sizeof(NV));
	NV sum_y = 0.0;
	for (i = 0; i < valid_n; i++) sum_y += Y[i];
	NV mean_y = sum_y / valid_n;
	if (log_link && mean_y <= 0.0) croak("glm: poisson/negbin family requires some positive counts");

	/*Negative binomial: alternate an IRLS fit at the current theta with a fresh
	ML estimate of theta at the current fitted means, exactly as MASS::glm.nb
	does. Every other family runs the body once.
	
	Three details of glm.nb decide whether the answers agree, and all three
	are reproduced below:
	
	 - The FIRST pass is an ordinary Poisson fit, not a negative-binomial one
	   at some large stand-in theta. Its fitted means are what the first theta
	   is estimated from, and its residual degrees of freedom set d1.
	 - Each later pass is WARM STARTED from the previous pass's means
	   (glm.nb passes etastart = log(mu)), so the fit it lands on is the one
	   MASS lands on rather than merely the same optimum reached from
	   elsewhere.
	 - Inside the loop theta is re-estimated from the means that STARTED the
	   pass, not the ones the pass just produced: glm.nb calls
	   theta.ml(Y, mu) and only then reassigns mu <- fit$fitted.values. The
	   lag is easy to miss and moves theta in the eighth digit.
	
	The convergence test is MASS's as well:
	
	    (|Lm0 - Lm| / d1 + |theta - theta_prev| / d2) < epsilon
	
	with d1 = sqrt(2 * max(1, df.residual)) from the Poisson pass, d2 = 1 and
	epsilon = 1e-8. What used to be here was a relative test on the
	log-likelihood alone -- |dll| < 1e-7 * (|ll| + 0.1) -- which on an
	80-observation fit is satisfied roughly 2e-5 of log-likelihood early and
	left theta 8e-7 away from MASS's, dragging the coefficients 8e-6 with it.
	Dividing the log-likelihood move by d1 and requiring theta itself to have
	settled is what makes the alternation stop in the same place.*/
	unsigned int outer_max = (is_negbin && !theta_given) ? (max_iter + 1) : 1;
	NV  nb_d1 = 1.0, nb_Lm = 0.0, nb_Lm0 = 0.0, nb_del = 1.0;
	NV *nb_mu_prev = NULL;
	bool nb_alt_converged = FALSE;
	for (unsigned int outer = 0; outer < outer_max; outer++) {
	/*Pass 0 of a theta-estimating fit is Poisson; treat the family as Poisson
	throughout that pass rather than approximating it with a huge theta.*/
	bool nb_pois_pass = (is_negbin && !theta_given && outer == 0);
	bool use_negbin   = is_negbin && !nb_pois_pass;
	/*Passes after the first warm start where the previous one finished, and the
	means they start from are also the ones theta is re-estimated at.*/
	bool nb_warm = (is_negbin && !theta_given && outer > 0);
	if (nb_warm) {
		/*Allocated on first use rather than before the loop: the response
		validation in the cold-start block below can croak, and there is no
		reason to have an allocation outstanding when it does.*/
		if (!nb_mu_prev) nb_mu_prev = (NV*)safemalloc(valid_n * sizeof(NV));
		memcpy(nb_mu_prev, mu, valid_n * sizeof(NV));
	}
	if (nb_warm) {
		/*Keep mu, eta and beta where the last pass left them; only the
		deviance has to be restated under the new theta so that the IRLS
		convergence test starts from the right place.*/
		deviance_old = 0.0;
		for (i = 0; i < valid_n; i++)
			deviance_old += dev_negbin(Y[i], mu[i], theta);
		converged = FALSE;
	} else {
	for (i = 0; i < p; i++) { beta[i] = 0.0; beta_old[i] = 0.0; }
	deviance_old = 0.0; converged = FALSE;
	for (i = 0; i < valid_n; i++) {
		if (is_binomial) {
			if (Y[i] < 0.0 || Y[i] > 1.0) croak("glm: binomial family requires response between 0 and 1");
			mu[i] = (Y[i] + 0.5) / 2.0;
			eta[i] = nv_log(mu[i] / (1.0 - mu[i]));
			NV dev = 0.0;
			if (Y[i] == 0.0)      dev = -2.0 * nv_log(1.0 - mu[i]);
			else if (Y[i] == 1.0) dev = -2.0 * nv_log(mu[i]);
			else dev = 2.0 * (Y[i] * nv_log(Y[i] / mu[i]) + (1.0 - Y[i]) * nv_log((1.0 - Y[i]) / (1.0 - mu[i])));
			deviance_old += dev;
		} else if (log_link) {
			if (Y[i] < 0.0) croak("glm: poisson/negbin family requires a non-negative response");
	/*Each family's own mustart. R's poisson()$initialize sets y + 0.1,
	but MASS's negative.binomial()$initialize sets y + (y == 0)/6 --
	the observed count itself wherever it is positive. Starting a
	negative-binomial fit from the Poisson value instead walks a
	different sequence of iterates, and since the standard errors come
	from the penultimate one, that showed up as standard errors 6e-7
	out from R while the coefficients agreed to 1e-9. glm.nb's own
	first pass IS Poisson, so it keeps y + 0.1; its later passes are
	warm started and use no mustart at all.*/
			mu[i]  = use_negbin ? (Y[i] + (Y[i] == 0.0 ? 1.0 / 6.0 : 0.0))
			                    : (Y[i] + 0.1);
			eta[i] = nv_log(mu[i]);
			deviance_old += use_negbin ? dev_negbin(Y[i], mu[i], theta) : dev_poisson(Y[i], mu[i]);
		} else {
			mu[i] = mean_y;
			eta[i] = mu[i];
		}
	}
	}
	for (iter = 1; iter <= max_iter; iter++) {
		for (i = 0; i < valid_n; i++) {
			if (is_binomial) {
				 NV varmu = mu[i] * (1.0 - mu[i]);
				 NV mu_eta = varmu;
				 if (varmu < 1e-10) varmu = 1e-10;
				 Z[i] = eta[i] + (Y[i] - mu[i]) / mu_eta;
				 W[i] = (mu_eta * mu_eta) / varmu;
			} else if (log_link) {
				 NV mu_eta = mu[i];  //dmu/deta for the log link
				 NV varmu  = use_negbin ? (mu[i] + mu[i] * mu[i] / theta) : mu[i];
				 if (varmu < 1e-10) varmu = 1e-10;
				 Z[i] = eta[i] + (Y[i] - mu[i]) / mu_eta;
				 W[i] = (mu_eta * mu_eta) / varmu;
			} else {
				 W[i] = 1.0;
				 Z[i] = Y[i];
			}
		}
		for (i = 0; i < p; i++) { XtWZ[i] = 0.0; for (size_t j = 0; j < p; j++) XtWX[i * p + j] = 0.0; }
		for (size_t k = 0; k < valid_n; k++) {
			NV w = W[k], z = Z[k];
			for (i = 0; i < p; i++) {
				 XtWZ[i] += X[k * p + i] * w * z;
				 NV xw = X[k * p + i] * w;
				 for (size_t j = 0; j < p; j++) XtWX[i * p + j] += xw * X[k * p + j];
			}
		}
		final_rank = sweep_matrix_ols(XtWX, p, aliased);
		for (i = 0; i < p; i++) {
			if (aliased[i]) { beta[i] = NAN; } else {
				 NV sum = 0.0;
				 for (size_t j = 0; j < p; j++) if (!aliased[j]) sum += XtWX[i * p + j] * XtWZ[j];
				 beta[i] = sum;
			}
		}
		boundary = FALSE;
		for (unsigned short int half = 0; half < 10; half++) {
			deviance_new = 0.0;
			for (i = 0; i < valid_n; i++) {
				 NV linear_pred = 0.0;
				 for (size_t j = 0; j < p; j++) if (!aliased[j]) linear_pred += X[i * p + j] * beta[j];
				 eta[i] = linear_pred;
				 if (is_binomial) {
					 mu[i] = 1.0 / (1.0 + nv_exp(-eta[i]));
					 if (mu[i] < 10 * DBL_EPSILON) mu[i] = 10 * DBL_EPSILON;
					 if (mu[i] > 1.0 - 10 * DBL_EPSILON) mu[i] = 1.0 - 10 * DBL_EPSILON;
					 NV dev = 0.0;
					 if (Y[i] == 0.0)      dev = -2.0 * nv_log(1.0 - mu[i]);
					 else if (Y[i] == 1.0) dev = -2.0 * nv_log(mu[i]);
					 else dev = 2.0 * (Y[i] * nv_log(Y[i] / mu[i]) + (1.0 - Y[i]) * nv_log((1.0 - Y[i]) / (1.0 - mu[i])));
					 deviance_new += dev;
				 } else if (log_link) {
					 mu[i] = nv_exp(eta[i]);
					 if (mu[i] < 1e-10) mu[i] = 1e-10;
					 deviance_new += use_negbin ? dev_negbin(Y[i], mu[i], theta) : dev_poisson(Y[i], mu[i]);
				 } else {
					 mu[i] = eta[i];
					 NV res = Y[i] - mu[i];
					 deviance_new += res * res;
				 }
			}
			/*Halve the step only when the deviance came out non-finite, which is
			R's rule (glm.fit truncates the step "due to divergence" for a
			non-finite deviance, or when the link puts eta or mu outside its
			range -- the clamps above already prevent that here).
			
			A deviance that merely rose is NOT divergence, and treating it as
			such was costing iterations on every non-gaussian fit. The standard
			IRLS start puts mu at y + 0.1, i.e. essentially on the data, so the
			initial deviance is near zero -- 0.016 for the nine-point poisson
			fit in t/glm.t -- and the first real step necessarily raises it, to
			1.54 there. The old test read that as divergence and halved the
			step ten times over, crippling the first move and turning a
			four-iteration fit into a seven-iteration one. The extra iterations
			converged to the same coefficients, but they left the weights of
			the penultimate iterate -- the ones the standard errors are built
			from, here and in R alike -- a different distance from the MLE than
			R's, which is why poisson and binomial standard errors used to sit
			5e-8 to 2e-5 away from R's while the coefficients agreed to twelve
			digits.
			
			Note also that the old condition had the isfinite test on the
			accepting side, so a genuinely divergent step producing a NaN
			deviance was kept rather than truncated.*/
			if (is_gaussian || nv_isfinite(deviance_new)) break;
			if (half + 1 >= 10) break;   //stop halving rather than spin
			boundary = TRUE;
			for (size_t j = 0; j < p; j++) beta[j] = (beta[j] + beta_old[j]) / 2.0;
		}
		if (nv_fabs(deviance_new - deviance_old) / (0.1 + nv_fabs(deviance_new)) < epsilon) {
			converged = TRUE; break;
		}
		deviance_old = deviance_new;
		for (size_t j = 0; j < p; j++) beta_old[j] = beta[j];
	}
	if (is_negbin && !theta_given) {
		if (nb_pois_pass) {
			/*Pre-loop half of glm.nb: the Poisson fit is done, so take the first
			theta from its means, size the log-likelihood scale d1 from its
			residual degrees of freedom, and prime the test the way MASS does
			-- Lm0 = Lm + 2 * d1, which makes the first term 2 and guarantees
			at least one alternation.*/
			int pois_df = (int)valid_n - final_rank;
			nb_d1  = nv_sqrt(2.0 * (NV)(pois_df > 1 ? pois_df : 1));
			theta  = nb_theta_ml(Y, mu, valid_n, max_iter);
			nb_Lm  = nb_loglik(Y, mu, valid_n, theta);
			nb_Lm0 = nb_Lm + 2.0 * nb_d1;
			nb_del = 1.0;
		} else {
			/*One alternation. theta comes from the means this pass STARTED at,
			which is the lag glm.nb has; mu is by now the means this pass
			produced, and the log-likelihood is taken at the pair (new theta,
			new mu). d2 is 1 in MASS and never changes, so |del| enters the
			test unscaled.*/
			NV th_prev = theta;
			theta  = nb_theta_ml(Y, nb_mu_prev, valid_n, max_iter);
			nb_del = th_prev - theta;
			nb_Lm0 = nb_Lm;
			nb_Lm  = nb_loglik(Y, mu, valid_n, theta);
			if (nv_fabs(nb_Lm0 - nb_Lm) / nb_d1 + nv_fabs(nb_del) < epsilon) {
				nb_alt_converged = TRUE;
				break;
			}
			if (outer == outer_max - 1) {
				warn("glm: theta ML did not converge in %u alternations "
				     "(data may be under-dispersed / near-Poisson)", max_iter);
				converged = FALSE;
				break;
			}
		}
	}
	} //end outer theta loop

	/*The alternation exits with theta and the coefficients in step: the last
	pass fitted at the theta before it, then replaced theta with the estimate
	taken at that pass's starting means -- which is the pairing glm.nb reports,
	since it too returns the fit from before its final theta update.*/
	if (is_negbin && !theta_given) {
		if (nb_alt_converged) converged = TRUE;
		if (nb_mu_prev) { Safefree(nb_mu_prev); nb_mu_prev = NULL; }
	}
	/*XtWX already holds what the standard errors need: sweep_matrix_ols
	inverted it in place during the last IRLS iteration, and nothing since has
	written to it. Those weights come from the mu that went INTO that
	iteration, i.e. from the iterate before the final coefficient update, and
	that is deliberate -- it is the matrix R reports from.
	
	R's glm.fit keeps the QR factorisation of its last weighted design matrix
	and summary.glm forms chol2inv(qr.R) from it, so R's standard errors are
	likewise built from the weights of the penultimate iterate; its
	$weights component is that same vector, one step behind $fitted.values.
	Rebuilding X'WX here from the converged mu instead is the more defensible
	estimator -- it evaluates the Fisher information at the MLE rather than a
	step short of it -- but it is not what R prints, and for a poisson fit the
	two differ by far more than the coefficients do: on `y ~ x + z` over nine
	observations the weights are 2.1e-7 apart, moving the standard errors by
	5.4e-8 relative while the coefficients agree to twelve digits. Reusing the
	matrix the iteration already produced reproduces R to 2e-14.
	
	This is safe to rely on because the two implementations take the same path
	to get here: identical starting values (mustart of y + 0.1 for a log link,
	(y + 0.5)/2 for binomial), the same convergence test on the deviance
	(|dev - devold| / (0.1 + |dev|) < epsilon) and the same epsilon of 1e-8, so
	they stop on the same iteration and their penultimate iterates agree. For
	gaussian the weights are all 1 and the question does not arise: the matrix
	is X'X either way.
	
	final_rank and aliased[] likewise come from that same in-loop sweep.*/
	NV wtdmu = has_intercept ? mean_y : (is_binomial ? 0.5 : (log_link ? 1.0 : 0.0));

	for (i = 0; i < valid_n; i++) {
		if (is_binomial) {
			if (Y[i] == 0.0)      null_dev += -2.0 * nv_log(1.0 - wtdmu);
			else if (Y[i] == 1.0) null_dev += -2.0 * nv_log(wtdmu);
			else null_dev += 2.0 * (Y[i] * nv_log(Y[i] / wtdmu) + (1.0 - Y[i]) * nv_log((1.0 - Y[i]) / (1.0 - wtdmu)));
		} else if (log_link) {
			null_dev += is_negbin ? dev_negbin(Y[i], wtdmu, theta) : dev_poisson(Y[i], wtdmu);
		} else {
			NV diff = Y[i] - wtdmu;
			null_dev += diff * diff;
		}
	}
	if (is_gaussian) {
		NV n_f = (NV)valid_n;
		NV dev_for_aic = deviance_new;
		if (dev_for_aic < 1.0355727742801604e-30) {
			dev_for_aic = 1.0355727742801604e-30;
		}
		aic = n_f * (nv_log(2.0 * M_PI) + 1.0 + nv_log(dev_for_aic / n_f)) + 2.0 * (final_rank + 1.0);
	} else if (is_binomial) {
		aic = deviance_new + 2.0 * final_rank;
	} else if (is_poisson) {
		NV ll = 0.0;
		for (i = 0; i < valid_n; i++)
			ll += (Y[i] > 0.0 ? Y[i] * nv_log(mu[i]) : 0.0) - mu[i] - nv_lgamma(Y[i] + 1.0);
		aic = -2.0 * ll + 2.0 * final_rank;
	} else if (is_negbin) {
		NV ll = nb_loglik(Y, mu, valid_n, theta);
		aic = -2.0 * ll + 2.0 * final_rank + (theta_given ? 0.0 : 2.0);
	}
	res_hv = newHV(); coef_hv = newHV(); fitted_hv = newHV(); resid_hv = newHV();
	df_res = valid_n - final_rank;
	dispersion = (is_binomial || log_link) ? 1.0 : ((df_res > 0) ? (deviance_new / df_res) : NAN);
	for (size_t i = 0; i < valid_n; i++) {
		NV res = Y[i] - mu[i];
		if (is_binomial) {
			NV d_res = 0.0;
			if (Y[i] == 0.0)      d_res = nv_sqrt(-2.0 * nv_log(1.0 - mu[i]));
			else if (Y[i] == 1.0) d_res = nv_sqrt(-2.0 * nv_log(mu[i]));
			else d_res = nv_sqrt(2.0 * (Y[i] * nv_log(Y[i] / mu[i]) + (1.0 - Y[i]) * nv_log((1.0 - Y[i]) / (1.0 - mu[i]))));
			res = (Y[i] > mu[i]) ? d_res : -d_res;
		} else if (log_link) {
			NV d = is_negbin ? dev_negbin(Y[i], mu[i], theta) : dev_poisson(Y[i], mu[i]);
			if (d < 0.0) d = 0.0;
			NV d_res = nv_sqrt(d);
			res = (Y[i] >= mu[i]) ? d_res : -d_res;
		}
		hv_store(fitted_hv, valid_row_names[i], strlen(valid_row_names[i]), newSVnv(mu[i]), 0);
		hv_store(resid_hv,  valid_row_names[i], strlen(valid_row_names[i]), newSVnv(res), 0);
		Safefree(valid_row_names[i]);
	}
	Safefree(valid_row_names);
	summary_hv = newHV(); terms_av = newAV();
	/*Wald confidence intervals on the link scale (confint.default), and, for
	the non-gaussian families, exponentiated coefficients: odds ratios
	(binomial), rate/incidence-rate ratios (poisson/negbin).*/
	bool use_z = is_binomial || log_link;
	NV zcrit = std_qnorm(1.0 - (1.0 - conf_level) / 2.0);
	HV *conf_hv = newHV();
	HV *exp_hv  = is_gaussian ? NULL : newHV();
	for (size_t j = 0; j < p; j++) {
		const char *cname = design->col[j].name;
		hv_store(coef_hv, cname, strlen(cname), newSVnv(beta[j]), 0);
		av_push(terms_av, newSVpv(cname, 0));

		HV *row_hv = newHV();
		if (aliased[j]) {
			hv_store(row_hv, "Estimate",   8, newSVpv("NaN", 0), 0);
			hv_store(row_hv, "Std. Error", 10, newSVpv("NaN", 0), 0);
			hv_store(row_hv, use_z ? "z value" : "t value", 7, newSVpv("NaN", 0), 0);
			hv_store(row_hv, use_z ? "Pr(>|z|)" : "Pr(>|t|)", 8, newSVpv("NaN", 0), 0);
			hv_store(row_hv, "CI.lower", 8, newSVpv("NaN", 0), 0);
			hv_store(row_hv, "CI.upper", 8, newSVpv("NaN", 0), 0);
		} else {
			NV se = nv_sqrt(dispersion * XtWX[j * p + j]);
			NV val_stat = beta[j] / se;
	/*2*pnorm(-|z|), not 2*(1 - pnorm(|z|)): erfc is accurate deep in
	the lower tail, but subtracting a near-1 value from 1 discards
	the answer entirely once the p-value falls below ~1e-16. R
	writes it the same way. get_t_pvalue() already computes its
	two-tail probability directly, so it needs no such care.*/
			NV p_val = use_z ? 2.0 * approx_pnorm(-nv_fabs(val_stat))
			                 : get_t_pvalue(val_stat, df_res, "two.sided");
			NV ci_lo = beta[j] - zcrit * se;
			NV ci_hi = beta[j] + zcrit * se;
			hv_store(row_hv, "Estimate",   8, newSVnv(beta[j]), 0);
			hv_store(row_hv, "Std. Error", 10, newSVnv(se), 0);
			hv_store(row_hv, use_z ? "z value" : "t value", 7, newSVnv(val_stat), 0);
			hv_store(row_hv, use_z ? "Pr(>|z|)" : "Pr(>|t|)", 8, newSVnv(p_val), 0);
			hv_store(row_hv, "CI.lower", 8, newSVnv(ci_lo), 0);
			hv_store(row_hv, "CI.upper", 8, newSVnv(ci_hi), 0);
			AV *ci_av = newAV();
			av_push(ci_av, newSVnv(ci_lo)); av_push(ci_av, newSVnv(ci_hi));
			hv_store(conf_hv, cname, strlen(cname), newRV_noinc((SV*)ci_av), 0);
			if (exp_hv) {
				HV *e = newHV();
				hv_store(e, "estimate",  8, newSVnv(nv_exp(beta[j])), 0);
				hv_store(e, "conf.low",  8, newSVnv(nv_exp(ci_lo)), 0);
				hv_store(e, "conf.high", 9, newSVnv(nv_exp(ci_hi)), 0);
				hv_store(exp_hv, cname, strlen(cname), newRV_noinc((SV*)e), 0);
			}
		}
		hv_store(summary_hv, cname, strlen(cname), newRV_noinc((SV*)row_hv), 0);
	}
	hv_store(res_hv, "aic",            3, newSVnv(aic), 0);
	hv_store(res_hv, "coefficients",  12, newRV_noinc((SV*)coef_hv), 0);
	hv_store(res_hv, "conf.int",       8, newRV_noinc((SV*)conf_hv), 0);
	hv_store(res_hv, "conf.level",    10, newSVnv(conf_level), 0);
	if (exp_hv) hv_store(res_hv, "exp", 3, newRV_noinc((SV*)exp_hv), 0);
	if (is_negbin) hv_store(res_hv, "theta", 5, newSVnv(theta), 0);
	hv_store(res_hv, "converged",      9, newSVuv(converged ? 1 : 0), 0);
	hv_store(res_hv, "boundary",       8, newSVuv(boundary ? 1 : 0), 0);
	hv_store(res_hv, "deviance",       8, newSVnv(deviance_new), 0);
	hv_store(res_hv, "deviance.resid", 14, newRV_noinc((SV*)resid_hv), 0);
	hv_store(res_hv, "df.null",        7, newSVuv(valid_n - has_intercept), 0);
	hv_store(res_hv, "df.residual",   11, newSVuv(df_res), 0);
	hv_store(res_hv, "family",         6, newSVpv(family_str, 0), 0);
	hv_store(res_hv, "fitted.values", 13, newRV_noinc((SV*)fitted_hv), 0);
	hv_store(res_hv, "iter",           4, newSVuv(iter > max_iter ? max_iter : iter), 0);
	hv_store(res_hv, "null.deviance", 13, newSVnv(null_dev), 0);
	hv_store(res_hv, "rank",           4, newSVuv(final_rank), 0);
	hv_store(res_hv, "summary",        7, newRV_noinc((SV*)summary_hv), 0);
	hv_store(res_hv, "terms",          5, newRV_noinc((SV*)terms_av), 0);
	hv_store(res_hv, "xlevels",       7, newRV_inc((SV*)xlevels_hv), 0);
	for (i = 0; i < num_terms; i++) Safefree(terms[i]);
	Safefree(terms);
	for (i = 0; i < num_uniq; i++) Safefree(uniq_terms[i]);
	Safefree(uniq_terms);
	lm_design_free(aTHX_ design);
	Safefree(mu); Safefree(eta); Safefree(Z); Safefree(W);
	Safefree(beta); Safefree(beta_old); Safefree(aliased);
	Safefree(XtWX); Safefree(XtWZ); Safefree(X); Safefree(Y);
	if (row_hashes) Safefree(row_hashes);
	RETVAL = newRV_noinc((SV*)res_hv);
	}
	OUTPUT:
		RETVAL

SV* cor_test(...)
CODE:
{
	if (items < 2 || items % 2 != 0)
		croak("Usage: cor_test(\\@x, \\@y, method => 'pearson', ...)");
	SV *x_ref = ST(0), *y_ref = ST(1);
	const char *alternative = "two.sided";
	const char *method = "pearson";
	SV *exact_sv = NULL;
	NV conf_level = NV_CONF_95;
	bool continuity = 0;
	//Parse named arguments from the flat stack starting at index 2
	for (Stack_off_t i = 2; i < items; i += 2) {
	  const char *key = SvPV_nolen(ST(i));
	  SV *val = ST(i + 1);
	  if      (strEQ(key, "alternative")) alternative = SvPV_nolen(val);
	  else if (strEQ(key, "method"))      method = SvPV_nolen(val);
	  else if (strEQ(key, "exact"))       exact_sv = val;
	  else if (strEQ(key, "conf.level") || strEQ(key, "conf_level")) conf_level = SvNV(val);
	  else if (strEQ(key, "continuity"))  continuity = SvTRUE(val);
	  else croak("cor_test: unknown argument '%s'", key);
	}
	AV *x_av, *y_av;
	NV *x, *y;
	NV estimate = 0, p_value = 0, statistic = 0, df = 0, ci_lower = 0, ci_upper = 0;
	bool is_pearson  = (strcmp(method, "pearson")  == 0);
	bool is_kendall  = (strcmp(method, "kendall")  == 0);
	bool is_spearman = (strcmp(method, "spearman") == 0);
	HV *rhv;
	if (!SvOK(x_ref) || !SvROK(x_ref) || SvTYPE(SvRV(x_ref)) != SVt_PVAV ||
		!SvOK(y_ref) || !SvROK(y_ref) || SvTYPE(SvRV(y_ref)) != SVt_PVAV) {
	  croak("cor_test: x and y must be array references");
	}
	x_av = (AV*)SvRV(x_ref);
	y_av = (AV*)SvRV(y_ref);
	size_t n_raw = av_len(x_av) + 1;
	if (n_raw != (size_t)(av_len(y_av) + 1)) croak("incompatible dimensions");
	x = safemalloc(n_raw * sizeof(NV));
	y = safemalloc(n_raw * sizeof(NV));
	size_t n = 0; //Final count of pairwise complete observations
	for (size_t i = 0; i < n_raw; i++) {
	  SV **x_val = av_fetch(x_av, i, 0);
	  SV **y_val = av_fetch(y_av, i, 0);
	  NV xv = (x_val && SvOK(*x_val) && looks_like_number(*x_val)) ? SvNV(*x_val) : NAN;
	  NV yv = (y_val && SvOK(*y_val) && looks_like_number(*y_val)) ? SvNV(*y_val) : NAN;
	  if (!nv_isnan(xv) && !nv_isnan(yv)) {//Pairwise complete observations (skips NAs like R)
		  x[n] = xv;
		  y[n] = yv;
		  n++;
	  }
	}
	if (n < 3) {
	  Safefree(x);
	  Safefree(y);
	  croak("not enough finite observations");
	}
	if (is_pearson) {//Welford's one-pass algorithm for Pearson correlation
		NV mean_x = 0.0, mean_y = 0.0, M2_x = 0.0, M2_y = 0.0, cov = 0.0;
		for (size_t i = 0; i < n; i++) {
			NV dx = x[i] - mean_x;
			mean_x += dx / (i + 1);
			NV dy = y[i] - mean_y;
			mean_y += dy / (i + 1);
			M2_x += dx * (x[i] - mean_x);
			M2_y += dy * (y[i] - mean_y);
			cov  += dx * (y[i] - mean_y);
	  }
	  estimate = (M2_x > 0.0 && M2_y > 0.0) ? cov / nv_sqrt(M2_x * M2_y) : 0.0;
	  //Clamp to [-1, 1] to guard against floating-point overshoot
	  if      (estimate >  1.0) estimate =  1.0;
	  else if (estimate < -1.0) estimate = -1.0;
	  df = (NV)(n - 2);
	  /*guard divide-by-zero when |estimate| == 1 exactly.
	  A perfect correlation gives t = ±Inf, matching R's behaviour.*/
	  NV denom_t = 1.0 - estimate * estimate;
	  if (denom_t <= 0.0)
		  statistic = (estimate > 0.0) ? INFINITY : -INFINITY;
	  else
		  statistic = estimate * nv_sqrt(df / denom_t);
	  /*Confidence interval via Fisher's Z transform.
	  when |estimate| == 1 the log blows up; clamp first.
	  We use a half-ULP margin so tanh can recover ±1 cleanly.*/
	  NV est_clamped = estimate;
	  if      (est_clamped >=  1.0) est_clamped =  1.0 - DBL_EPSILON;
	  else if (est_clamped <= -1.0) est_clamped = -1.0 + DBL_EPSILON;
	  NV z     = 0.5 * nv_log((1.0 + est_clamped) / (1.0 - est_clamped));
	  NV se    = 1.0 / nv_sqrt((NV)(n - 3));
	  NV alpha = 1.0 - conf_level;
	  NV q     = std_qnorm(1.0 - alpha / 2.0);
	  ci_lower = nv_tanh(z - q * se);
	  ci_upper = nv_tanh(z + q * se);
	  // High-precision p-value using incomplete beta
	  p_value = get_t_pvalue(statistic, df, alternative);
	} else if (is_kendall) { // use long to avoid int overflow for large n
	  long c = 0, d = 0, tie_x = 0, tie_y = 0;
	  for (size_t i = 0; i < n - 1; i++) {
		  for (size_t j = i + 1; j < n; j++) {
			  NV sign_x = (x[i] > x[j]) - (x[i] < x[j]);
			  NV sign_y = (y[i] > y[j]) - (y[i] < y[j]);
			  if      (sign_x == 0 && sign_y == 0) { } //joint tie — ignore
			  else if (sign_x == 0) tie_x++;
			  else if (sign_y == 0) tie_y++;
			  else if (sign_x * sign_y > 0) c++;
			  else d++;
		  }
	  }
	  NV denom = nv_sqrt((NV)(c + d + tie_x) * (NV)(c + d + tie_y));
	  estimate = (denom == 0.0) ? NAN : (NV)(c - d) / denom;
	  bool has_ties = (tie_x > 0 || tie_y > 0), do_exact;
	  // Mirror R: exact defaults to TRUE if n < 50 and no ties
	  if (!exact_sv || !SvOK(exact_sv))
		  do_exact = (n < 50) && !has_ties;
	  else
		  do_exact = SvTRUE(exact_sv) ? 1 : 0;
	  //R overrides forced-exact back to approximation when ties exist
	  if (do_exact && has_ties) do_exact = 0;
	  if (do_exact) {
		  NV S_stat = (NV)(c - d);
		  statistic = (NV)c;
		  p_value = kendall_exact_pvalue(n, S_stat, alternative);
	  } else {
		  //Normal approximation for large n or when ties are present
		  NV var_S = (NV)n * (NV)(n - 1) * (2.0 * (NV)n + 5.0) / 18.0;
		  NV S = (NV)(c - d);
		  if (continuity) S -= (S > 0.0 ? 1.0 : -1.0);
		  statistic = S / nv_sqrt(var_S);

		  /*Tails evaluated where they lie: approx_pnorm is erfc-based and so
		  is accurate deep into its lower tail, but subtracting a near-1
		  value from 1 discards the answer below ~1e-16. pnorm(-x) is the
		  upper tail exactly, by symmetry, at no cost.*/
		  if      (strcmp(alternative, "two.sided") == 0)
			  p_value = 2.0 * approx_pnorm(-nv_fabs(statistic));
		  else if (strcmp(alternative, "less") == 0)
			  p_value = approx_pnorm(statistic);
		  else
			  p_value = approx_pnorm(-statistic);
	  }

	} else if (is_spearman) {
	  NV *rank_x = safemalloc(n * sizeof(NV));
	  NV *rank_y = safemalloc(n * sizeof(NV));
	  rank_data(x, rank_x, n);
	  rank_data(y, rank_y, n);
	  //Spearman rho = Pearson r of the ranks (Welford's algorithm)
	  NV mean_x = 0.0, mean_y = 0.0, M2_x = 0.0, M2_y = 0.0, cov = 0.0;
	  for (size_t i = 0; i < n; i++) {
		  NV dx = rank_x[i] - mean_x;
		  mean_x += dx / (i + 1);
		  NV dy = rank_y[i] - mean_y;
		  mean_y += dy / (i + 1);
		  M2_x += dx * (rank_x[i] - mean_x);
		  M2_y += dy * (rank_y[i] - mean_y);
		  cov  += dx * (rank_y[i] - mean_y);
	  }
	  estimate = (M2_x > 0.0 && M2_y > 0.0) ? cov / nv_sqrt(M2_x * M2_y) : 0.0;

	  //Clamp to [-1, 1] to guard against floating-point overshoot
	  if      (estimate >  1.0) estimate =  1.0;
	  else if (estimate < -1.0) estimate = -1.0;

	  //S = sum of squared rank differences (R's reported statistic)
	  NV S_stat = 0.0;
	  for (size_t i = 0; i < n; i++) {
		  NV diff = rank_x[i] - rank_y[i];
		  S_stat += diff * diff;
	  }
	  //Ties produce fractional (averaged) ranks — detect them
	  bool has_ties = 0;
	  for (size_t i = 0; i < n; i++) {
		  if (rank_x[i] != nv_floor(rank_x[i]) || rank_y[i] != nv_floor(rank_y[i])) {
			  has_ties = 1;
			  break;
		  }
	  }
	  bool do_exact;
	  if (!exact_sv || !SvOK(exact_sv))
		  do_exact = (n < 10) && !has_ties;
	  else
		  do_exact = SvTRUE(exact_sv) ? 1 : 0;
	  if (do_exact) {
		  statistic = S_stat;
		  p_value   = spearman_exact_pvalue(S_stat, n, alternative);
	  } else {
		  NV r = estimate;
		  /*NOTE: R silently ignores continuity correction for Spearman.
		  The adjustment below is non-standard; a warning is emitted
		  so callers are not silently misled.*/
		  if (continuity) {
			  warn("cor_test: continuity correction is not defined for Spearman in R and is ignored here");
		  }
		  NV denom_t = 1.0 - r * r;
		  if (denom_t <= 0.0)
			  statistic = (r > 0.0) ? INFINITY : -INFINITY;
		  else
			  statistic = r * nv_sqrt((NV)(n - 2) / denom_t);
		  p_value = get_t_pvalue(statistic, (NV)(n - 2), alternative);
	  }
	  Safefree(rank_x);	  Safefree(rank_y);
	} else {
	  Safefree(x);	  Safefree(y);
	  croak("Unknown method '%s': must be 'pearson', 'kendall', or 'spearman'", method);
	}
	Safefree(x);	Safefree(y);
	rhv = newHV();
	hv_stores(rhv, "estimate",    newSVnv(estimate));
	hv_stores(rhv, "p.value",     newSVnv(p_value));
	hv_stores(rhv, "statistic",   newSVnv(statistic));
	hv_stores(rhv, "method",      newSVpv(method, 0));
	hv_stores(rhv, "alternative", newSVpv(alternative, 0));
	if (is_pearson) {
	  hv_stores(rhv, "parameter", newSVnv(df));
	  AV *ci_av = newAV();
	  av_push(ci_av, newSVnv(ci_lower));
	  av_push(ci_av, newSVnv(ci_upper));
	  hv_stores(rhv, "conf.int", newRV_noinc((SV*)ci_av));
	}
	RETVAL = newRV_noinc((SV*)rhv);
}
OUTPUT:
	RETVAL

void shapiro_test(data)
	SV *data
PREINIT:
	AV *av;
	HV *ret_hash;
	size_t n_raw, n = 0, nn2;
	NV *x = NULL, *a = NULL, w = 0.0, p_val = 0.0, w1, range, centre, sa = 0.0, sx = 0.0;
	NV ssa = 0.0, ssx = 0.0, sax = 0.0, ssassx;
	/* AS R94's own coefficient blocks, transcribed from R's swilk.c. */
	const NV c1[6] = { 0.0, 0.221157, -0.147981, -2.07119, 4.434685, -2.706056 };
	const NV c2[6] = { 0.0, 0.042981, -0.293762, -1.752461, 5.682633, -3.582633 };
	const NV c3[4] = { 0.544, -0.39978, 0.025054, -6.714e-4 };
	const NV c4[4] = { 1.3822, -0.77857, 0.062767, -0.0020322 };
	const NV c5[4] = { -1.5861, -0.31082, -0.083751, 0.0038915 };
	const NV c6[3] = { -0.4803, -0.082676, 0.0030302 };
	const NV g[2]  = { -2.273, 0.459 };
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 ? n_raw : 1, NV);
	/* R's shapiro.test() drops the incomplete cases before it counts, and
	   complete.cases() calls NaN missing, so undef and NaN both go here. */
	for (size_t i = 0; i < n_raw; i++) {
		SV **elem = av_fetch(av, i, 0);
		if (elem && SvOK(*elem)) {
			NV val = SvNV(*elem);
			if (!nv_isnan(val)) {
				x[n] = val;
				n++;
			}
		}
	}
	if (n < 3 || n > 5000) {
	  Safefree(x);
	  croak("Sample size must be between 3 and 5000 (R's limit)");
	}
	nv_sort(x, n);
	range = x[n-1] - x[0];
	if (range == 0.0) {
		Safefree(x);
		croak("Data is perfectly constant; cannot compute Shapiro-Wilk test");
	}
	/* Everything below works on (x - median)/range.  W is invariant under
   both, and the pair is what keeps it computable: R divides by the range
   only, so a sample whose values dwarf their own spread -- 1e6 + noise --
   loses most of its digits in ssx before W is ever formed (SciPy's
   gh-14462).  Centring first costs one subtraction per value and the
   well-conditioned samples still agree with R to the last few ulp */
	centre = x[n/2];
	for (size_t i = 0; i < n; i++) x[i] = (x[i] - centre) / range;
	/* AS R94 weights.  Only the lower half is generated; mirroring it
	 makes a[] exactly antisymmetric (which is what R's sign(i-j) indexing
	 achieves) and halves the number of normal quantiles to evaluate */
	nn2 = n / 2;
	Newx(a, n, NV);
	if (n == 3) {
		a[0] = -0.70710678118654752440;   /* -sqrt(1/2) */
		a[1] = 0.0;
		a[2] = -a[0];
	} else {
		NV an25 = (NV)n + 0.25, summ2 = 0.0, ssumm2, rsn, a1, a2, fac;
		size_t i1;
		for (size_t i = 0; i < nn2; i++) {
			a[i] = normal_quantile_hp(((NV)i + 0.625) / an25);
			summ2 += a[i] * a[i];
		}
		summ2 *= 2.0;
		ssumm2 = nv_sqrt(summ2);
		rsn = 1.0 / nv_sqrt((NV)n);
		a1 = as181_poly(c1, 6, rsn) - a[0] / ssumm2;
		if (n > 5) {
			i1 = 2;
			a2 = as181_poly(c2, 6, rsn) - a[1] / ssumm2;
			fac = nv_sqrt((summ2 - 2.0 * a[0] * a[0] - 2.0 * a[1] * a[1])
			            / (1.0   - 2.0 * a1   * a1   - 2.0 * a2   * a2));
			a[1] = -a2;
		} else {
			i1 = 1;
			fac = nv_sqrt((summ2 - 2.0 * a[0] * a[0]) / (1.0 - 2.0 * a1 * a1));
		}
		a[0] = -a1;
		for (size_t i = i1; i < nn2; i++) a[i] /= fac;
		if (n & 1) a[nn2] = 0.0;
		for (size_t i = 0; i < nn2; i++) a[n-1-i] = -a[i];
	}
	/* W as the squared correlation between the data and the weights.
  1 - W is formed directly, never as a subtraction from 1: the p-value
  is a function of log(1-W) and W runs to within 1e-5 of 1 on a large
  normal sample, so the naive (b*b)/ssq loses every digit that matters
  exactly where the sample is largest.  This is R's own w1 */
	for (size_t i = 0; i < n; i++) { sa += a[i]; sx += x[i]; }
	sa /= (NV)n;
	sx /= (NV)n;
	for (size_t i = 0; i < n; i++) {
		NV asa = a[i] - sa, xsx = x[i] - sx;
		ssa += asa * asa;
		ssx += xsx * xsx;
		sax += asa * xsx;
	}
	Safefree(a); a = NULL;
	Safefree(x); x = NULL;
	ssassx = nv_sqrt(ssa * ssx);
	w1 = (ssassx - sax) * (ssassx + sax) / (ssa * ssx);
	if (w1 < 0.0) w1 = 0.0;   /* a perfect correlation, rounded past zero */
	w  = 1.0 - w1;
	//significance level for W
	if (n == 3) {
	/* Exact: Royston (1993).  6/pi and asin(sqrt(3/4)) = pi/3 to NV
	   width -- R carries 15 digits of the latter, which is enough to
	   drive its own p-value 4e-15 negative at the W = 3/4 floor
	   (R's reg-tests-1b.R only asks that the result not go below 0) */
		p_val = 1.909859317102744029 * (nv_asin(nv_sqrt(w)) - 1.047197551196597746);
	} else if (w1 == 0.0) {
		p_val = 1.0;
	} else {
		NV y = nv_log(w1), mu = 0.0, sigma = 1.0;
		bool off_scale = 0; //W past the range the fit was made over
		if (n <= 11) {
			NV gamma = as181_poly(g, 2, (NV)n);
			if (y >= gamma) {
				off_scale = TRUE;
				p_val = 1e-99; // R's own "obvious" value
			} else {
				y     = -nv_log(gamma - y);
				mu    = as181_poly(c3, 4, (NV)n);
				sigma = nv_exp(as181_poly(c4, 4, (NV)n));
			}
		} else {
			NV ln_n = nv_log((NV)n);
			mu    = as181_poly(c5, 4, ln_n);
			sigma = nv_exp(as181_poly(c6, 3, ln_n));
		}
		/* Upper tail P(Z > (y-mu)/sigma): a small W is a large y is a small
		   p-value, and pnorm(-z) is that tail exactly, by symmetry. */
		if (!off_scale) p_val = approx_pnorm(-(y - mu) / sigma);
	}
	if (p_val > 1.0) p_val = 1.0;
	if (p_val < 0.0) p_val = 0.0;
	ret_hash = newHV();
	hv_stores(ret_hash, "statistic", newSVnv(w));
	hv_stores(ret_hash, "W",         newSVnv(w));
	hv_stores(ret_hash, "p.value",   newSVnv(p_val));
	EXTEND(SP, 1);
	PUSHs(sv_2mortal(newRV_noinc((SV *)ret_hash)));

NV min(...)
	PROTOTYPE: @
	INIT:
		NvAcc acc = { 0.0, 0.0, 0.0, 0 };
	CODE:
		/*Stack_off_t, not a short: `items` is the whole flattened argument
		list, so min(@x) on a 70k-element array puts 70k scalars here. An
		`unsigned short int` counter wrapped at 65536 and looped forever.*/
		for (Stack_off_t i = 0; i < items; i++) {
			SV* arg = ST(i);
			if (SvROK(arg) && SvTYPE(SvRV(arg)) == SVt_PVAV) {
				AV* av = (AV*)SvRV(arg);
				SSize_t len = av_len(av) + 1, j = 0;
				if (!SvRMAGICAL((SV*)av)) av_scan_min(av, &j, len, &acc);
				for (; j < len; j++) {
					 SV* tv = av_slow_at(aTHX_ av, j);
					 if (tv) {
						 NV val = SvNV(tv);
						 if (acc.count == 0 || val < acc.min) acc.min = val;
						 acc.count++;
					 } else {
						 croak("min: undefined value at array ref index %" UVuf " (argument %" UVuf ")", (UV)j, (UV)i);
					 }
				 }
			} else if (SvOK(arg)) {
				 NV val = SvNV(arg);
				 if (acc.count == 0 || val < acc.min) acc.min = val;
				 acc.count++;
			} else {
				 croak("min: undefined value at argument index %" UVuf, (UV)i);
			}
		}
		if (acc.count == 0) croak("min needs >= 1 numeric element");
		RETVAL = acc.min;
	OUTPUT:
	  RETVAL

NV max(...)
	PROTOTYPE: @
	INIT:
		NvAcc acc = { 0.0, 0.0, 0.0, 0 };
	CODE:
		for (Stack_off_t i = 0; i < items; i++) {
		   SV* arg = ST(i);
		   if (SvROK(arg) && SvTYPE(SvRV(arg)) == SVt_PVAV) {
			   AV* av = (AV*)SvRV(arg);
			   SSize_t len = av_len(av) + 1, j = 0;
			   if (!SvRMAGICAL((SV*)av)) av_scan_max(av, &j, len, &acc);
			   for (; j < len; j++) {
				   SV* tv = av_slow_at(aTHX_ av, j);
				   if (tv) {
					   NV val = SvNV(tv);
					   if (acc.count == 0 || val > acc.max) acc.max = val;
					   acc.count++;
				   } else {
					   croak("max: undefined value at array ref index %" UVuf " (argument %" UVuf ")", (UV)j, (UV)i);
				   }
			   }
		   } else if (SvOK(arg)) {
			   NV val = SvNV(arg);
			   if (acc.count == 0 || val > acc.max) acc.max = val;
			   acc.count++;
		   } else {
			   croak("max: undefined value at argument index %" UVuf, (UV)i);
		   }
	  }
	  if (acc.count == 0) croak("max needs >= 1 numeric element");
	  RETVAL = acc.max;
	OUTPUT:
		RETVAL

SV* runif(...)
CODE:
{
	size_t n = 0;
	NV min = 0.0, max = 1.0;
	bool n_set = 0, min_set = 0, max_set = 0;// Flags to track what has been assigned
	SV *n_sv = NULL;	// 'n' is range-checked once, after the parse
	Stack_off_t i = 0;
	if (items == 0) {
	  croak("Usage: runif(n, [min=0], [max=1]) or runif(n => $n, ...)");
	}
	while (i < items) {
	/*A string that is not a number can only have been meant as a named
	argument, because every positional slot here (n, min, max) is numeric.
	Deciding that on the key alone is what makes a dangling or misspelled
	key an error: the older parser accepted a key only when a value
	followed it, so runif(5, 'min') fell through to the positional branch,
	where SvNV("min") is 0 -- the key silently became min = 0, and the only
	hint was perl's own "isn't numeric" warning, which does not name the
	function it came from. A numeric string is still positional, so
	runif("9") keeps working.*/
		if (SvPOK(ST(i)) && !looks_like_number(ST(i))) {
			const char *key = SvPV_nolen(ST(i));
			bool is_n   = strEQ(key, "n"), is_min = strEQ(key, "min"), is_max = strEQ(key, "max");
			if (!is_n && !is_min && !is_max)
				croak("runif: unknown argument '%s' (expected n, min or max)", key);
			if (i + 1 >= items)
				croak("runif: odd number of named arguments ('%s' has no value)", key);
			SV *val = ST(i + 1);
			if (!SvOK(val) || !looks_like_number(val))
				croak("runif: '%s' must be a number", key);
			if      (is_n)   { n_sv = val;        n_set   = 1; }
			else if (is_min) { min = SvNV(val);   min_set = 1; }
			else             { max = SvNV(val);   max_set = 1; }
			i += 2;
			continue;
		}
		// positional, in order: n, then min, then max
		if (!SvOK(ST(i)) || !looks_like_number(ST(i)))
			croak("runif: argument %d is not a number", (int)i + 1);
		if      (!n_set)   { n_sv = ST(i);       n_set   = 1; }
		else if (!min_set) { min = SvNV(ST(i));  min_set = 1; }
		else if (!max_set) { max = SvNV(ST(i));  max_set = 1; }
		else croak("runif: too many arguments (expected n, min, max)");
		i++;
	}
	if (!n_set) {
		croak("runif: 'n' is a required argument");
	}
	/*Range-check n before it reaches av_extend(). It used to be read straight
	through SvUV(), so runif(-1) wrapped to 2**64-1, av_extend() took that as a
	negative SSize_t and perl died with "panic: av_extend_guts() negative
	count" -- a message that names neither runif nor the argument at fault.
	Non-integers truncate toward zero, as R's runif() does.*/
	{
		NV nv = SvNV(n_sv);
		if (nv_isnan(nv) || nv < 0.0)
			croak_nv("runif: 'n' must be a non-negative integer, not %" NVgf, nv);
		if (nv > (NV)IV_MAX)
			croak_nv("runif: 'n' is too large: %" NVgf, nv);
		n = (size_t)nv;	// truncates toward zero, as R does
	}
	// Ensure PRNG is seeded
	AUTO_SEED_PRNG();
	AV *results = newAV();
	if (n > 0) {
		av_extend(results, n - 1);
	}
	const NV range = max - min;
	for (size_t j = 0; j < n; j++) {
		NV r;
		if (max < min) {
			r = NAN; // R behavior for inverted ranges
		} else {
			r = min + range * Drand01();
		}
		av_push(results, newSVnv(r));
	}
	RETVAL = newRV_noinc((SV*)results);
}
OUTPUT:
	RETVAL

SV* rbinom(...)
	CODE:
	{
	// Auto-seed the PRNG if the Perl script hasn't done so yet
	AUTO_SEED_PRNG();
	if (items % 2 != 0)
		croak("Usage: rbinom(n => 10, size => 100, prob => 0.5)");
	//Parse named arguments
	size_t n = 0, size = 0;
	NV prob = 0.5;
	bool size_set = 0, prob_set = 0;

	for (unsigned short i = 0; i < items; i += 2) {
		const char* key = SvPV_nolen(ST(i));
		SV* val = ST(i + 1);

		if      (strEQ(key, "n"))      n    = (unsigned int)SvUV(val);
		else if (strEQ(key, "size")) { size = (unsigned int)SvUV(val); size_set = TRUE; }
		else if (strEQ(key, "prob")) { prob = SvNV(val); prob_set = TRUE; }
		else croak("rbinom: unknown argument '%s'", key);
	}

	// R requires size and prob to be explicitly passed in rbinom
	if (!size_set || !prob_set) croak("rbinom: 'size' and 'prob' are required arguments");
	if (prob < 0.0 || prob > 1.0) croak("rbinom: prob must be between 0 and 1");

	AV *result_av = newAV();
	if (n > 0) {
		av_extend(result_av, n - 1);
		for (unsigned int i = 0; i < n; i++) {
			av_store(result_av, i, newSVuv(generate_binomial(aTHX_ size, prob)));
		}
	}

	RETVAL = newRV_noinc((SV*)result_av);
	}
	OUTPUT:
		RETVAL

SV* hist(SV* x_sv, ...)
	CODE:
	{
		// 1. Validate Input
		if (!SvROK(x_sv) || SvTYPE(SvRV(x_sv)) != SVt_PVAV)
			croak("hist: first argument must be an array reference");

		AV*x_av = (AV*)SvRV(x_sv);
		size_t n_raw = av_len(x_av) + 1;
		if (n_raw == 0) croak("hist: input array is empty");

		// 2. Extract Data & Find Range
		NV *x;
		Newx(x, n_raw, NV);
		size_t n = 0;
		NV min_val = DBL_MAX, max_val = -DBL_MAX;

		for (size_t i = 0; i < n_raw; i++) {
			SV**tv = av_fetch(x_av, i, 0);
			if (tv && SvOK(*tv)) {
				 NV val = SvNV(*tv);
				 x[n++] = val;
				 if (val < min_val) min_val = val;
				 if (val > max_val) max_val = val;
			}
		}
		if (n == 0) {
			Safefree(x);
			croak("hist: input contains no valid numeric data");
		}
		// 3. Determine Bin Count (Sturges default or user-provided)
		size_t n_bins = 0;
		if (items == 2) {
// Support pure positional argument: hist($data, 22)
			n_bins = (size_t)SvIV(ST(1));
		} else if (items > 2) {
// Support named parameters even if mixed with positional arguments
			for (unsigned short i = 1; i < items - 1; i++) {
				 // Make sure the SV holds a string before doing string comparison
				 if (SvPOK(ST(i)) && strEQ(SvPV_nolen(ST(i)), "breaks")) {
					 n_bins = (size_t)SvIV(ST(i+1));
					 break;
				 }
			}
//Fallback: if 'breaks' wasn't found but a positional number was given first
			if (n_bins == 0 && looks_like_number(ST(1))) {
				 n_bins = (size_t)SvIV(ST(1));
			}
		}
		if (n_bins == 0) n_bins = calculate_sturges_bins(n);
// 4. Allocate Result Arrays
		NV *breaks, *mids, *density;
		size_t *counts;
		Newx(breaks,  n_bins + 1, NV);
		Newx(mids,    n_bins,     NV);
		Newx(density, n_bins,     NV);
		Newx(counts,  n_bins,     size_t);
		// Generate simple linear breaks
		NV step = (max_val - min_val) / (NV)n_bins;
		for (size_t i = 0; i <= n_bins; i++) {
			breaks[i] = min_val + (NV)i * step;
		}
		// 5. Compute Statistics
		compute_hist_logic(x, n, breaks, n_bins, counts, mids, density);
		// 6. Build Return HashRef
		HV*res_hv = newHV();
		AV*av_breaks  = newAV();
		AV*av_counts  = newAV();
		AV*av_mids    = newAV();
		AV*av_density = newAV();
		for (size_t i = 0; i <= n_bins; i++) {
			av_push(av_breaks, newSVnv(breaks[i]));
			if (i < n_bins) {
				 av_push(av_counts,  newSViv(counts[i]));
				 av_push(av_mids,    newSVnv(mids[i]));
				 av_push(av_density, newSVnv(density[i]));
			}
		}
		hv_stores(res_hv, "breaks",  newRV_noinc((SV*)av_breaks));
		hv_stores(res_hv, "counts",  newRV_noinc((SV*)av_counts));
		hv_stores(res_hv, "mids",    newRV_noinc((SV*)av_mids));
		hv_stores(res_hv, "density", newRV_noinc((SV*)av_density));
		// Clean
		Safefree(x); Safefree(breaks); Safefree(mids);
		Safefree(density); Safefree(counts);
		RETVAL = newRV_noinc((SV*)res_hv);
	}
	OUTPUT:
	  RETVAL

SV* quantile(...)
	CODE:
	{
		SV *x_sv = NULL;
		SV *probs_sv = NULL;
		Stack_off_t arg_idx = 0;
		// --- 1. Consume first positional arg as 'x' if it's an array ref
		if (arg_idx < items && SvROK(ST(arg_idx)) && SvTYPE(SvRV(ST(arg_idx))) == SVt_PVAV) {
			 x_sv = ST(arg_idx);
			 arg_idx++;
		}
		// --- 2. Remaining args must be key-value pairs
		if ((items - arg_idx) % 2 != 0)
			 croak("Usage: quantile(\\@data, probs => \\@probs)  OR  quantile(x => \\@data, probs => \\@probs)");

		for (; arg_idx < items; arg_idx += 2) {
			 const char *key = SvPV_nolen(ST(arg_idx));
			 SV *val = ST(arg_idx + 1);

			 if      (strEQ(key, "x"))     x_sv     = val;
			 else if (strEQ(key, "probs")) probs_sv = val;
			 else croak("quantile: unknown argument '%s'", key);
		}
		if (!x_sv || !SvROK(x_sv) || SvTYPE(SvRV(x_sv)) != SVt_PVAV)
			croak("quantile: 'x' must be an array reference");
		
		AV *x_av = (AV*)SvRV(x_sv);
		size_t n_raw = av_len(x_av) + 1;
		if (n_raw == 0) croak("quantile: 'x' is empty");
		/* Parse Probabilities (Upgraded to NV)
		 Before the column is read, not after: which order statistics the
		 partial sort below has to place is decided by the probs, and a probs
		 vector that turns out to be invalid should not first cost a pass over
		 a million-element column. */
		NV default_probs[] = {0.0, 0.25, 0.50, 0.75, 1.0};
		unsigned int n_probs = 5;
		NV *probs;
		if (probs_sv && SvROK(probs_sv) && SvTYPE(SvRV(probs_sv)) == SVt_PVAV) {
			AV *p_av = (AV*)SvRV(probs_sv);
			/* R's own overshoot allowance, eps <- 100*.Machine$double.eps:
			   a probability arrived at by arithmetic can land a hair outside
			   [0, 1], and R clamps rather than refuses (its PR#17891,
			   quantile(0:1, 1+1e-14) == 1).  This is R's constant and not
			   NV_EPSILON on purpose -- it is part of what quantile() accepts,
			   not a tolerance on an answer, so a long-double or __float128
			   build must not reject a probs vector R takes. */
			const NV probs_eps = 2.220446049250313e-14;
			n_probs = av_len(p_av) + 1;
			Newx(probs, n_probs, NV);
			for (unsigned int i = 0; i < n_probs; i++) {
				 SV **tv = av_fetch(p_av, i, 0);
				 probs[i] = (tv && SvOK(*tv)) ? SvNV(*tv) : 0.0;
				 if (probs[i] < -probs_eps || probs[i] > 1.0 + probs_eps) {
					 Safefree(probs);
					 croak("quantile: probabilities must be between 0 and 1");
				 }
				 if (probs[i] < 0.0) probs[i] = 0.0;
				 if (probs[i] > 1.0) probs[i] = 1.0;
			}
		} else {
			Newx(probs, n_probs, NV);
			for (unsigned int i = 0; i < n_probs; i++) probs[i] = default_probs[i];
		}
		// --- Extract valid numeric data & drop NAs (Upgraded to NV)
		NV *x;
		Newx(x, n_raw, NV);
		size_t n = 0;
		{
			SSize_t len = (SSize_t)n_raw, j = 0;
			if (!SvRMAGICAL((SV*)x_av)) av_scan_extract(x_av, &j, len, x, &n);
			for (; j < len; j++) {
				SV *tv = av_slow_at(aTHX_ x_av, j);
				if (tv) x[n++] = SvNV(tv);
			}
		}
		if (n == 0) {
			Safefree(x); Safefree(probs);
			croak("quantile: 'x' contains no valid numbers");
		}
		/* Order only the statistics that are actually read
		 Type 7 reads at most two order statistics per probability: x[j] at
		 j = floor((n-1)p), and x[j+1] when the interpolation weight is
		 non-zero.  Placing just those with nv_select_multi() is O(n log k)
		 against the O(n log n) of ordering the whole column, and is what R
		 does -- quantile.default() hands its indices to sort(partial=).
		 Measured on 1e6 doubles at the 5 default probs: 19.2 ms against 69.1
		 ms for nv_sort().

		 Past k ~ n/2 distinct indices the partial sort is doing a sort's work
		 with more bookkeeping, so above that a full sort is simply the
		 cheaper way to get the same array. */
		{
			size_t *ks, nk = 0, uk = 0;
			Newx(ks, (size_t)n_probs * 2 + 1, size_t);
			for (unsigned int i = 0; i < n_probs; i++) {
				NV h = (NV)(n - 1) * probs[i];
				size_t j = (size_t)h;
				if (j >= n) j = n - 1;		//guards p == 1 and any rounding at the top
				ks[nk++] = j;
				if (j + 1 < n) ks[nk++] = j + 1;
			}
			if (nk > 0) {
				qsort(ks, nk, sizeof(size_t), size_t_cmp);
				for (size_t i = 0; i < nk; i++)		//drop repeats: ks must be distinct
					if (i == 0 || ks[i] != ks[i - 1]) ks[uk++] = ks[i];
			}
			if (uk == 0)              ;			//no probabilities: nothing to order
			else if (uk >= n / 2)     nv_sort(x, n);
			else                      nv_select_multi(x, 0, n - 1, ks, 0, uk);
			Safefree(ks);
		}
		// Calculate Quantiles (R Type 7 Algorithm)
		HV *res_hv = newHV();
		for (size_t i = 0; i < n_probs; i++) {
			NV p = probs[i];
			NV q = 0.0;

			if (n == 1) {
				 q = x[0];
			} else if (p == 1.0) {
				 q = x[n - 1]; 
			} else if (p == 0.0) {
				 q = x[0];
			} else {
				 NV h = (NV)(n - 1) * p;
				 size_t j = (size_t)h;
				 NV gamma = h - (NV)j;
				 q = x[j];
				 /* Interpolate only where R does: strictly between the two
				    bracketing order statistics, and only when they actually
				    differ (R's `index > lo & x[hi] != qs`).  Without the
				    second half, (1-g)*v + g*v drifts off v whenever the
				    bracket is a run of equal values -- which is what broke
				    monotonicity in R's own PR#16672, and what makes a
				    two-valued sample report 0.99999999999994 for 1. */
				 if (gamma > 0.0 && x[j + 1] != q)
					 q = (1.0 - gamma) * q + gamma * x[j + 1];
			}
			// Format hash key with Epsilon guarding
			char key[32];
			double pct = (double)(p * 100.0); // Safe to cast to double just for formatting
			double pct_rounded = nv_floor(pct + 0.5); // C89 safe rounding
			// Use 1e-9 epsilon check instead of strict integer equality
			if (nv_fabs(pct - pct_rounded) < 1e-9) {
				 snprintf(key, sizeof(key), "%.0f%%", pct_rounded);
			} else {
				 snprintf(key, sizeof(key), "%.1f%%", pct);
			}
			
			hv_store(res_hv, key, strlen(key), newSVnv(q), 0);
		}
		Safefree(x); Safefree(probs);
		RETVAL = newRV_noinc((SV*)res_hv);
	}
	OUTPUT:
	  RETVAL

NV mean(...)
	PROTOTYPE: @
	INIT:
		NvAcc acc = { 0.0, 0.0, 0.0, 0 };
	CODE:
		for (Stack_off_t i = 0; i < items; i++) {
			SV* arg = ST(i);
			if (SvROK(arg) && SvTYPE(SvRV(arg)) == SVt_PVAV) {
				AV* av = (AV*)SvRV(arg);
				SSize_t len = av_len(av) + 1, j = 0;
				if (!SvRMAGICAL((SV*)av)) av_scan_sum(av, &j, len, &acc);
				for (; j < len; j++) {
					SV* tv = av_slow_at(aTHX_ av, j);
					if (tv) {
						acc.sum += SvNV(tv);
						acc.count++;
					} else {
						croak("mean: undefined value at array ref index %" UVuf " (argument %" UVuf ")", (UV)j, (UV)i);
					}
				}
			} else if (SvOK(arg)) {
				acc.sum += SvNV(arg);
				acc.count++;
			} else {
				croak("mean: undefined value at argument index %" UVuf, (UV)i);
			}
		}
		if (acc.count == 0) croak("mean needs >= 1 element");
		RETVAL = acc.sum / acc.count;
	OUTPUT:
		RETVAL

void mode(...)
	PROTOTYPE: @
	PREINIT:
	HV *counts;
	HV *originals;
	size_t max_count = 0, arg_count = 0;
	HE *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 (Stack_off_t i = 0; i < items; i++) {
		SV *arg = ST(i);
		if (SvROK(arg) && SvTYPE(SvRV(arg)) == SVt_PVAV) {
			AV *av = (AV *)SvRV(arg);
			SSize_t len = av_len(av) + 1;
			for (size_t j = 0; j < len; j++) {
				SV **tv = av_fetch(av, j, 0);
				if (tv && SvOK(*tv)) {
					STRLEN klen;
					const char *key = SvPV(*tv, klen);
					SV **slot = hv_fetch(counts, key, klen, 1);
					if (!slot) croak("mode: internal hash error");
					size_t cnt = SvOK(*slot) ? SvIV(*slot) + 1 : 1;
					sv_setiv(*slot, cnt);
					if (cnt > max_count) max_count = cnt;
					if (cnt == 1)
						 hv_store(originals, key, klen, newSVsv(*tv), 0);
					arg_count++;
				} else {
					croak("mode: undefined value at array ref index %" UVuf " (argument %" UVuf ")", (UV)j, (UV)i);
				}
			}
		} else if (SvOK(arg)) {
			STRLEN klen;
			const char *key = SvPV(arg, klen);
			SV **slot = hv_fetch(counts, key, klen, 1);
			if (!slot) croak("mode: internal hash error");
			size_t cnt = SvOK(*slot) ? SvIV(*slot) + 1 : 1;
			sv_setiv(*slot, cnt);
			if (cnt > max_count) max_count = cnt;
			if (cnt == 1)
			  hv_store(originals, key, klen, newSVsv(arg), 0);
			arg_count++;
		} else {
			croak("mode: undefined value at argument index %" UVuf, (UV)i);
		}
	}

	if (arg_count == 0)
		croak("mode needs >= 1 element");

	hv_iterinit(counts);
	while ((he = hv_iternext(counts))) {
		if (SvIV(hv_iterval(counts, he)) == max_count) {
			STRLEN klen;
			const char *key = HePV(he, klen);
			SV **orig = hv_fetch(originals, key, klen, 0);
			mXPUSHs(orig ? newSVsv(*orig) : newSVpvn(key, klen));
		}
	}

NV sum(...)
	PROTOTYPE: @
	INIT:
		NvAcc acc = { 0.0, 0.0, 0.0, 0 };
	CODE:
		for (Stack_off_t i = 0; i < items; i++) {
			SV* arg = ST(i);
			if (SvROK(arg) && SvTYPE(SvRV(arg)) == SVt_PVAV) {
				 AV* av = (AV*)SvRV(arg);
				 SSize_t len = av_len(av) + 1, j = 0;
				 if (!SvRMAGICAL((SV*)av)) av_scan_sum(av, &j, len, &acc);
				 for (; j < len; j++) {
					 SV* tv = av_slow_at(aTHX_ av, j);
					 if (tv) {
						 acc.sum += SvNV(tv);
						 acc.count++;
					 } else {
						 croak("sum: undefined value at array ref index %" UVuf " (argument %" UVuf ")", (UV)j, (UV)i);
					 }
				 }
			} else if (SvOK(arg)) {
				 acc.sum += SvNV(arg);
				 acc.count++;
			} else {
				 croak("sum: undefined value at argument index %" UVuf, (UV)i);
			}
		}
		if (acc.count == 0) croak("sum needs >= 1 element");
		RETVAL = acc.sum;
	OUTPUT:
	  RETVAL

NV sd(...)
	PROTOTYPE: @
	INIT:
	  NvAcc acc = { 0.0, 0.0, 0.0, 0 };
	  NV mean, m2 = 0.0, comp = 0.0;
	CODE:
	/*Two passes, not Welford.

	Welford's update carries a divide (mean += delta / count) in a
	loop-carried dependency chain, so every element waits on the previous
	one's ~14-cycle latency: 5.34 ns/element against 2.70 for two passes
	on 1e6 NVs (perl-5.44.0, -O2).

	The two-pass form is also what R computes. R's cov.c takes a first
	mean, refines it with a second pass (tmp = tmp + sum(x - tmp)/n, the
	MEAN macro) and only then sums the squared deviations about the
	refined mean. Expanding that third pass about the unrefined mean
	leaves sum((x-m)^2) - (sum(x-m))^2/n, so carrying the sum of the
	deviations alongside the sum of their squares gives R's answer in one
	pass fewer -- and it is the Chan-Golub-LeVeque correction, so it is
	no less accurate than Welford on an ill-centred column.

	Reading the arguments twice is visible only to a tied array, whose
	FETCH now runs once per pass.*/
		for (Stack_off_t i = 0; i < items; i++) {	//pass 1: the mean
			SV* arg = ST(i);
			if (SvROK(arg) && SvTYPE(SvRV(arg)) == SVt_PVAV) {
				AV* av = (AV*)SvRV(arg);
				SSize_t len = av_len(av) + 1, j = 0;
				if (!SvRMAGICAL((SV*)av)) av_scan_sum(av, &j, len, &acc);
				for (; j < len; j++) {
					SV* tv = av_slow_at(aTHX_ av, j);
					if (tv) {
						acc.sum += SvNV(tv);
						acc.count++;
					} else {
						croak("sd: undefined value at array ref index %" UVuf " (argument %" UVuf ")", (UV)j, (UV)i);
					}
				}
			} else if (SvOK(arg)) {
				acc.sum += SvNV(arg);
				acc.count++;
			} else {
				croak("sd: undefined value at argument index %" UVuf, (UV)i);
			}
		}
		if (acc.count < 2) croak("sd needs >= 2 elements");
		mean = acc.sum / acc.count;
		for (Stack_off_t i = 0; i < items; i++) {	//pass 2: the deviations
			SV* arg = ST(i);
			if (SvROK(arg) && SvTYPE(SvRV(arg)) == SVt_PVAV) {
				AV* av = (AV*)SvRV(arg);
				SSize_t len = av_len(av) + 1, j = 0;
				if (!SvRMAGICAL((SV*)av)) av_scan_dev(av, &j, len, mean, &m2, &comp);
				for (; j < len; j++) {
					SV* tv = av_slow_at(aTHX_ av, j);
					if (tv) {
						NV d = SvNV(tv) - mean;
						m2 += d * d;
						comp += d;
					} else {
						croak("sd: undefined value at array ref index %" UVuf " (argument %" UVuf ")", (UV)j, (UV)i);
					}
				}
			} else if (SvOK(arg)) {
				NV d = SvNV(arg) - mean;
				m2 += d * d;
				comp += d;
			} else {
				croak("sd: undefined value at argument index %" UVuf, (UV)i);
			}
		}
		RETVAL = nv_sqrt((m2 - comp * comp / acc.count) / (acc.count - 1));
	OUTPUT:
	  RETVAL

void uniq(...)
	PROTOTYPE: @
	PREINIT:
		dd_ctx *T;
		AV *out;
		SV *scratch;
		SSize_t total, k, outlen;
		int gimme;
		char numbuf[NK_NUMBUF];
	PPCODE:
		gimme = GIMME_V;
		ENTER;                          //the tables are freed on croak too
		Newxz(T, 1, dd_ctx);
		SAVEDESTRUCTOR_X(dd_ctx_free, T);
		T->fast_nv = nk_fast_nv_ok(aTHX);
		scratch = sv_newmortal();
		//the element count bounds the distinct count, so it sizes the table
		total = 0;
		for (Stack_off_t i = 0; i < items; i++) {
			SV *arg = ST(i);
			total += (SvROK(arg) && SvTYPE(SvRV(arg)) == SVt_PVAV)
			       ? av_len((AV *)SvRV(arg)) + 1 : 1;
		}
		dd_presize(aTHX_ T, total);
		//scalar context wants the count alone, so it builds no result at all
		out = gimme == G_SCALAR ? NULL : (AV *)sv_2mortal((SV *)newAV());
		for (Stack_off_t i = 0; i < items; i++) {
			SV *arg = ST(i);
			if (SvROK(arg) && SvTYPE(SvRV(arg)) == SVt_PVAV) {
				AV *av = (AV *)SvRV(arg);
				const SSize_t len = av_len(av) + 1;
				for (SSize_t j = 0; j < len; j++) {
					/*av_slow_at(), not av_fetch(): a tied array's element is a
					PVLV that reads undef until mg_get() has run on it, so up
					to 0.301 uniq(\@tied) croaked on its own first element.
					Same fix sum() had.*/
					SV *tv = av_slow_at(aTHX_ av, j);
					if (!tv)
						croak("uniq: undefined value at array ref index %" UVuf " (argument %" UVuf ")", (UV)j, (UV)i);
					uniq_take(aTHX_ T, tv, out, scratch, numbuf);
				}
			} else if (SvOK(arg)) {
				uniq_take(aTHX_ T, arg, out, scratch, numbuf);
			} else {
				croak("uniq: undefined value at argument index %" UVuf, (UV)i);
			}
		}
		if (gimme == G_SCALAR) {
			const UV n = (UV)T->ng;         //read before LEAVE frees T
			LEAVE;                          //dd_ctx_free releases the tables
			XPUSHs(sv_2mortal(newSVuv(n)));
		} else {
			outlen = av_len(out) + 1;
			LEAVE;
			EXTEND(SP, outlen);
			for (k = 0; k < outlen; k++)
				PUSHs(sv_2mortal(av_shift(out)));
		}

NV var(...)
	PROTOTYPE: @
	INIT:
	  NvAcc acc = { 0.0, 0.0, 0.0, 0 };
	  NV mean, m2 = 0.0, comp = 0.0;
	CODE:
	/*Two passes, not Welford.

	Welford's update carries a divide (mean += delta / count) in a
	loop-carried dependency chain, so every element waits on the previous
	one's ~14-cycle latency: 5.34 ns/element against 2.70 for two passes
	on 1e6 NVs (perl-5.44.0, -O2).

	The two-pass form is also what R computes. R's cov.c takes a first
	mean, refines it with a second pass (tmp = tmp + sum(x - tmp)/n, the
	MEAN macro) and only then sums the squared deviations about the
	refined mean. Expanding that third pass about the unrefined mean
	leaves sum((x-m)^2) - (sum(x-m))^2/n, so carrying the sum of the
	deviations alongside the sum of their squares gives R's answer in one
	pass fewer -- and it is the Chan-Golub-LeVeque correction, so it is
	no less accurate than Welford on an ill-centred column.

	Reading the arguments twice is visible only to a tied array, whose
	FETCH now runs once per pass.*/
		for (Stack_off_t i = 0; i < items; i++) {	//pass 1: the mean
			SV* arg = ST(i);
			if (SvROK(arg) && SvTYPE(SvRV(arg)) == SVt_PVAV) {
				AV* av = (AV*)SvRV(arg);
				SSize_t len = av_len(av) + 1, j = 0;
				if (!SvRMAGICAL((SV*)av)) av_scan_sum(av, &j, len, &acc);
				for (; j < len; j++) {
					SV* tv = av_slow_at(aTHX_ av, j);
					if (tv) {
						acc.sum += SvNV(tv);
						acc.count++;
					} else {
						croak("var: undefined value at array ref index %" UVuf " (argument %" UVuf ")", (UV)j, (UV)i);
					}
				}
			} else if (SvOK(arg)) {
				acc.sum += SvNV(arg);
				acc.count++;
			} else {
				croak("var: undefined value at argument index %" UVuf, (UV)i);
			}
		}
		if (acc.count < 2) croak("var needs >= 2 elements");
		mean = acc.sum / acc.count;
		for (Stack_off_t i = 0; i < items; i++) {	//pass 2: the deviations
			SV* arg = ST(i);
			if (SvROK(arg) && SvTYPE(SvRV(arg)) == SVt_PVAV) {
				AV* av = (AV*)SvRV(arg);
				SSize_t len = av_len(av) + 1, j = 0;
				if (!SvRMAGICAL((SV*)av)) av_scan_dev(av, &j, len, mean, &m2, &comp);
				for (; j < len; j++) {
					SV* tv = av_slow_at(aTHX_ av, j);
					if (tv) {
						NV d = SvNV(tv) - mean;
						m2 += d * d;
						comp += d;
					} else {
						croak("var: undefined value at array ref index %" UVuf " (argument %" UVuf ")", (UV)j, (UV)i);
					}
				}
			} else if (SvOK(arg)) {
				NV d = SvNV(arg) - mean;
				m2 += d * d;
				comp += d;
			} else {
				croak("var: undefined value at argument index %" UVuf, (UV)i);
			}
		}
		RETVAL = (m2 - comp * comp / acc.count) / (acc.count - 1);
	OUTPUT:
		RETVAL

NV skew(...)
	PROTOTYPE: @
	INIT:
	  moment_acc acc = { 0.0, 0.0, 0.0, 0.0, 0 };
	  IV type = 2;
	CODE:
		/*Sample skewness.  type 2 (the default) is G1, the estimator SAS,
		SPSS, Stata, Excel's SKEW() and scipy's bias=FALSE all report;
		type 1 is the plain moment ratio g1 (moments::skewness) and type 3
		is b1 (e1071::skewness's own default).*/
		moment_args(aTHX_ &ST(0), (size_t)items, "skew", &acc, &type);
		if (acc.n < 2) croak("skew needs >= 2 elements");
		if (type == 2 && acc.n < 3) croak("skew: type 2 needs >= 3 elements");
		{
			const NV n  = (NV)acc.n;
			const NV m2 = acc.m2 / n;
			if (!(m2 > 0.0))
				croak("skew: zero variance (all %" UVuf " values are equal), "
				      "so skewness is undefined", (UV)acc.n);
			const NV g1 = (acc.m3 / n) / nv_pow(m2, 1.5);
			RETVAL = type == 1 ? g1
			       : type == 2 ? g1 * nv_sqrt(n * (n - 1.0)) / (n - 2.0)
			       :             g1 * nv_pow((n - 1.0) / n, 1.5);
		}
	OUTPUT:
		RETVAL

NV kurtosis(...)
	PROTOTYPE: @
	INIT:
	  moment_acc acc = { 0.0, 0.0, 0.0, 0.0, 0 };
	  IV type = 2;
	CODE:
/*Excess kurtosis: 3 is already subtracted, so a normal sample sits
 near 0 rather than near 3.  type 2 (the default) is G2, as in SAS,
 SPSS, Stata, Excel's KURT() and scipy's bias=FALSE; type 1 is g2
 (moments::kurtosis minus 3) and type 3 is b2 (e1071::kurtosis's
 own default).*/
		moment_args(aTHX_ &ST(0), (size_t)items, "kurtosis", &acc, &type);
		if (acc.n < 2) croak("kurtosis needs >= 2 elements");
		if (type == 2 && acc.n < 4) croak("kurtosis: type 2 needs >= 4 elements");
		{
			const NV n  = (NV)acc.n;
			const NV m2 = acc.m2 / n;
			if (!(m2 > 0.0))
				croak("kurtosis: zero variance (all %" UVuf " values are "
				      "equal), so kurtosis is undefined", (UV)acc.n);
			const NV r  = (acc.m4 / n) / (m2 * m2);   //4th standardised moment
			RETVAL = type == 1 ? r - 3.0
			       : type == 2 ? ((n + 1.0) * (r - 3.0) + 6.0) * (n - 1.0)
			                     / ((n - 2.0) * (n - 3.0))
			       :             r * nv_pow(1.0 - 1.0 / n, 2.0) - 3.0;
		}
	OUTPUT:
		RETVAL

SV* t_test(...)
	CODE:
	{
		SV*x_sv = NULL;
		SV*y_sv = NULL;
		NV mu = 0.0, conf_level = NV_CONF_95;
		bool paired = FALSE, var_equal = FALSE;
		const char*alternative = "two.sided";
		Stack_off_t arg_idx = 0;
		// 1. Shift first positional argument as 'x' if it's an array reference
		if (arg_idx < items && SvROK(ST(arg_idx)) && SvTYPE(SvRV(ST(arg_idx))) == SVt_PVAV) {
		  x_sv = ST(arg_idx);
		  arg_idx++;
		}
		// 2. Shift second positional argument as 'y' if it's an array reference
		if (arg_idx < items && SvROK(ST(arg_idx)) && SvTYPE(SvRV(ST(arg_idx))) == SVt_PVAV) {
		  y_sv = ST(arg_idx);
		  arg_idx++;
		}
		// Ensure the remaining arguments form complete key-value pairs
		if ((items - arg_idx) % 2 != 0) {
		  croak("Usage: t_test(\\@x, [\\@y], key => value, ...)");
		}
		// Parse named arguments from the remaining flat stack
		for (; arg_idx < items; arg_idx += 2) {
			const char*key = SvPV_nolen(ST(arg_idx));
			SV*val = ST(arg_idx + 1);

			if      (strEQ(key, "x"))           x_sv        = val;
			else if (strEQ(key, "y"))           y_sv        = val;
			else if (strEQ(key, "mu"))          mu          = SvNV(val);
			else if (strEQ(key, "paired"))      paired      = SvTRUE(val);
			else if (strEQ(key, "var_equal"))   var_equal   = SvTRUE(val);
			else if (strEQ(key, "conf_level"))  conf_level  = SvNV(val);
			else if (strEQ(key, "alternative")) alternative = SvPV_nolen(val);
			else croak("t_test: unknown argument '%s'", key);
		}

		// Validate required / types
		if (!x_sv || !SvROK(x_sv) || SvTYPE(SvRV(x_sv)) != SVt_PVAV)
			croak("t_test: 'x' is a required argument and must be an ARRAY reference");
		AV*x_av = (AV*)SvRV(x_sv);
		/*'y' may be absent or an explicit undef -- R's default is y = NULL --
		but a defined non-array 'y' is a mistake worth refusing: dropping it
		silently runs a one-sample test on data meant for a comparison.*/
		AV*y_av = NULL;
		if (y_sv && SvOK(y_sv)) {
			if (!SvROK(y_sv) || SvTYPE(SvRV(y_sv)) != SVt_PVAV)
				croak("t_test: 'y' must be an ARRAY reference");
			y_av = (AV*)SvRV(y_sv);
		}
		/*R's match.arg(): an unrecognised alternative is an error there, where
		falling through to a two-sided test would answer a question nobody
		asked. scipy's "two-sided" spelling is unambiguous, so take it too.*/
		if (strEQ(alternative, "two-sided") || strEQ(alternative, "two_sided"))
			alternative = "two.sided";
		if (strNE(alternative, "two.sided") && strNE(alternative, "less")
		    && strNE(alternative, "greater"))
			croak("t_test: 'alternative' must be 'two.sided', 'less' or 'greater', "
			      "not '%s'", alternative);
		if (conf_level <= 0.0 || conf_level >= 1.0)
			croak("t_test: 'conf_level' must be between 0 and 1");
		if (paired && !y_av)
			croak("t_test: 'y' must be provided for paired or two-sample tests");

		//Computation via Welford's Algorithm
		NV mean_x = 0.0, var_x = NAN, mean_y = 0.0, var_y = NAN;
		NV t_stat, df, p_val, std_err, cint_est, constant_scale;
		/*which estimate keys the result carries; set with the branch below so
		the hash is only built once every croak is behind us*/
		enum { EST_MEAN_X, EST_MEAN_DIFF, EST_BOTH } estimates = EST_MEAN_X;

		if (paired) {
			/*R uses complete.cases(x, y): a pair goes whole if either side is
			NA, so the differences stay paired. Lengths are compared before
			any filtering, as complete.cases() refuses unequal ones.*/
			const size_t nx_raw = (size_t)(av_len(x_av) + 1);
			const size_t ny_raw = (size_t)(av_len(y_av) + 1);
			if (nx_raw != ny_raw) croak("t_test: Paired arrays must be same length");
			SV**x_a = AvARRAY(x_av);
			SV**y_a = AvARRAY(y_av);
			size_t n = 0;
			NV mean_d = 0.0, M2_d = 0.0;
			for (size_t i = 0; x_a && y_a && i < nx_raw; i++) {
				SV *xe = x_a[i], *ye = y_a[i];
				if (!xe || !SvOK(xe) || !ye || !SvOK(ye)) continue;
				const NV dx = SvNV(xe), dy = SvNV(ye);
				if (dx != dx || dy != dy) continue;
				const NV val = dx - dy;
				n++;
				const NV delta = val - mean_d;
				mean_d += delta / (NV)n;
				M2_d   += delta * (val - mean_d);
			}
			if (n < 2) croak("t_test: not enough complete pairs; need at least 2");
			const NV var_d = M2_d / (NV)(n - 1);
			cint_est       = mean_d;
			std_err        = nv_sqrt(var_d / (NV)n);
			df             = (NV)n - 1.0;
			constant_scale = nv_fabs(mean_d);
			estimates      = EST_MEAN_DIFF;
		} else if (y_av) {
			const size_t nx = t_test_scan(aTHX_ x_av, &mean_x, &var_x);
			const size_t ny = t_test_scan(aTHX_ y_av, &mean_y, &var_y);
			/*R's thresholds: a pooled variance can carry a group of one, since
			that group contributes no sum of squares, but a Welch test needs a
			variance from each side. Both were missing here, so an n = 1 'y'
			divided by (ny - 1) == 0 and returned NaN throughout.*/
			if (nx < 1 || (!var_equal && nx < 2))
				croak("t_test: not enough 'x' observations");
			if (ny < 1 || (!var_equal && ny < 2))
				croak("t_test: not enough 'y' observations");
			if (var_equal && nx + ny < 3)
				croak("t_test: not enough observations");
			cint_est       = mean_x - mean_y;
			constant_scale = nv_fmax(nv_fabs(mean_x), nv_fabs(mean_y));
			estimates      = EST_BOTH;
			if (var_equal) {
				df = (NV)nx + (NV)ny - 2.0;
				NV pooled_var = 0.0;
				if (nx > 1) pooled_var += ((NV)nx - 1.0) * var_x;
				if (ny > 1) pooled_var += ((NV)ny - 1.0) * var_y;
				pooled_var /= df;
				std_err = nv_sqrt(pooled_var * (1.0 / (NV)nx + 1.0 / (NV)ny));
			} else {
				const NV stderr_x2 = var_x / (NV)nx;
				const NV stderr_y2 = var_y / (NV)ny;
				std_err = nv_sqrt(stderr_x2 + stderr_y2);
				df = nv_pow(stderr_x2 + stderr_y2, 2) /
				     (nv_pow(stderr_x2, 2) / ((NV)nx - 1.0) + nv_pow(stderr_y2, 2) / ((NV)ny - 1.0));
			}
		} else {
			const size_t nx = t_test_scan(aTHX_ x_av, &mean_x, &var_x);
			if (nx < 2) croak("t_test: 'x' needs at least 2 elements");
			cint_est       = mean_x;
			std_err        = nv_sqrt(var_x / (NV)nx);
			df             = (NV)nx - 1.0;
			constant_scale = nv_fabs(mean_x);
		}
		/*R stops once the standard error has sunk into the rounding noise of
		the data's own magnitude, not only when the variance is exactly zero.
		An absolute test lets through a sample whose spread a double cannot
		resolve at that scale and reports the noise as an enormous t: four
		values around 1e10 differing by 1e-5 gave t = 4e15, p = 3e-47. The
		exactly-zero case is R's NaN, croaked rather than returned.*/
		if (std_err == 0.0
		    || (nv_isfinite(std_err) && std_err < 10.0 * DBL_EPSILON * constant_scale))
			croak("t_test: data are essentially constant");
		t_stat = (cint_est - mu) / std_err;
		p_val  = get_t_pvalue(t_stat, df, alternative);
		HV*results = newHV();
		switch (estimates) {
			case EST_MEAN_DIFF:
				hv_store(results, "estimate", 8, newSVnv(cint_est), 0);
				break;
			case EST_BOTH:
				hv_store(results, "estimate.x", 10, newSVnv(mean_x), 0);
				hv_store(results, "estimate.y", 10, newSVnv(mean_y), 0);
				break;
			default:
				hv_store(results, "estimate", 8, newSVnv(mean_x), 0);
		}
		NV alpha = 1.0 - conf_level, t_crit, ci_lower, ci_upper;
		if (strcmp(alternative, "less") == 0) {
			t_crit   = qt_tail(df, alpha);
			ci_lower = -INFINITY;
			ci_upper = cint_est + t_crit * std_err;
		} else if (strcmp(alternative, "greater") == 0) {
			t_crit   = qt_tail(df, alpha);
			ci_lower = cint_est - t_crit * std_err;
			ci_upper = INFINITY;
		} else {
			t_crit   = qt_tail(df, alpha / 2.0);
			ci_lower = cint_est - t_crit * std_err;
			ci_upper = cint_est + t_crit * std_err;
		}
		AV*conf_int = newAV();
		av_push(conf_int, newSVnv(ci_lower));
		av_push(conf_int, newSVnv(ci_upper));
		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 *alt = "two.sided";
	NV conf_level = NV_CONF_95;
	bool correct = 1;
	SV *p_sv = NULL;
	for (int i = 2; i + 1 < items; i += 2) {
		const char *key = SvPV_nolen(ST(i)); SV *v = ST(i + 1);
		if      (strEQ(key, "p"))            p_sv = v;
		else if (strEQ(key, "alternative"))  alt = SvPV_nolen(v);
		else if (strEQ(key, "conf_level") || strEQ(key, "conf.level")) conf_level = SvNV(v);
		else if (strEQ(key, "correct"))      correct = SvTRUE(v) ? 1 : 0;
		else croak("prop_test: unknown argument '%s'", key);
	}
	if (!(conf_level > 0.0 && conf_level < 1.0))
		croak("prop_test: conf.level must be between 0 and 1");
	if (strNE(alt, "two.sided") && strNE(alt, "less") && strNE(alt, "greater"))
		croak("prop_test: alternative must be 'two.sided', 'less' or 'greater'");

	//read x (successes) and n (trials): each a scalar or an array ref
	NV *x = NULL, *nn = NULL, *pnull = NULL;
	size_t k = 0;
	{
		SV *xsv = ST(0), *nsv = ST(1);
		if (SvROK(xsv) && SvTYPE(SvRV(xsv)) == SVt_PVAV) {
			AV *av = (AV*)SvRV(xsv); k = (size_t)(av_len(av) + 1);
			if (k == 0) croak("prop_test: 'x' is empty");
			Newx(x, k, NV);
			for (size_t i = 0; i < k; i++) { SV **e = av_fetch(av, i, 0); x[i] = (e && *e) ? SvNV(*e) : NAN; }
		} else { k = 1; Newx(x, 1, NV); x[0] = SvNV(xsv); }
		size_t kn;
		if (SvROK(nsv) && SvTYPE(SvRV(nsv)) == SVt_PVAV) {
			AV *av = (AV*)SvRV(nsv); kn = (size_t)(av_len(av) + 1);
			Newx(nn, kn, NV);
			for (size_t i = 0; i < kn; i++) { SV **e = av_fetch(av, i, 0); nn[i] = (e && *e) ? SvNV(*e) : NAN; }
		} else { kn = 1; Newx(nn, 1, NV); nn[0] = SvNV(nsv); }
		if (kn != k) { Safefree(x); Safefree(nn); croak("prop_test: 'x' and 'n' must have the same length"); }
	}
	for (size_t i = 0; i < k; i++) {
		if (nn[i] <= 0)          { Safefree(x); Safefree(nn); croak("prop_test: elements of 'n' must be positive"); }
		if (x[i] < 0)            { Safefree(x); Safefree(nn); croak("prop_test: elements of 'x' must be nonnegative"); }
		if (x[i] > nn[i])        { Safefree(x); Safefree(nn); croak("prop_test: elements of 'x' must not exceed 'n'"); }
	}

	//null probabilities and degrees of freedom
	bool p_is_null;   //true => testing equality (pooled p, df = k-1)
	Newx(pnull, k, NV);
	if (p_sv && SvOK(p_sv)) {
		p_is_null = FALSE;
		if (SvROK(p_sv) && SvTYPE(SvRV(p_sv)) == SVt_PVAV) {
			AV *av = (AV*)SvRV(p_sv);
			if ((size_t)(av_len(av) + 1) != k) { Safefree(x); Safefree(nn); Safefree(pnull); croak("prop_test: 'p' must have the same length as 'x'"); }
			for (size_t i = 0; i < k; i++) { SV **e = av_fetch(av, i, 0); pnull[i] = (e && *e) ? SvNV(*e) : NAN; }
		} else { NV pv = SvNV(p_sv); for (size_t i = 0; i < k; i++) pnull[i] = pv; }
		for (size_t i = 0; i < k; i++)
			if (!(pnull[i] > 0.0 && pnull[i] < 1.0)) { Safefree(x); Safefree(nn); Safefree(pnull); croak("prop_test: elements of 'p' must be in (0,1)"); }
	} else if (k == 1) {
		p_is_null = FALSE; pnull[0] = 0.5;   //one-sample default target
	} else {
		p_is_null = TRUE;
		NV sx = 0.0, sn = 0.0;
		for (size_t i = 0; i < k; i++) { sx += x[i]; sn += nn[i]; }
		NV pooled = sx / sn;
		for (size_t i = 0; i < k; i++) pnull[i] = pooled;
	}
	/*R forces a two-sided test whenever a one-sided one is not meaningful:
	more than two groups, or exactly two groups tested against given p.*/
	bool p_given = (p_sv && SvOK(p_sv));
	if (k > 2 || (k == 2 && p_given)) alt = "two.sided";

	NV YATES = (correct && k <= 2) ? 0.5 : 0.0;

	// estimates
	NV *est = NULL; Newx(est, k, NV);
	for (size_t i = 0; i < k; i++) est[i] = x[i] / nn[i];

	NV ci_lo = NAN, ci_hi = NAN; bool have_ci = FALSE;
	NV delta = 0.0;
	if (k == 1) {
		NV cap = nv_fabs(x[0] - nn[0] * pnull[0]);
		if (cap < YATES) YATES = cap;
		NV z  = std_qnorm(strEQ(alt, "two.sided") ? (1.0 + conf_level) / 2.0 : conf_level);
		NV z22n = z * z / (2.0 * nn[0]);
		NV pcu = est[0] + YATES / nn[0];
		NV p_u = (pcu >= 1.0) ? 1.0 : (pcu + z22n + z * nv_sqrt(pcu * (1.0 - pcu) / nn[0] + z22n / (2.0 * nn[0]))) / (1.0 + 2.0 * z22n);
		NV pcl = est[0] - YATES / nn[0];
		NV p_l = (pcl <= 0.0) ? 0.0 : (pcl + z22n - z * nv_sqrt(pcl * (1.0 - pcl) / nn[0] + z22n / (2.0 * nn[0]))) / (1.0 + 2.0 * z22n);
		if      (strEQ(alt, "two.sided")) { ci_lo = p_l < 0.0 ? 0.0 : p_l; ci_hi = p_u > 1.0 ? 1.0 : p_u; }
		else if (strEQ(alt, "greater"))   { ci_lo = p_l < 0.0 ? 0.0 : p_l; ci_hi = 1.0; }
		else                              { ci_lo = 0.0; ci_hi = p_u > 1.0 ? 1.0 : p_u; }
		have_ci = TRUE;
	} else if (k == 2 && p_is_null) {
		delta = est[0] - est[1];
		NV inv_sum = 1.0 / nn[0] + 1.0 / nn[1];
		NV cap = nv_fabs(delta) / inv_sum;
		if (cap < YATES) YATES = cap;
		NV z = std_qnorm(strEQ(alt, "two.sided") ? (1.0 + conf_level) / 2.0 : conf_level);
		NV width = z * nv_sqrt(est[0] * (1.0 - est[0]) / nn[0] + est[1] * (1.0 - est[1]) / nn[1]) + YATES * inv_sum;
		if      (strEQ(alt, "two.sided")) { ci_lo = (delta - width < -1.0) ? -1.0 : delta - width; ci_hi = (delta + width > 1.0) ? 1.0 : delta + width; }
		else if (strEQ(alt, "greater"))   { ci_lo = (delta - width < -1.0) ? -1.0 : delta - width; ci_hi = 1.0; }
		else                              { ci_lo = -1.0; ci_hi = (delta + width > 1.0) ? 1.0 : delta + width; }
		have_ci = TRUE;
	}

	int df = p_is_null ? (int)(k - 1) : (int)k;

	//Pearson chi-square with (capped) Yates correction
	NV stat = 0.0;
	for (size_t i = 0; i < k; i++) {
		NV E0 = nn[i] * pnull[i], E1 = nn[i] * (1.0 - pnull[i]);
		NV o0 = x[i], o1 = nn[i] - x[i];
		NV d0 = nv_fabs(o0 - E0) - YATES;   //R does not floor this at 0
		NV d1 = nv_fabs(o1 - E1) - YATES;
		stat += d0 * d0 / E0 + d1 * d1 / E1;
	}

	NV p_value;
	if (strEQ(alt, "two.sided")) {
		p_value = get_p_value(stat, df);
	} else {
		NV z = (k == 1) ? ((est[0] > pnull[0]) - (est[0] < pnull[0])) * nv_sqrt(stat)
		                : ((delta > 0.0) - (delta < 0.0)) * nv_sqrt(stat);
		p_value = strEQ(alt, "less") ? approx_pnorm(z) : 1.0 - approx_pnorm(z);
	}

	// Chi-square approximation warning, as in R
	for (size_t i = 0; i < k; i++)
		if (nn[i] * pnull[i] < 5.0 || nn[i] * (1.0 - pnull[i]) < 5.0) {
			warn("prop_test: Chi-squared approximation may be incorrect");
			break;
		}

	HV *ret = newHV();
	hv_stores(ret, "statistic",   newSVnv(stat));
	hv_stores(ret, "parameter",   newSViv(df));
	hv_stores(ret, "p.value",     newSVnv(p_value));
	hv_stores(ret, "alternative", newSVpv(alt, 0));
	hv_stores(ret, "conf.level",  newSVnv(conf_level));
	{
		char method[96];
		if (k == 1) snprintf(method, sizeof method, "1-sample proportions test %s continuity correction", YATES > 0.0 ? "with" : "without");
		else snprintf(method, sizeof method, "%zu-sample test for %s proportions %s continuity correction",
			k, p_is_null ? "equality of" : "given", YATES > 0.0 ? "with" : "without");
		hv_stores(ret, "method", newSVpv(method, 0));
	}
	{
		AV *ev = newAV();
		for (size_t i = 0; i < k; i++) av_push(ev, newSVnv(est[i]));
		hv_stores(ret, "estimate", newRV_noinc((SV*)ev));
	}
	if (have_ci) {
		AV *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;
	NV *tab = NULL;

	bool is_matrix = FALSE;
	if (SvROK(ST(0)) && SvTYPE(SvRV(ST(0))) == SVt_PVAV
		&& av_len((AV*)SvRV(ST(0))) >= 0) {
		SV **e0 = av_fetch((AV*)SvRV(ST(0)), 0, 0);
		is_matrix = e0 && *e0 && SvROK(*e0) && SvTYPE(SvRV(*e0)) == SVt_PVAV;
	}

	if (is_matrix) {
		AV *m = (AV*)SvRV(ST(0));
		r = (size_t)(av_len(m) + 1);
		if (r < 2) croak("mcnemar_test: matrix must have at least two rows");
		Newxz(tab, r * r, NV);
		for (size_t i = 0; i < r; i++) {
			SV **row = av_fetch(m, i, 0);
			if (!row || !*row || !SvROK(*row) || SvTYPE(SvRV(*row)) != SVt_PVAV)
				{ Safefree(tab); croak("mcnemar_test: row %" UVuf " is not an array ref", (UV)i); }
			AV *rv = (AV*)SvRV(*row);
			if ((size_t)(av_len(rv) + 1) != r) { Safefree(tab); croak("mcnemar_test: matrix must be square"); }
			for (size_t j = 0; j < r; j++) {
				SV **c = av_fetch(rv, j, 0);
				NV v = (c && *c) ? SvNV(*c) : 0.0;
				if (v < 0 || nv_isnan(v)) { Safefree(tab); croak("mcnemar_test: entries must be nonnegative and finite"); }
				tab[i * r + j] = v;
			}
		}
		opt_start = 1;
	} else {
		if (items < 2 || !SvROK(ST(0)) || !SvROK(ST(1))
			|| SvTYPE(SvRV(ST(0))) != SVt_PVAV || SvTYPE(SvRV(ST(1))) != SVt_PVAV)
			croak("mcnemar_test: expected a square matrix or two array refs");
		AV *xa = (AV*)SvRV(ST(0)), *ya = (AV*)SvRV(ST(1));
		size_t n = (size_t)(av_len(xa) + 1);
		if ((size_t)(av_len(ya) + 1) != n) croak("mcnemar_test: 'x' and 'y' must have the same length");
		//collect sorted unique levels across both vectors
		char **lev = NULL; size_t nlev = 0, cap = 8; Newx(lev, cap, char*);
		for (size_t src = 0; src < 2; src++) {
			AV *a = src ? ya : xa;
			for (size_t i = 0; i < n; i++) {
				SV **e = av_fetch(a, i, 0);
				if (!e || !*e || !SvOK(*e)) continue;
				STRLEN l; const char *s = SvPV(*e, l);
				bool found = FALSE;
				for (size_t k = 0; k < nlev; k++) if (strEQ(lev[k], s)) { found = TRUE; break; }
				if (!found) { if (nlev >= cap) { cap *= 2; Renew(lev, cap, char*); } lev[nlev++] = savepvn(s, l); }
			}
		}
		//sort levels lexically for a deterministic table order
		for (size_t a = 0; a + 1 < nlev; a++) for (size_t b = a + 1; b < nlev; b++)
			if (strcmp(lev[a], lev[b]) > 0) { char *t = lev[a]; lev[a] = lev[b]; lev[b] = t; }
		r = nlev;
		if (r < 2) { for (size_t k = 0; k < nlev; k++) Safefree(lev[k]); Safefree(lev); croak("mcnemar_test: need at least two levels"); }
		Newxz(tab, r * r, NV);
		for (size_t i = 0; i < n; i++) {
			SV **ex = av_fetch(xa, i, 0), **ey = av_fetch(ya, i, 0);
			if (!ex || !*ex || !SvOK(*ex) || !ey || !*ey || !SvOK(*ey)) continue;
			STRLEN lx, ly; const char *sx = SvPV(*ex, lx), *sy = SvPV(*ey, ly);
			size_t ix = 0, iy = 0;
			for (size_t k = 0; k < r; k++) { if (strEQ(lev[k], sx)) ix = k; if (strEQ(lev[k], sy)) iy = k; }
			tab[ix * r + iy] += 1.0;
		}
		for (size_t k = 0; k < nlev; k++) Safefree(lev[k]);
		Safefree(lev);
		opt_start = 2;
	}
	for (int i = opt_start; i + 1 < items; i += 2) {
		const char *k = SvPV_nolen(ST(i)); SV *v = ST(i + 1);
		if      (strEQ(k, "correct")) correct = SvTRUE(v) ? 1 : 0;
		else if (strEQ(k, "exact"))   exact   = SvTRUE(v) ? 1 : 0;
		else { Safefree(tab); croak("mcnemar_test: unknown argument '%s'", k); }
	}
	if (exact && r != 2) { Safefree(tab); croak("mcnemar_test: exact test requires a 2x2 table"); }

	HV *ret = newHV();
	if (exact) {// two-sided exact binomial test of the discordant pairs, b ~ Bin(b+c, 0.5)
		NV b = tab[0 * 2 + 1], c = tab[1 * 2 + 0];
		NV nn = b + c, m = (b < c) ? b : c;
		NV p_value;
		if (nn == 0.0) p_value = 1.0;
		else {
			NV s = 0.0, lognn2 = nn * nv_log(2.0);
			for (NV kk = 0.0; kk <= m; kk += 1.0) s += nv_exp(ft_lchoose((long)nn, (long)kk) - lognn2);
			p_value = 2.0 * s; if (p_value > 1.0) p_value = 1.0;
		}
		hv_stores(ret, "statistic",   newSVnv(b));
		hv_stores(ret, "p.value",     newSVnv(p_value));
		hv_stores(ret, "method",      newSVpv("McNemar's test (exact binomial)", 0));
	} else {
		bool use_cc = 0;
		if (correct && r == 2) {
			for (size_t i = 0; i < r && !use_cc; i++)
				for (size_t j = 0; j < r; j++)
					if (tab[i * r + j] != tab[j * r + i]) { use_cc = 1; break; }
		}
		NV stat = 0.0;
		for (size_t i = 0; i < r; i++)
			for (size_t j = i + 1; j < r; j++) {
				NV diff = tab[i * r + j] - tab[j * r + i];
				NV sum  = tab[i * r + j] + tab[j * r + i];
				if (sum <= 0.0) continue;
				NV num = use_cc ? (nv_fabs(diff) - 1.0) : diff;
				stat += num * num / sum;
			}
		int df = (int)(r * (r - 1) / 2);
		NV p_value = get_p_value(stat, df);
		hv_stores(ret, "statistic", newSVnv(stat));
		hv_stores(ret, "parameter", newSViv(df));
		hv_stores(ret, "p.value",   newSVnv(p_value));
		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 *method = "holm";
	for (int i = 2; i + 1 < items; i += 2) {
		const char *key = SvPV_nolen(ST(i)); SV *v = ST(i + 1);
		if (strEQ(key, "method")) method = SvPV_nolen(v);
		else croak("dunn_test: unknown argument '%s'", key);
	}
	char meth[32]; strncpy(meth, method, 31); meth[31] = '\0';
	for (unsigned i = 0; meth[i]; i++) meth[i] = tolower(meth[i]);
	if (strEQ(meth, "fdr")) strcpy(meth, "bh");
	if (strEQ(meth, "holm-sidak")) strcpy(meth, "hs");

	AV *xa = (AV*)SvRV(ST(0)), *ga = (AV*)SvRV(ST(1));
	size_t raw = (size_t)(av_len(xa) + 1);
	if ((size_t)(av_len(ga) + 1) != raw) croak("dunn_test: values and groups must have the same length");

	//gather complete (value, group) pairs
	NV *x = NULL; char **glab = NULL;
	Newx(x, raw, NV); Newx(glab, raw, char*);
	size_t N = 0;
	for (size_t i = 0; i < raw; i++) {
		SV **xv = av_fetch(xa, i, 0), **gv = av_fetch(ga, i, 0);
		if (!xv || !*xv || !SvOK(*xv) || !looks_like_number(*xv)) continue;
		if (!gv || !*gv || !SvOK(*gv)) continue;
		NV val = SvNV(*xv); if (nv_isnan(val)) continue;
		STRLEN l; const char *s = SvPV(*gv, l);
		x[N] = val; glab[N] = savepvn(s, l); N++;
	}
	if (N < 3) { for (size_t i = 0; i < N; i++) Safefree(glab[i]); Safefree(x); Safefree(glab); croak("dunn_test: not enough complete observations"); }
	// sorted unique group levels
	char **lev = NULL; size_t k = 0, cap = 8; Newx(lev, cap, char*);
	for (size_t i = 0; i < N; i++) {
		bool found = FALSE;
		for (size_t j = 0; j < k; j++) if (strEQ(lev[j], glab[i])) { found = TRUE; break; }
		if (!found) { if (k >= cap) { cap *= 2; Renew(lev, cap, char*); } lev[k++] = savepv(glab[i]); }
	}
	for (size_t a = 0; a + 1 < k; a++) for (size_t b = a + 1; b < k; b++)
		if (strcmp(lev[a], lev[b]) > 0) { char *t = lev[a]; lev[a] = lev[b]; lev[b] = t; }
	if (k < 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); croak("dunn_test: need at least two groups"); }

	//ranks over all observations (tie-averaged)
	NV *r = NULL; Newx(r, N, NV);
	rank_data(x, r, N);

	//per-group rank sums and sizes
	NV *rsum = NULL; size_t *ns = NULL;
	Newxz(rsum, k, NV); Newxz(ns, k, size_t);
	for (size_t i = 0; i < N; i++) {
		size_t gi = 0;
		for (size_t j = 0; j < k; j++) if (strEQ(lev[j], glab[i])) { gi = j; break; }
		rsum[gi] += r[i]; ns[gi]++;
	}
	//tie correction: sum over distinct values of (t^3 - t)
	NV *xs = NULL; Newx(xs, N, NV);
	memcpy(xs, x, N * sizeof(NV));
	qsort(xs, N, sizeof(NV), cmp_nv3);
	NV tsum = 0.0;
	{
		size_t a = 0;
		while (a < N) {
			size_t b = a;
			while (b + 1 < N && xs[b + 1] == xs[a]) b++;
			NV t = (NV)(b - a + 1);
			tsum += t * t * t - t;
			a = b + 1;
		}
	}
	Safefree(xs);
	NV Nf = (NV)N;
	NV sigma_base = (Nf * (Nf + 1.0)) / 12.0 - tsum / (12.0 * (Nf - 1.0));
	size_t m = k * (k - 1) / 2;
	NV *z = NULL, *praw = NULL, *padj = NULL;
	Newx(z, m, NV); Newx(praw, m, NV); Newx(padj, m, NV);
	size_t *gi_ = NULL, *gj_ = NULL;
	Newx(gi_, m, size_t); Newx(gj_, m, size_t);
	size_t c = 0;
	for (size_t i = 0; i < k; i++)
		for (size_t j = i + 1; j < k; j++) {
			NV rbar_i = rsum[i] / ns[i], rbar_j = rsum[j] / ns[j];
			NV se = nv_sqrt(sigma_base * (1.0 / ns[i] + 1.0 / ns[j]));
			NV zz = (rbar_i - rbar_j) / se;
			z[c] = zz;
			praw[c] = 2.0 * (1.0 - approx_pnorm(nv_fabs(zz)));
			if (praw[c] > 1.0) praw[c] = 1.0;
			gi_[c] = i; gj_[c] = j;
			c++;
		}
	dunn_padjust(praw, m, meth, padj);

	AV *out = newAV();
	for (size_t t = 0; t < m; t++) {
		HV *h = newHV();
		char comp[256];
		snprintf(comp, sizeof comp, "%s - %s", lev[gi_[t]], lev[gj_[t]]);
		hv_stores(h, "comparison", newSVpv(comp, 0));
		hv_stores(h, "group1",     newSVpv(lev[gi_[t]], 0));
		hv_stores(h, "group2",     newSVpv(lev[gj_[t]], 0));
		hv_stores(h, "Z",          newSVnv(z[t]));
		hv_stores(h, "p.value",    newSVnv(praw[t]));
		hv_stores(h, "p.adjust",   newSVnv(padj[t]));
		av_push(out, newRV_noinc((SV*)h));
	}

	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 *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)");

	// determine k from the first row
	SV **r0 = av_fetch(m, 0, 0);
	if (!r0 || !*r0 || !SvROK(*r0) || SvTYPE(SvRV(*r0)) != SVt_PVAV)
		croak("friedman_test: each row must be an array ref");
	size_t k = (size_t)(av_len((AV*)SvRV(*r0)) + 1);
	if (k < 2) croak("friedman_test: need at least two treatments (columns)");

	NV *colsum = NULL; Newxz(colsum, k, NV);
	NV *rowbuf = NULL; Newx(rowbuf, k, NV);
	NV *ranks  = NULL; Newx(ranks, k, NV);
	NV *sorted = NULL; Newx(sorted, k, NV);
	NV tie_sum = 0.0;
	size_t n = 0; // complete blocks actually used

	for (size_t i = 0; i < nrow_raw; i++) {
		SV **rr = av_fetch(m, i, 0);
		if (!rr || !*rr || !SvROK(*rr) || SvTYPE(SvRV(*rr)) != SVt_PVAV)
			{ Safefree(colsum); Safefree(rowbuf); Safefree(ranks); Safefree(sorted); croak("friedman_test: row %" UVuf " is not an array ref", (UV)i); }
		AV *rv = (AV*)SvRV(*rr);
		if ((size_t)(av_len(rv) + 1) != k)
			{ Safefree(colsum); Safefree(rowbuf); Safefree(ranks); Safefree(sorted); croak("friedman_test: all rows must have the same number of columns"); }
		bool complete = TRUE;
		for (size_t j = 0; j < k; j++) {
			SV **c = av_fetch(rv, j, 0);
			if (!c || !*c || !SvOK(*c) || !looks_like_number(*c)) { complete = FALSE; break; }
			rowbuf[j] = SvNV(*c);
			if (nv_isnan(rowbuf[j])) { complete = FALSE; break; }
		}
		if (!complete) continue;   //drop incomplete blocks, like R's complete.cases

		rank_data(rowbuf, ranks, k);
		for (size_t j = 0; j < k; j++) colsum[j] += ranks[j];

		//tie correction: sum over tie groups of (u^3 - u) within this block
		memcpy(sorted, rowbuf, k * sizeof(NV));
		qsort(sorted, k, sizeof(NV), cmp_nv3);
		size_t a = 0;
		while (a < k) {
			size_t b = a;
			while (b + 1 < k && sorted[b + 1] == sorted[a]) b++;
			NV u = (NV)(b - a + 1);
			tie_sum += u * u * u - u;
			a = b + 1;
		}
		n++;
	}
	Safefree(rowbuf); Safefree(ranks); Safefree(sorted);
	if (n < 1) { Safefree(colsum); croak("friedman_test: no complete blocks"); }

	NV nf = (NV)n, kf = (NV)k;
	NV ssq = 0.0, target = nf * (kf + 1.0) / 2.0;
	for (size_t j = 0; j < k; j++) { NV d = colsum[j] - target; ssq += d * d; }
	Safefree(colsum);
	NV denom = nf * kf * (kf + 1.0) - tie_sum / (kf - 1.0);
	NV stat = 12.0 * ssq / denom;
	int df = (int)(k - 1);
	NV p_value = get_p_value(stat, df);

	HV *ret = newHV();
	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 = NV_CONF_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 {
		if (items < 4)
			croak("epi_2x2: need 4 cell counts a,b,c,d (or a single 2x2 array ref)");
		a = SvNV(ST(0)); b = SvNV(ST(1)); c = SvNV(ST(2)); d = SvNV(ST(3));
		if (a < 0 || b < 0 || c < 0 || d < 0)
			croak("epi_2x2: cell counts must be non-negative");
		opt_start = 4;
	}
	for (int i = opt_start; i + 1 < items; i += 2) {
		const char *k = SvPV_nolen(ST(i)); SV *v = ST(i + 1);
		if      (strEQ(k, "conf_level") || strEQ(k, "conf.level")) conf_level = SvNV(v);
		else if (strEQ(k, "correct"))                              correct = SvTRUE(v) ? 1 : 0;
		else croak("epi_2x2: unknown argument '%s'", k);
	}
	if (!(conf_level > 0.0 && conf_level < 1.0))
		croak("epi_2x2: conf_level must be between 0 and 1");

	/*Haldane-Anscombe +0.5 when asked, or forced by a zero cell (avoids
	division by zero / log of zero).  Point estimates then shift too, so
	the applied flag is reported back.*/
	NV A = a, B = b, C = c, D = d; int corrected = 0;
	if (correct || a == 0 || b == 0 || c == 0 || d == 0) {
		A += 0.5; B += 0.5; C += 0.5; D += 0.5; corrected = 1;
	}
	NV z  = std_qnorm(1.0 - (1.0 - conf_level) / 2.0);
	NV n1 = A + B, n0 = C + D;

	NV or_    = (A * D) / (B * C);
	NV se_lor = nv_sqrt(1.0 / A + 1.0 / B + 1.0 / C + 1.0 / D);
	NV or_lo  = or_ * nv_exp(-z * se_lor), or_hi = or_ * nv_exp(z * se_lor);

	NV p1 = A / n1, p0 = C / n0;
	NV rr     = p1 / p0;                          //Katz log-RR variance
	NV se_lrr = nv_sqrt(B / (A * n1) + D / (C * n0));
	NV rr_lo  = rr * nv_exp(-z * se_lrr), rr_hi = rr * nv_exp(z * se_lrr);

	NV rd    = p1 - p0;
	NV se_rd = nv_sqrt(p1 * (1.0 - p1) / n1 + p0 * (1.0 - p0) / n0);
	NV rd_lo = rd - z * se_rd, rd_hi = rd + z * se_rd;

	HV *ret = newHV();
	hv_stores(ret, "method",         newSVpv("2x2 epidemiological measures (Wald)", 0));
	hv_stores(ret, "conf.level",     newSVnv(conf_level));
	hv_stores(ret, "correction",     newSViv(corrected));
	hv_stores(ret, "odds.ratio",     newSVnv(or_));
	hv_stores(ret, "risk.ratio",     newSVnv(rr));
	hv_stores(ret, "risk.diff",      newSVnv(rd));
	hv_stores(ret, "risk.exposed",   newSVnv(p1));
	hv_stores(ret, "risk.unexposed", newSVnv(p0));
	hv_stores(ret, "nnt",            newSVnv(1.0 / nv_fabs(rd)));
#define EPI_CI(name, lo, hi) do { AV *ci = newAV(); \
	av_push(ci, newSVnv(lo)); av_push(ci, newSVnv(hi)); \
	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 *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 = NV_CONF_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);
		if      (strEQ(k, "conf_level") || strEQ(k, "conf.level")) conf_level = SvNV(v);
		else if (strEQ(k, "correct"))                              correct = SvTRUE(v) ? 1 : 0;
		else croak("cmh_test: unknown argument '%s'", k);
	}
	if (!(conf_level > 0.0 && conf_level < 1.0))
		croak("cmh_test: conf_level must be between 0 and 1");

	NV sum_a = 0, E = 0, V = 0;      //CMH statistic pieces
	NV sumR = 0, sumS = 0;           //Mantel-Haenszel common-OR num/den
	NV vR = 0, vRS = 0, vS = 0;      //Robins-Breslow-Greenland variance
	for (SSize_t s = 0; s < K; s++) {
		SV **ep = av_fetch(strata, s, 0);
		NV a, b, c, d;
		epi_read_2x2(aTHX_ (ep ? *ep : &PL_sv_undef), "cmh_test", &a, &b, &c, &d);
		NV n = a + b + c + d;
		if (n <= 0) continue;
		NV r1 = a + b, r2 = c + d, c1 = a + c, c2 = b + d;
		sum_a += a;
		E     += r1 * c1 / n;
		if (n > 1.0) V += (r1 * r2 * c1 * c2) / (n * n * (n - 1.0));
		NV Rk = a * d / n, Sk = b * c / n;
		sumR += Rk; sumS += Sk;
		NV Pk = (a + d) / n, Qk = (b + c) / n;
		vR  += Pk * Rk;
		vRS += Pk * Sk + Qk * Rk;
		vS  += Qk * Sk;
	}
	NV diff = nv_fabs(sum_a - E) - (correct ? 0.5 : 0.0);
	if (diff < 0) diff = 0;
	NV chi  = (V > 0) ? (diff * diff) / V : 0.0;
	NV pval = get_p_value(chi, 1);

	NV or_mh    = (sumS > 0) ? sumR / sumS : NAN;
	NV var_lnor = vR / (2.0 * sumR * sumR)
	            + vRS / (2.0 * sumR * sumS)
	            + vS / (2.0 * sumS * sumS);
	NV z     = std_qnorm(1.0 - (1.0 - conf_level) / 2.0);
	NV or_lo = or_mh * nv_exp(-z * nv_sqrt(var_lnor)), or_hi = or_mh * nv_exp(z * nv_sqrt(var_lnor));

	HV *ret = newHV();
	hv_stores(ret, "method", newSVpv(correct
		? "Mantel-Haenszel chi-squared test with continuity correction"
		: "Mantel-Haenszel chi-squared test", 0));
	hv_stores(ret, "statistic",  newSVnv(chi));
	hv_stores(ret, "parameter",  newSViv(1));       //degrees of freedom
	hv_stores(ret, "p.value",    newSVnv(pval));
	hv_stores(ret, "estimate",   newSVnv(or_mh));   //common odds ratio
	hv_stores(ret, "conf.level", newSVnv(conf_level));
	hv_stores(ret, "correction", newSViv(correct));
	hv_stores(ret, "k",          newSViv((IV)K));
	AV *ci = newAV(); av_push(ci, newSVnv(or_lo)); av_push(ci, newSVnv(or_hi));
	hv_stores(ret, "conf.int", newRV_noinc((SV *)ci));
	ST(0) = sv_2mortal(newRV_noinc((SV *)ret));
	XSRETURN(1);
}

NV auc(...)
CODE:
{
	if (items < 2 || !SvROK(ST(0)) || SvTYPE(SvRV(ST(0))) != SVt_PVAV
	              || !SvROK(ST(1)) || SvTYPE(SvRV(ST(1))) != SVt_PVAV)
		croak("Usage: auc(\\@scores, \\@labels, positive => 1, direction => '>')");
	const char *positive = "1"; bool lower_pos = 0;
	for (int i = 2; i + 1 < items; i += 2) {
		const char *k = SvPV_nolen(ST(i)); SV *v = ST(i + 1);
		if      (strEQ(k, "positive"))  positive = SvPV_nolen(v);
		else if (strEQ(k, "direction")) { const char *d = SvPV_nolen(v); lower_pos = (d[0] == '<'); }
		else croak("auc: unknown argument '%s'", k);
	}
	NV *pos, *neg; size_t m, n;
	roc_split(aTHX_ (AV *)SvRV(ST(0)), (AV *)SvRV(ST(1)), positive, lower_pos,
	          &pos, &m, &neg, &n, "auc");
	NV a, se; roc_delong(aTHX_ pos, m, neg, n, &a, &se);
	Safefree(pos); Safefree(neg);
	RETVAL = a;
}
OUTPUT:
	RETVAL

NV auroc(...)
CODE:
{
/*sklearn-style AUROC: auroc(\@y_true, \@y_score, ...) -- LABELS first,
 SCORES second, higher score = positive class.  This mirrors the call the
 ~/ui/pep-priml scripts make, sklearn.metrics.roc_auc_score(y_true,
 y_score) (e.g. _compute.py's roc_auc_score(y_te, fold_scores) and the
 figs' roc_auc_score(y_true_bin, -pred)).  Ties count 0.5 (Mann-Whitney /
 DeLong midranks), so the number matches sklearn exactly.  Returns the
 scalar AUC; use roc() for the full curve, SE and CI, or auc() for the
 same number with the (scores, labels) argument order.
 
 The pep-priml "roc_auc_score(y_true_bin, -pred)" idiom (lower prediction
 = positive, truth derived from a continuous column by a percentile cut)
 is reproduced in one call: pass direction => '<' instead of negating the
 scores, and cutoff / active_frac to binarize a continuous truth column
 the way y_true_bin = (exp <= threshold) does.*/
	if (items < 2 || !SvROK(ST(0)) || SvTYPE(SvRV(ST(0))) != SVt_PVAV
	              || !SvROK(ST(1)) || SvTYPE(SvRV(ST(1))) != SVt_PVAV)
		croak("Usage: auroc(\\@y_true, \\@y_score, positive => 1, "
		      "direction => '>', cutoff => x, active_frac => 0.1, "
		      "active_side => 'high')");
	const char *positive = "1"; bool lower_pos = 0;
	bool have_cutoff = 0, have_frac = 0; NV cutoff = 0.0, active_frac = 0.0;
	bool frac_low = 0;
	for (int i = 2; i + 1 < items; i += 2) {
		const char *k = SvPV_nolen(ST(i)); SV *v = ST(i + 1);
		if      (strEQ(k, "positive"))  positive = SvPV_nolen(v);
		else if (strEQ(k, "direction")) { const char *d = SvPV_nolen(v); lower_pos = (d[0] == '<'); }
		else if (strEQ(k, "cutoff"))    { have_cutoff = 1; cutoff = SvNV(v); }
		else if (strEQ(k, "active_frac") || strEQ(k, "active")) { have_frac = 1; active_frac = SvNV(v); }
		else if (strEQ(k, "active_side")) {
			const char *sd = SvPV_nolen(v); // 'low'/'bottom' vs 'high'/'top'
			frac_low = (sd[0] == 'l' || sd[0] == 'L' || sd[0] == 'b' || sd[0] == 'B');
		}
		else croak("auroc: unknown argument '%s'", k);
	}
	if (have_frac && have_cutoff)
		croak("auroc: give either cutoff => or active_frac =>, not both");
	if (have_frac && !(active_frac > 0.0 && active_frac < 1.0))
		croak("auroc: active_frac must be strictly between 0 and 1");

	AV *lav = (AV *)SvRV(ST(0));   //y_true  (labels first, like sklearn)
	AV *sav = (AV *)SvRV(ST(1));   //y_score

	if (have_cutoff || have_frac) {
		/*Binarize a continuous truth column, then DeLong on the pos/neg
		score vectors -- same shape as bedroc's cutoff/active_frac.*/
		SSize_t Ns = av_len(sav) + 1;
		if (Ns != av_len(lav) + 1)
			croak("auroc: y_true and y_score must be the same length");
		if (Ns < 1) croak("auroc: need at least one observation");
		size_t N = (size_t)Ns;
		int *act; Newxz(act, N, int);
		if (have_frac) {
			size_t n_a = (size_t)nv_ceil(active_frac * (NV)N);
			if (n_a < 1) n_a = 1;
			if (N >= 2 && n_a > N - 1) n_a = N - 1;
			NVIdx *tmp; Newx(tmp, N, NVIdx);
			for (size_t i = 0; i < N; i++) {
				SV **lp = av_fetch(lav, i, 0);
				tmp[i].v = (lp && *lp) ? SvNV(*lp) : NAN; tmp[i].i = i;
			}
			qsort(tmp, N, sizeof(NVIdx), nvidx_cmp_asc);
			if (frac_low) for (size_t k = 0; k < n_a; k++) act[tmp[k].i] = 1;
			else          for (size_t k = N - n_a; k < N; k++) act[tmp[k].i] = 1;
			Safefree(tmp);
		} else {
			for (size_t i = 0; i < N; i++) {
				SV **lp = av_fetch(lav, i, 0);
				act[i] = (((lp && *lp) ? SvNV(*lp) : NAN) >= cutoff);
			}
		}
		NV *P; Newx(P, N, NV); NV *Q; Newx(Q, N, NV);
		size_t m = 0, n = 0;
		for (size_t i = 0; i < N; i++) {
			SV **sp = av_fetch(sav, i, 0);
			NV s = (sp && *sp) ? SvNV(*sp) : NAN;
			if (lower_pos) s = -s;
			if (act[i]) P[m++] = s; else Q[n++] = s;
		}
		Safefree(act);
		if (m == 0 || n == 0) {
			Safefree(P); Safefree(Q);
			croak("auroc: need both positive and negative labels%s",
			      have_cutoff ? " (check cutoff)" : "");
		}
		NV a, se; roc_delong(aTHX_ P, m, Q, n, &a, &se);
		Safefree(P); Safefree(Q);
		RETVAL = a;
	} else {
		/*Pre-built 0/1 (or string) labels: roc_split does the parallel-array
		walk; note swapped args so labels are ST(0), scores ST(1).*/
		NV *pos, *neg; size_t m, n;
		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 *positive = "1"; NV conf_level = NV_CONF_95; bool lower_pos = 0;
	for (int i = 2; i + 1 < items; i += 2) {
		const char *k = SvPV_nolen(ST(i)); SV *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);
		else if (strEQ(k, "direction")) { const char *d = SvPV_nolen(v); lower_pos = (d[0] == '<'); }
		else croak("roc: unknown argument '%s'", k);
	}
	if (!(conf_level > 0.0 && conf_level < 1.0))
		croak("roc: conf_level must be between 0 and 1");

	NV *pos, *neg; size_t m, n;
	roc_split(aTHX_ (AV *)SvRV(ST(0)), (AV *)SvRV(ST(1)), positive, lower_pos,
	          &pos, &m, &neg, &n, "roc");
	NV auc_val, se; roc_delong(aTHX_ pos, m, neg, n, &auc_val, &se);
	NV z  = std_qnorm(1.0 - (1.0 - conf_level) / 2.0);
	NV lo = auc_val - z * se, hi = auc_val + z * se;
	if (lo < 0.0) lo = 0.0; if (hi > 1.0) hi = 1.0;

	// Curve + Youden by sweeping thresholds high -> low over all points
	size_t N = m + n;
	ROCPt *pts; Newx(pts, N, ROCPt);
	for (size_t i = 0; i < m; i++) { pts[i].score     = pos[i]; pts[i].lab     = 1; }
	for (size_t j = 0; j < n; j++) { pts[m + j].score = neg[j]; pts[m + j].lab = 0; }
	Safefree(pos); Safefree(neg);
	qsort(pts, N, sizeof(ROCPt), rocpt_cmp_desc);

	AV *curve = newAV();
	{ //leading operating point: threshold = +inf, nothing called positive
		HV *p0 = newHV();
		hv_stores(p0, "threshold",   newSVnv(INFINITY));
		hv_stores(p0, "sensitivity", newSVnv(0.0));
		hv_stores(p0, "specificity", newSVnv(1.0));
		av_push(curve, newRV_noinc((SV *)p0));
	}
	NV TP = 0.0, FP = 0.0, P = (NV)m, Nn = (NV)n;
	NV best_j = -2.0, best_thr = 0.0, best_sens = 0.0, best_spec = 0.0;
	size_t i = 0;
	while (i < N) {
		NV thr = pts[i].score;
		size_t j = i;
		while (j < N && pts[j].score == thr) { if (pts[j].lab) TP += 1.0; else FP += 1.0; j++; }
		NV sens = TP / P, spec = (Nn - FP) / Nn;
		HV *pt = newHV();
		hv_stores(pt, "threshold",   newSVnv(thr));
		hv_stores(pt, "sensitivity", newSVnv(sens));
		hv_stores(pt, "specificity", newSVnv(spec));
		av_push(curve, newRV_noinc((SV *)pt));
		NV jstat = sens + spec - 1.0;
		if (jstat > best_j) { best_j = jstat; best_thr = thr; best_sens = sens; best_spec = spec; }
		i = j;
	}
	Safefree(pts);

	HV *youden = newHV();
	hv_stores(youden, "threshold",   newSVnv(best_thr));
	hv_stores(youden, "sensitivity", newSVnv(best_sens));
	hv_stores(youden, "specificity", newSVnv(best_spec));
	hv_stores(youden, "j",           newSVnv(best_j));

	HV *ret = newHV();
	hv_stores(ret, "auc",        newSVnv(auc_val));
	hv_stores(ret, "auc.se",     newSVnv(se));
	{ AV *ci = newAV(); av_push(ci, newSVnv(lo)); av_push(ci, newSVnv(hi));
	  hv_stores(ret, "auc.ci", newRV_noinc((SV *)ci)); }
	hv_stores(ret, "conf.level", newSVnv(conf_level));
	hv_stores(ret, "n.pos",      newSViv((IV)m));
	hv_stores(ret, "n.neg",      newSViv((IV)n));
	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 *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)))
			            ? IoOFP(GvIO(ogv)) : PerlIO_stdout();
			PerlIO_printf(pio,
"bedroc - Boltzmann-Enhanced Discrimination of ROC (Truchon & Bayly 2007)\n"
"\n"
"Early-recognition metric: scores actives ranked near the TOP of the list\n"
"far more than actives buried deep.  Result is in [0, 1] (1 = ideal early\n"
"recognition, 0 = worst, ~0.5 = random-ish depending on alpha & R_a).\n"
"\n"
"USAGE\n"
"  my $r = bedroc(\\@scores, \\@labels, alpha => 20);\n"
"  print $r->{bedroc};\n"
"\n"
"ARGUMENTS\n"
"  \\@scores      ranking scores (higher = better by default)\n"
"  \\@labels      class labels, OR a numeric column when cutoff/active_frac\n"
"                is given (then bedroc binarizes it for you)\n"
"  alpha => 20   early-recognition weight, > 0 (Truchon-Bayly default 20)\n"
"  positive => 1 label value that marks an active (string compare)\n"
"  cutoff => x   define actives as \\@labels entries with value >= x\n"
"  active_frac=>f binarize \\@labels: take a fraction f in (0,1) as active,\n"
"                from one tail (see active_side).  Exactly ceil(f*N) actives,\n"
"                clamped so both classes exist -- never dies for lack of a\n"
"                pre-built 0/1 label.  Mutually exclusive with cutoff.\n"
"  active_side=>  with active_frac: 'high' (default) = largest values are\n"
"    'high'      active (like cutoff); 'low' = smallest values (e.g. actives\n"
"                = strongest binders when the column is dG).\n"
"  direction=>'>' '>' higher score ranks first (default); '<' flips\n"
"  top => 0.05   also report enrichment in the top fraction (0..1]\n"
"\n"
"Unlike the common Python implementations (which need a pre-built 0/1 label\n"
"array, or reimplement a regression variant per script), active_frac lets one\n"
"call turn a raw measured column straight into a BEDROC score.\n"
"\n"
"RETURNS a hashref: bedroc, alpha, rie, rie_min, rie_max, n, n_active,\n"
"  n_inactive, ra, direction, method, and (with top=>) enrichment =>\n"
"  { fraction, n_top, active_count, expected, enrichment_factor }.\n"
"\n"
"  bedroc('h'), bedroc('H') or bedroc('?') prints this help.\n");
			XSRETURN(0);
		}
	}
	if (items < 2 || !SvROK(ST(0)) || SvTYPE(SvRV(ST(0))) != SVt_PVAV
	              || !SvROK(ST(1)) || SvTYPE(SvRV(ST(1))) != SVt_PVAV)
		croak("Usage: bedroc(\\@scores, \\@labels, alpha => 20, "
		      "positive => 1, cutoff => x, active_frac => 0.1, "
		      "active_side => 'high', direction => '>', top => 0.05)");
	NV alpha = 20.0; const char *positive = "1"; bool lower_pos = 0;
	bool have_cutoff = 0, have_top = 0, have_frac = 0;
	NV cutoff = 0.0, top = 0.0, active_frac = 0.0;
	bool frac_low = 0;
	for (int i = 2; i + 1 < items; i += 2) {
		const char *k = SvPV_nolen(ST(i)); SV *v = ST(i + 1);
		if      (strEQ(k, "alpha"))     alpha = SvNV(v);
		else if (strEQ(k, "positive"))  positive = SvPV_nolen(v);
		else if (strEQ(k, "cutoff"))    { have_cutoff = 1; cutoff = SvNV(v); }
		else if (strEQ(k, "top") || strEQ(k, "fraction")) { have_top = 1; top = SvNV(v); }
		else if (strEQ(k, "active_frac") || strEQ(k, "active")) { have_frac = 1; active_frac = SvNV(v); }
		else if (strEQ(k, "active_side")) {
			const char *sd = SvPV_nolen(v);           //'low'/'bottom' vs 'high'/'top'
			frac_low = (sd[0] == 'l' || sd[0] == 'L' || sd[0] == 'b' || sd[0] == 'B');
		}
		else if (strEQ(k, "direction")) { const char *d = SvPV_nolen(v); lower_pos = (d[0] == '<'); }
		else croak("bedroc: unknown argument '%s'", k);
	}
	if (!(alpha > 0.0)) croak("bedroc: alpha must be > 0");
	if (have_top && !(top > 0.0 && top <= 1.0))
		croak("bedroc: top must be between 0 and 1");
	if (have_frac && have_cutoff)
		croak("bedroc: give either cutoff => or active_frac =>, not both");
	if (have_frac && !(active_frac > 0.0 && active_frac < 1.0))
		croak("bedroc: active_frac must be strictly between 0 and 1");

	AV *sav = (AV *)SvRV(ST(0)), *lav = (AV *)SvRV(ST(1));
	SSize_t Ns = av_len(sav) + 1;
	if (Ns != av_len(lav) + 1)
		croak("bedroc: scores and labels must be the same length");
	if (Ns < 1) croak("bedroc: need at least one observation");
	size_t N = (size_t)Ns;

	/*active_frac mode: binarize the second array by taking exactly
	ceil(active_frac*N) items from one tail (default the HIGH end, like
	cutoff; active_side => 'low' takes the low end).  n_a is clamped to
	[1, N-1] so both classes always exist — no "need both labels" death.*/
	int *act_by_frac = NULL;
	if (have_frac) {
		size_t n_a = (size_t)nv_ceil(active_frac * (NV)N);
		if (n_a < 1) n_a = 1;
		if (N >= 2 && n_a > N - 1) n_a = N - 1;
		NVIdx *tmp; Newx(tmp, N, NVIdx);
		for (size_t i = 0; i < N; i++) {
			SV **lp = av_fetch(lav, i, 0);
			tmp[i].v = (lp && *lp) ? SvNV(*lp) : NAN;
			tmp[i].i = i;
		}
		qsort(tmp, N, sizeof(NVIdx), nvidx_cmp_asc);
		Newxz(act_by_frac, N, int);
		if (frac_low) for (size_t k = 0; k < n_a; k++) act_by_frac[tmp[k].i] = 1;
		else          for (size_t k = N - n_a; k < N; k++) act_by_frac[tmp[k].i] = 1;
		Safefree(tmp);
	}

	ROCPt *pts; Newx(pts, N, ROCPt);
	size_t m = 0;                            // actives
	for (size_t i = 0; i < N; i++) {
		SV **sp = av_fetch(sav, i, 0), **lp = av_fetch(lav, i, 0);
		NV s = (sp && *sp) ? SvNV(*sp) : NAN;
		if (lower_pos) s = -s;
		bool active = act_by_frac ? act_by_frac[i]
			: have_cutoff
			? (((lp && *lp) ? SvNV(*lp) : NAN) >= cutoff)
			: ((lp && *lp) ? strEQ(SvPV_nolen(*lp), positive) : 0);
		pts[i].score = s; pts[i].lab = active ? 1 : 0;
		if (active) m++;
	}
	Safefree(act_by_frac);
	size_t n = N - m;                        // inactives
	if (m == 0 || n == 0) {
		Safefree(pts);
		croak("bedroc: need both active and inactive labels%s",
		      have_cutoff ? " (check cutoff)" : "");
	}

	qsort(pts, N, sizeof(ROCPt), rocpt_cmp_desc);
// sum over actives of exp(-alpha * midrank / N), 1-based ranks, best = 1 */
	NV sum = 0.0;
	for (size_t i = 0; i < N; ) {
		size_t j = i;
		while (j < N && pts[j].score == pts[i].score) j++;
		NV midrank = ((NV)(i + 1) + (NV)j) / 2.0; // avg of positions i+1..j
		NV w = nv_exp(-alpha * midrank / (NV)N);
		for (size_t k = i; k < j; k++) if (pts[k].lab) sum += w;
		i = j;
	}

	NV ra   = (NV)m / (NV)N;
	NV rand_ = ra * (1.0 - nv_exp(-alpha)) / (nv_exp(alpha / (NV)N) - 1.0);
	NV rie   = sum / rand_;
	NV f1    = ra * nv_sinh(alpha / 2.0)
	         / (nv_cosh(alpha / 2.0) - nv_cosh(alpha / 2.0 - alpha * ra));
	NV f2    = 1.0 / (1.0 - nv_exp(alpha * (1.0 - ra)));
	NV bedroc   = rie * f1 + f2;
	NV rie_max  = (1.0 - nv_exp(-alpha * ra)) / (ra * (1.0 - nv_exp(-alpha)));
	NV rie_min  = (1.0 - nv_exp( alpha * ra)) / (ra * (1.0 - nv_exp( alpha)));

	HV *ret = newHV();
	hv_stores(ret, "bedroc",     newSVnv(bedroc));
	hv_stores(ret, "alpha",      newSVnv(alpha));
	hv_stores(ret, "rie",        newSVnv(rie));
	hv_stores(ret, "rie.min",    newSVnv(rie_min));
	hv_stores(ret, "rie.max",    newSVnv(rie_max));
	hv_stores(ret, "n",          newSViv((IV)N));
	hv_stores(ret, "n.active",   newSViv((IV)m));
	hv_stores(ret, "n.inactive", newSViv((IV)n));
	hv_stores(ret, "ra",         newSVnv(ra));
	hv_stores(ret, "direction",  newSVpv(lower_pos ? "<" : ">", 1));
	hv_stores(ret, "method",     newSVpv("BEDROC (Truchon-Bayly early recognition)", 0));

	if (have_top) {//enrichment in the top fraction: EF = (hits/n_top) / R_a
		size_t n_top = (size_t)nv_ceil(top * (NV)N);
		if (n_top < 1) n_top = 1; if (n_top > N) n_top = N;
		size_t hits = 0;
		for (size_t i = 0; i < n_top; i++) if (pts[i].lab) hits++;
		NV expected = ra * (NV)n_top;
		HV *enr = newHV();
		hv_stores(enr, "fraction",         newSVnv(top));
		hv_stores(enr, "n.top",            newSViv((IV)n_top));
		hv_stores(enr, "active.count",     newSViv((IV)hits));
		hv_stores(enr, "expected",         newSVnv(expected));
		hv_stores(enr, "enrichment.factor",
		          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 *gav = NULL; NV conf_level = NV_CONF_95;
	for (int i = 2; i + 1 < items; i += 2) {
		const char *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);
		}
		else if (strEQ(k, "conf_level") || strEQ(k, "conf.level")) conf_level = SvNV(v);
		else croak("survfit: unknown argument '%s'", k);
	}
	if (!(conf_level > 0.0 && conf_level < 1.0)) croak("survfit: conf_level must be between 0 and 1");

	AV *labels = (AV *)sv_2mortal((SV *)newAV());
	size_t N; SurvObs *o = srv_read(aTHX_ (AV *)SvRV(ST(0)), (AV *)SvRV(ST(1)), gav, &N, labels, "survfit");
	qsort(o, N, sizeof(SurvObs), survobs_cmp);
	SSize_t G = av_len(labels) + 1;
	NV z = std_qnorm(1.0 - (1.0 - conf_level) / 2.0);

	HV *strata = newHV();
	for (SSize_t g = 0; g < G; g++) {// group size
		size_t ng = 0; for (size_t i = 0; i < N; i++) if (o[i].grp == g) ng++;
		AV *t_av=newAV(), *nr_av=newAV(), *ne_av=newAV(), *nc_av=newAV(),
		   *s_av=newAV(), *se_av=newAV(), *lo_av=newAV(), *hi_av=newAV();
		NV S = 1.0, vterm = 0.0, median = NAN;
		size_t at_risk = ng, total_events = 0;
		size_t i = 0;
		while (i < N) {
			if (o[i].grp != g) { i++; continue; }
			NV t = o[i].time;
			size_t d = 0, c = 0, block = 0;
			size_t j = i;
			while (j < N && o[j].time == t) {
				if (o[j].grp == g) { block++; if (o[j].status) d++; else c++; }
				j++;
			}
			size_t nr = at_risk;    // at risk just before t
			if (d > 0 && nr > d) {
				S *= 1.0 - (NV)d / (NV)nr;
				vterm += (NV)d / ((NV)nr * (NV)(nr - d));
				total_events += d;
			} else if (d > 0) {    // everyone remaining has an event
				S = 0.0; total_events += d;
			}
			NV se_S = S * nv_sqrt(vterm);
			NV lo = (S > 0.0) ? S * nv_exp(-z * nv_sqrt(vterm)) : 0.0;
			NV hi = (S > 0.0) ? S * nv_exp( z * nv_sqrt(vterm)) : 0.0;
			if (hi > 1.0) hi = 1.0;
			av_push(t_av,  newSVnv(t));
			av_push(nr_av, newSViv((IV)nr));
			av_push(ne_av, newSViv((IV)d));
			av_push(nc_av, newSViv((IV)c));
			av_push(s_av,  newSVnv(S));
			av_push(se_av, newSVnv(se_S));
			av_push(lo_av, newSVnv(lo));
			av_push(hi_av, newSVnv(hi));
			if (nv_isnan(median) && S <= 0.5) median = t;
			at_risk -= block;
			i = j;
		}
		HV *st = newHV();
		hv_stores(st, "time",     newRV_noinc((SV *)t_av));
		hv_stores(st, "n.risk",   newRV_noinc((SV *)nr_av));
		hv_stores(st, "n.event",  newRV_noinc((SV *)ne_av));
		hv_stores(st, "n.censor", newRV_noinc((SV *)nc_av));
		hv_stores(st, "surv",     newRV_noinc((SV *)s_av));
		hv_stores(st, "std.err",  newRV_noinc((SV *)se_av));
		hv_stores(st, "lower",    newRV_noinc((SV *)lo_av));
		hv_stores(st, "upper",    newRV_noinc((SV *)hi_av));
		hv_stores(st, "n",        newSViv((IV)ng));
		hv_stores(st, "events",   newSViv((IV)total_events));
		hv_stores(st, "median",   nv_isnan(median) ? newSV(0) : newSVnv(median));
		SV *key = *av_fetch(labels, g, 0);
		STRLEN klen; const char *kp = SvPV(key, klen);
		hv_store(strata, kp, klen, newRV_noinc((SV *)st), 0);
	}
	Safefree(o);

	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 *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"); }
	qsort(o, N, sizeof(SurvObs), survobs_cmp);

	NV *O, *E, *V; Newx(O, G, NV); Newx(E, G, NV); Newx(V, G * G, NV);
	for (SSize_t k = 0; k < G; k++) { O[k] = 0.0; E[k] = 0.0; }
	for (SSize_t k = 0; k < G * G; k++) V[k] = 0.0;

	size_t *nrisk; Newx(nrisk, G, size_t);
	for (SSize_t k = 0; k < G; k++) { size_t c = 0; for (size_t i = 0; i < N; i++) if (o[i].grp == k) c++; nrisk[k] = c; }

	size_t i = 0;
	while (i < N) {
		NV t = o[i].time;
		size_t d_tot = 0, n_tot = 0;
		size_t *dj; Newx(dj, G, size_t); for (SSize_t k = 0; k < G; k++) dj[k] = 0;
		for (SSize_t k = 0; k < G; k++) n_tot += nrisk[k];
		size_t j = i, block_j0 = 0; (void)block_j0;
		while (j < N && o[j].time == t) { if (o[j].status) { dj[o[j].grp]++; d_tot++; } j++; }
		if (d_tot > 0 && n_tot > 1) {
			for (SSize_t a = 0; a < G; a++) {
				NV nja = (NV)nrisk[a];
				O[a] += (NV)dj[a];
				E[a] += (NV)d_tot * nja / (NV)n_tot;
				for (SSize_t b = 0; b < G; b++) {
					NV njb = (NV)nrisk[b];
					NV term = (NV)d_tot * ((NV)n_tot - (NV)d_tot) / ((NV)n_tot - 1.0)
					          * (((a == b) ? nja / (NV)n_tot : 0.0) - nja * njb / ((NV)n_tot * (NV)n_tot));
					V[a * G + b] += term;
				}
			}
		}
		// remove this time's observations from the risk sets
		for (size_t k2 = i; k2 < j; k2++) nrisk[o[k2].grp]--;
		Safefree(dj);
		i = j;
	}

	int m = (int)G - 1; // reduced dimension
	NV *Vr; Newx(Vr, m * m, NV);
	NV *OE; Newx(OE, m, NV);
	for (int a = 0; a < m; a++) { OE[a] = O[a] - E[a]; for (int b = 0; b < m; b++) Vr[a*m+b] = V[a*G+b]; }
	NV *xsol; Newx(xsol, m, NV);
	NV chi = 0.0;
	if (srv_solve(Vr, OE, m, xsol) == 0)
		for (int a = 0; a < m; a++) chi += OE[a] * xsol[a];
	NV pval = get_p_value(chi, m);

	HV *ret = newHV();
	hv_stores(ret, "statistic", newSVnv(chi));
	hv_stores(ret, "parameter", newSViv(m));
	hv_stores(ret, "p.value",   newSVnv(pval));
	AV *obs = newAV(), *exp_av = newAV();
	for (SSize_t k = 0; k < G; k++) { av_push(obs, newSVnv(O[k])); av_push(exp_av, newSVnv(E[k])); }
	hv_stores(ret, "observed",  newRV_noinc((SV *)obs));
	hv_stores(ret, "expected",  newRV_noinc((SV *)exp_av));
	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 *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");

	//covariates: [\@x1, \@x2, ...] (multiple) or a single flat \@x
	int p, multi = 0;
	SV **first = av_fetch(Xav, 0, 0);
	if (first && *first && SvROK(*first) && SvTYPE(SvRV(*first)) == SVt_PVAV) { multi = 1; p = (int)(av_len(Xav) + 1); }
	else { multi = 0; p = 1; }
	if (p < 1) croak("coxph: need at least one covariate");

	NV conf_level = NV_CONF_95; int breslow = 0, maxit = 25; NV eps = 1e-9;
	AV *names_av = NULL;
	for (int i = 3; i + 1 < items; i += 2) {
		const char *k = SvPV_nolen(ST(i)); SV *v = ST(i + 1);
		if      (strEQ(k, "conf_level") || strEQ(k, "conf.level")) conf_level = SvNV(v);
		else if (strEQ(k, "ties"))  breslow = strEQ(SvPV_nolen(v), "breslow");
		else if (strEQ(k, "maxit")) maxit = (int)SvIV(v);
		else if (strEQ(k, "names")) { if (SvROK(v) && SvTYPE(SvRV(v)) == SVt_PVAV) names_av = (AV *)SvRV(v); }
		else croak("coxph: unknown argument '%s'", k);
	}
	if (!(conf_level > 0.0 && conf_level < 1.0)) croak("coxph: conf_level must be between 0 and 1");

	//pull data into contiguous C arrays
	NV *X; Newx(X, (size_t)n * p, NV);
	NV *tm; Newx(tm, n, NV);
	int *restrict st; Newx(st, n, int);
	for (SSize_t i = 0; i < n; i++) {
		tm[i] = SvNV(*av_fetch(tav, i, 0));
		st[i] = (SvNV(*av_fetch(sav, i, 0)) != 0.0) ? 1 : 0;
	}
	if (multi) {
		for (int k = 0; k < p; k++) {
			AV *col = (AV *)SvRV(*av_fetch(Xav, k, 0));
			if (av_len(col) + 1 != n) { Safefree(X); Safefree(tm); Safefree(st); croak("coxph: covariate %d length mismatch", k + 1); }
			for (SSize_t i = 0; i < n; i++) X[i * p + k] = SvNV(*av_fetch(col, i, 0));
		}
	} else {
		if (av_len(Xav) + 1 != n) { Safefree(X); Safefree(tm); Safefree(st); croak("coxph: covariate length mismatch"); }
		for (SSize_t i = 0; i < n; i++) X[i] = SvNV(*av_fetch(Xav, i, 0));
	}

	//observations sorted by time ascending (risk sets built time-descending)
	TimeIdx *ord; Newx(ord, n, TimeIdx);
	for (SSize_t i = 0; i < n; i++) { ord[i].time = tm[i]; ord[i].idx = (int)i; }
	qsort(ord, n, sizeof(TimeIdx), cmp_nv3);

	NV *beta = NULL, *U = NULL, *Imat = NULL, *Iinv = NULL, *ratio = NULL,
	   *S1 = NULL, *S2 = NULL, *SD1 = NULL, *SD2 = NULL, *sumX_D = NULL, *eta = NULL, *w = NULL;
	Newx(beta, p, NV);   Newx(U, p, NV);       Newx(Imat, p * p, NV); Newx(Iinv, p * p, NV);
	Newx(ratio, p, NV);  Newx(S1, p, NV);      Newx(S2, p * p, NV);
	Newx(SD1, p, NV);    Newx(SD2, p * p, NV); Newx(sumX_D, p, NV);
	Newx(eta, n, NV);    Newx(w, n, NV);
	for (int k = 0; k < p; k++) beta[k] = 0.0;

	NV loglik = 0.0, loglik_null = 0.0, prev = 0.0;
	int iter = 0, converged = 0, singular = 0;
	for (iter = 0; iter < maxit; iter++) {
		for (SSize_t i = 0; i < n; i++) {
			NV e = 0.0; for (int k = 0; k < p; k++) e += X[i * p + k] * beta[k];
			eta[i] = e; w[i] = nv_exp(e);
		}
		loglik = 0.0;
		for (int k = 0; k < p; k++) U[k] = 0.0;
		for (int k = 0; k < p * p; k++) Imat[k] = 0.0;
		NV S0 = 0.0;
		for (int k = 0; k < p; k++) S1[k] = 0.0;
		for (int k = 0; k < p * p; k++) S2[k] = 0.0;

		SSize_t pos = n - 1;
		while (pos >= 0) {
			NV t = ord[pos].time;
			SSize_t lo = pos; while (lo > 0 && ord[lo - 1].time == t) lo--;
			NV SD0 = 0.0; int m = 0; NV sumEta_D = 0.0;
			for (int k = 0; k < p; k++) { SD1[k] = 0.0; sumX_D[k] = 0.0; }
			for (int k = 0; k < p * p; k++) SD2[k] = 0.0;
			for (SSize_t q = lo; q <= pos; q++) {
				int oi = ord[q].idx; NV wq = w[oi];
				S0 += wq;
				for (int k = 0; k < p; k++) {
					NV xk = X[oi * p + k];
					S1[k] += wq * xk;
					for (int l = 0; l < p; l++) S2[k * p + l] += wq * xk * X[oi * p + l];
				}
				if (st[oi]) {
					m++; SD0 += wq; sumEta_D += eta[oi];
					for (int k = 0; k < p; k++) {
						NV xk = X[oi * p + k];
						SD1[k] += wq * xk; sumX_D[k] += xk;
						for (int l = 0; l < p; l++) SD2[k * p + l] += wq * xk * X[oi * p + l];
					}
				}
			}
			if (m > 0) {
				loglik += sumEta_D;
				for (int k = 0; k < p; k++) U[k] += sumX_D[k];
				for (int l = 0; l < m; l++) {
					NV d = breslow ? 0.0 : (NV)l / (NV)m;
					NV Z0 = S0 - d * SD0;
					loglik -= nv_log(Z0);
					for (int k = 0; k < p; k++) ratio[k] = (S1[k] - d * SD1[k]) / Z0;
					for (int k = 0; k < p; k++) {
						U[k] -= ratio[k];
						for (int l2 = 0; l2 < p; l2++)
							Imat[k * p + l2] += (S2[k * p + l2] - d * SD2[k * p + l2]) / Z0
							                    - ratio[k] * ratio[l2];
					}
				}
			}
			pos = lo - 1;
		}

		if (iter == 0) loglik_null = loglik;
		for (int k = 0; k < p * p; k++) Iinv[k] = Imat[k];   //mat_inv destroys input
		{ NV *tmp; Newx(tmp, p * p, NV); for (int k = 0; k < p*p; k++) tmp[k] = Imat[k];
		  if (mat_inv(tmp, p, Iinv) != 0) singular = 1; Safefree(tmp); }
		if (singular) break;
		if (iter > 0 && nv_fabs(loglik - prev) <= eps * (nv_fabs(loglik) + eps)) { converged = 1; break; }
		prev = loglik;
		//Newton update: beta += Iinv * U
		for (int k = 0; k < p; k++) { NV s = 0.0; for (int l = 0; l < p; l++) s += Iinv[k * p + l] * U[l]; beta[k] += s; }
	}

	int nevent = 0; for (SSize_t i = 0; i < n; i++) if (st[i]) nevent++;
	NV zc = std_qnorm(1.0 - (1.0 - conf_level) / 2.0);

	AV *coef=newAV(), *hr=newAV(), *se=newAV(), *zv=newAV(), *pv=newAV(),
	   *ci=newAV(), *nm=newAV();
	for (int k = 0; k < p; k++) {
		NV b = beta[k];
		NV sek = (Iinv[k * p + k] > 0.0) ? nv_sqrt(Iinv[k * p + k]) : NAN;
		NV zk = b / sek;
		NV pk = 2.0 * approx_pnorm(-nv_fabs(zk));
		av_push(coef, newSVnv(b));
		av_push(hr,   newSVnv(nv_exp(b)));
		av_push(se,   newSVnv(sek));
		av_push(zv,   newSVnv(zk));
		av_push(pv,   newSVnv(pk));
		AV *cik = newAV();
		av_push(cik, newSVnv(nv_exp(b - zc * sek)));
		av_push(cik, newSVnv(nv_exp(b + zc * sek)));
		av_push(ci, newRV_noinc((SV *)cik));
		if (names_av && k <= av_len(names_av)) av_push(nm, newSVsv(*av_fetch(names_av, k, 0)));
		else { SV *dn = newSVpvf("x%d", k + 1); av_push(nm, dn); }
	}
	NV lr = 2.0 * (loglik - loglik_null);
	NV lr_p = get_p_value(lr, p);

	HV *ret = newHV();
	hv_stores(ret, "coef",        newRV_noinc((SV *)coef));
	hv_stores(ret, "exp.coef",    newRV_noinc((SV *)hr));      //hazard ratios
	hv_stores(ret, "se",          newRV_noinc((SV *)se));
	hv_stores(ret, "z",           newRV_noinc((SV *)zv));
	hv_stores(ret, "p.value",     newRV_noinc((SV *)pv));
	hv_stores(ret, "conf.int",    newRV_noinc((SV *)ci));      //on the HR scale
	hv_stores(ret, "names",       newRV_noinc((SV *)nm));
	hv_stores(ret, "loglik",      newSVnv(loglik));
	hv_stores(ret, "loglik.null", newSVnv(loglik_null));
	hv_stores(ret, "lr.stat",     newSVnv(lr));
	hv_stores(ret, "lr.df",       newSViv(p));
	hv_stores(ret, "lr.p.value",  newSVnv(lr_p));
	hv_stores(ret, "n",           newSViv((IV)n));
	hv_stores(ret, "nevent",      newSViv(nevent));
	hv_stores(ret, "iterations",  newSViv(iter));
	hv_stores(ret, "converged",   newSViv(converged));
	hv_stores(ret, "conf.level",  newSVnv(conf_level));
	hv_stores(ret, "ties",        newSVpv(breslow ? "breslow" : "efron", 0));
	hv_stores(ret, "method",      newSVpv("Cox proportional hazards model", 0));

	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 *p_sv    = ST(0);
		const char *method = "holm";
		SV *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)))
				croak("p_adjust: the second argument must be an adjustment method name");
			method = SvPV_nolen(ST(1));
			first_pair = 2;
		}
		for (IV a = first_pair; a + 1 < (IV)items; a += 2) {
			const char *key = SvPV_nolen(ST(a));
			SV *val = ST(a + 1);
			if      (strEQ(key, "method")) method = SvPV_nolen(val);
			else if (strEQ(key, "columns") || strEQ(key, "column")
			      || strEQ(key, "cols")    || strEQ(key, "col")) cols_sv = val;
			else croak("p_adjust: unknown argument '%s'", key);
		}
		char meth[PA_METH_LEN];
		pa_method(method, meth);
		if (!pa_known(meth)) croak("Unknown p-value adjustment method: %s", method);
		/*Which columns hold p-values? Nothing named means all of them. The
		value is a flag, set once the column turns up in the frame.*/
		HV *want = NULL;
		if (cols_sv && SvOK(cols_sv)) {
			want = (HV*)sv_2mortal((SV*)newHV());
			if (SvROK(cols_sv) && SvTYPE(SvRV(cols_sv)) == SVt_PVAV) {
				AV *cav = (AV*)SvRV(cols_sv);
				for (SSize_t i = 0; i <= av_len(cav); i++) {
					SV **c = av_fetch(cav, i, 0);
					if (!c || !SvOK(*c))
						croak("p_adjust: undefined column name in 'columns'");
					(void)hv_store_ent(want, *c, newSViv(0), 0);
				}
			} else if (SvROK(cols_sv)) {
				croak("p_adjust: 'columns' must be a column name or an ARRAY "
				      "reference of column names");
			} else {
				(void)hv_store_ent(want, cols_sv, newSViv(0), 0);
			}
			if (HvUSEDKEYS(want) == 0) croak("p_adjust: 'columns' names no columns");
		}
		//Which of the five shapes is this?
		enum { PA_FLAT, PA_AOA, PA_AOH, PA_HOA, PA_HOH } kind = PA_FLAT;
		SV *ref = SvROK(p_sv) ? SvRV(p_sv) : NULL;
		if (!ref || (SvTYPE(ref) != SVt_PVAV && SvTYPE(ref) != SVt_PVHV))
			croak("p_adjust: first argument must be an ARRAY reference of p-values, "
			      "or a reference to an AoA, AoH, HoA or HoH data frame");
		if (SvTYPE(ref) == SVt_PVAV) {
			AV *av = (AV*)ref;
			for (SSize_t i = 0; i <= av_len(av); i++) {
				SV **e = av_fetch(av, i, 0);
				if (!e || !SvOK(*e)) continue;      //undef p-value: still flat
				if (SvROK(*e) && SvTYPE(SvRV(*e)) == SVt_PVAV)      kind = PA_AOA;
				else if (SvROK(*e) && SvTYPE(SvRV(*e)) == SVt_PVHV) kind = PA_AOH;
				else if (SvROK(*e))
					croak("p_adjust: an ARRAY reference must hold p-values, "
					      "ARRAY references (AoA) or HASH references (AoH)");
				break;
			}
		} else {
			HV *hv = (HV*)ref;
			HE *e;
			kind = PA_HOA; //an empty hash is either
			hv_iterinit(hv);
			while ((e = hv_iternext(hv))) {
				SV *v = HeVAL(e);
				if (!v || !SvOK(v)) continue;
				if (SvROK(v) && SvTYPE(SvRV(v)) == SVt_PVAV)      kind = PA_HOA;
				else if (SvROK(v) && SvTYPE(SvRV(v)) == SVt_PVHV) kind = PA_HOH;
				else croak("p_adjust: a HASH reference must hold ARRAY references "
				           "(HoA) or HASH references (HoH)");
				break;
			}
		}

		// the flat list, unchanged: a list of p-values in, a list out
		if (kind == PA_FLAT) {
			if (want)
				croak("p_adjust: 'columns' needs a data frame, not a flat list "
				      "of p-values");
			AV *p_av = (AV*)ref;
			size_t n = av_len(p_av) + 1;
			if (n == 0) XSRETURN_EMPTY;
			NV *pv;
			NV *adj;
			Newx(pv, n, NV);
			Newx(adj, n, NV);
			for (size_t i = 0; i < n; i++) {
				SV **tv = av_fetch(p_av, i, 0);
				pv[i] = (tv && SvOK(*tv)) ? SvNV(*tv) : 1.0;
			}
			pa_kernel(pv, adj, n, meth);
			EXTEND(SP, (SSize_t)n);
			for (size_t i = 0; i < n; i++) ST(i) = sv_2mortal(newSVnv(adj[i]));
			Safefree(pv);  pv  = NULL;
			Safefree(adj); adj = NULL;
			XSRETURN((int)n);
		}

		/* a frame: validate and size the family before building anything,
		so the second pass cannot die part way through and strand memory.*/
		size_t n = 0;
		SSize_t maxk = 0, nouter = 0;   //widest row hash; outer hash size
		if (kind == PA_AOA) {
			AV *av = (AV*)ref;
			for (SSize_t i = 0; i <= av_len(av); i++) {
				SV **rs = av_fetch(av, i, 0);
				if (!rs || !SvROK(*rs) || SvTYPE(SvRV(*rs)) != SVt_PVAV)
					croak("p_adjust: row %" IVdf " of the AoA is not an ARRAY reference",
					      (IV)i);
				AV *row = (AV*)SvRV(*rs);
				for (SSize_t j = 0; j <= av_len(row); j++) {
					if (want) {
						char kb[24];
						I32 kl = (I32)snprintf(kb, sizeof kb, "%" IVdf, (IV)j);
						if (!pa_mark(aTHX_ want, kb, (STRLEN)kl, 0)) continue;
					}
					SV **c = av_fetch(row, j, 0);
					pa_check(aTHX_ c ? *c : NULL, NULL, (IV)j);
					n++;
				}
			}
		} else if (kind == PA_AOH) {
			AV *av = (AV*)ref;
			for (SSize_t i = 0; i <= av_len(av); i++) {
				SV **rs = av_fetch(av, i, 0);
				if (!rs || !SvROK(*rs) || SvTYPE(SvRV(*rs)) != SVt_PVHV)
					croak("p_adjust: row %" IVdf " of the AoH is not a HASH reference",
					      (IV)i);
				HV *row = (HV*)SvRV(*rs);
				SSize_t hk = (SSize_t)HvUSEDKEYS(row);
				if (hk > maxk) maxk = hk;
				HE *e;
				hv_iterinit(row);
				while ((e = hv_iternext(row))) {
					STRLEN kl;
					const char *kp = HePV(e, kl);
					if (!pa_mark(aTHX_ want, kp, kl, HeUTF8(e))) continue;
					pa_check(aTHX_ HeVAL(e), kp, 0);
					n++;
				}
			}
		} else if (kind == PA_HOA) {
			HV *hv = (HV*)ref;
			HE *e;
			nouter = (SSize_t)HvUSEDKEYS(hv);
			hv_iterinit(hv);
			while ((e = hv_iternext(hv))) {
				STRLEN kl;
				const char *kp = HePV(e, kl);
				SV *cv = HeVAL(e);
				if (!cv || !SvROK(cv) || SvTYPE(SvRV(cv)) != SVt_PVAV)
					croak("p_adjust: column '%s' of the HoA is not an ARRAY reference", kp);
				if (!pa_mark(aTHX_ want, kp, kl, HeUTF8(e))) continue;
				AV *cav = (AV*)SvRV(cv);
				for (SSize_t i = 0; i <= av_len(cav); i++) {
					SV **c = av_fetch(cav, i, 0);
					pa_check(aTHX_ c ? *c : NULL, kp, 0);
					n++;
				}
			}
		} else {                                                   //PA_HOH
			HV *hv = (HV*)ref;
			HE *e;
			nouter = (SSize_t)HvUSEDKEYS(hv);
			hv_iterinit(hv);
			while ((e = hv_iternext(hv))) {
				SV *rv = HeVAL(e);
				if (!rv || !SvROK(rv) || SvTYPE(SvRV(rv)) != SVt_PVHV)
					croak("p_adjust: row '%s' of the HoH is not a HASH reference",
					      HePV(e, PL_na));
				HV *row = (HV*)SvRV(rv);
				SSize_t hk = (SSize_t)HvUSEDKEYS(row);
				if (hk > maxk) maxk = hk;
				HE *f;
				hv_iterinit(row);
				while ((f = hv_iternext(row))) {
					STRLEN kl;
					const char *kp = HePV(f, kl);
					if (!pa_mark(aTHX_ want, kp, kl, HeUTF8(f))) continue;
					pa_check(aTHX_ HeVAL(f), kp, 0);
					n++;
				}
			}
		}
		if (want) {
			HE *e;
			hv_iterinit(want);
			while ((e = hv_iternext(want)))
				if (!SvTRUE(HeVAL(e)))
					croak("p_adjust: the frame has no column named '%s'",
					      HePV(e, PL_na));
		}

		//---- second pass: rebuild the frame, reserving a slot per p-value
		NV *pv     = NULL;
		NV *adj    = NULL;
		SV **slots = NULL;
		HE **kbuf  = NULL;
		HE **obuf  = NULL;
		if (n) { Newx(pv, n, NV); Newx(adj, n, NV); Newx(slots, n, SV*); }
		if (maxk)   Newx(kbuf, maxk,   HE*);
		if (nouter) Newx(obuf, nouter, HE*);
		size_t k = 0;
		SV *out_sv;

		if (kind == PA_AOA) {
			AV *in = (AV*)ref, *out = newAV();
			out_sv = sv_2mortal(newRV_noinc((SV*)out));
			SSize_t nr = av_len(in) + 1;
			if (nr > 0) av_extend(out, nr - 1);
			for (SSize_t i = 0; i < nr; i++) {
				AV *row = (AV*)SvRV(*av_fetch(in, i, 0));
				AV *rout = newAV();
				av_push(out, newRV_noinc((SV*)rout));
				SSize_t nc = av_len(row) + 1;
				if (nc > 0) av_extend(rout, nc - 1);
				for (SSize_t j = 0; j < nc; j++) {
					SV **c = av_fetch(row, j, 0);
					int sel = 1;
					if (want) {
						char kb[24];
						I32 kl = (I32)snprintf(kb, sizeof kb, "%" IVdf, (IV)j);
						sel = hv_fetch(want, kb, kl, 0) != NULL;
					}
					av_push(rout, sel
						? pa_place(aTHX_ c ? *c : NULL, pv, slots, &k, n)
						: pa_copy(aTHX_ c ? *c : NULL));
				}
			}
		} else if (kind == PA_AOH) {
			AV *in = (AV*)ref, *out = newAV();
			out_sv = sv_2mortal(newRV_noinc((SV*)out));
			SSize_t nr = av_len(in) + 1;
			if (nr > 0) av_extend(out, nr - 1);
			for (SSize_t i = 0; i < nr; i++) {
				HV *row = (HV*)SvRV(*av_fetch(in, i, 0));
				HV *rout = newHV();
				av_push(out, newRV_noinc((SV*)rout));
				SSize_t nk = pa_sorted_keys(aTHX_ row, kbuf);
				for (SSize_t j = 0; j < nk; j++) {
					HE *e = kbuf[j];
					STRLEN kl;
					const char *kp = HePV(e, kl);
					I32 sk = HeUTF8(e) ? -(I32)kl : (I32)kl;
					int sel = !want || hv_fetch(want, kp, sk, 0) != NULL;
					(void)hv_store(rout, kp, sk, sel
						? pa_place(aTHX_ HeVAL(e), pv, slots, &k, n)
						: pa_copy(aTHX_ HeVAL(e)), 0);
				}
			}
		} else if (kind == PA_HOA) {
			HV *in = (HV*)ref, *out = newHV();
			out_sv = sv_2mortal(newRV_noinc((SV*)out));
			SSize_t nk = pa_sorted_keys(aTHX_ in, obuf);
			for (SSize_t ci = 0; ci < nk; ci++) {
				HE *e = obuf[ci];
				STRLEN kl;
				const char *kp = HePV(e, kl);
				I32 sk = HeUTF8(e) ? -(I32)kl : (I32)kl;
				AV *cin = (AV*)SvRV(HeVAL(e));
				AV *cout = newAV();
				(void)hv_store(out, kp, sk, newRV_noinc((SV*)cout), 0);
				SSize_t nrw = av_len(cin) + 1;
				if (nrw > 0) av_extend(cout, nrw - 1);
				int sel = !want || hv_fetch(want, kp, sk, 0) != NULL;
				for (SSize_t i = 0; i < nrw; i++) {
					SV **c = av_fetch(cin, i, 0);
					av_push(cout, sel
						? pa_place(aTHX_ c ? *c : NULL, pv, slots, &k, n)
						: pa_copy(aTHX_ c ? *c : NULL));
				}
			}
		} else {                                                   //PA_HOH
			HV *in = (HV*)ref, *out = newHV();
			out_sv = sv_2mortal(newRV_noinc((SV*)out));
			SSize_t nr = pa_sorted_keys(aTHX_ in, obuf);
			for (SSize_t ri = 0; ri < nr; ri++) {
				HE *re = obuf[ri];
				STRLEN rl;
				const char *rp = HePV(re, rl);
				HV *row = (HV*)SvRV(HeVAL(re));
				HV *rout = newHV();
				(void)hv_store(out, rp, HeUTF8(re) ? -(I32)rl : (I32)rl,
				               newRV_noinc((SV*)rout), 0);
				SSize_t nk = pa_sorted_keys(aTHX_ row, kbuf);
				for (SSize_t j = 0; j < nk; j++) {
					HE *e = kbuf[j];
					STRLEN kl;
					const char *kp = HePV(e, kl);
					I32 sk = HeUTF8(e) ? -(I32)kl : (I32)kl;
					int sel = !want || hv_fetch(want, kp, sk, 0) != NULL;
					(void)hv_store(rout, kp, sk, sel
						? pa_place(aTHX_ HeVAL(e), pv, slots, &k, n)
						: pa_copy(aTHX_ HeVAL(e)), 0);
				}
			}
		}

		if (n) {
			pa_kernel(pv, adj, n, meth);
			for (size_t i = 0; i < n; i++) sv_setnv(slots[i], adj[i]);
		}
		Safefree(pv);    pv    = NULL; Safefree(adj);   adj   = NULL;
		Safefree(slots); slots = NULL; Safefree(kbuf);  kbuf  = NULL;
		Safefree(obuf);  obuf  = NULL;
		ST(0) = out_sv;
		XSRETURN(1);

NV median(...)
	PROTOTYPE: @
	INIT:
	  size_t total_count = 0, k = 0;
	  NV* nums;
	  NV median_val = 0.0;
	  /*Small samples -- a per-group median under agg()/group_by(), say --
	  are the common case by call count, and for those the malloc/free pair
	  cost more than the arithmetic.  They borrow the C stack instead.*/
	  NV stackbuf[256];
	CODE:
	  /*How many values there are, from the array lengths alone.  Every
	  element has to be defined (an undef croaks below, as it always has),
	  so this bound is exact and the old counting pass over every SV -- a
	  second walk of the whole input before any arithmetic -- is gone.*/
	  for (Stack_off_t i = 0; i < items; i++) {
		   SV* arg = ST(i);
		   if (SvROK(arg) && SvTYPE(SvRV(arg)) == SVt_PVAV)
			   total_count += (size_t)(av_len((AV*)SvRV(arg)) + 1);
		   else
			   total_count++;
	  }
	  if (total_count == 0) croak("median needs >= 1 element");

	  nums = (total_count <= sizeof(stackbuf) / sizeof(stackbuf[0])) ? stackbuf : NULL;
	  if (!nums) Newx(nums, total_count, NV);

	  //Populate the C array — free the buffer before any croak
	  for (Stack_off_t i = 0; i < items; i++) {
		   SV* arg = ST(i);
		   if (SvROK(arg) && SvTYPE(SvRV(arg)) == SVt_PVAV) {
			   AV* av = (AV*)SvRV(arg);
			   size_t len = av_len(av) + 1;
			   if (SvRMAGICAL((SV*)av)) {
				   /*Tied, so the cells are not in AvARRAY -- which is NULL,
				   while av_len reports the tied FETCHSIZE, so the branch
				   below would read off a null pointer.  av_fetch hands back
				   a deferred PVLV rather than the value, and SvOK on that is
				   false until its get-magic runs: without SvGETMAGIC every
				   element of a tied array looks undefined and this croaks
				   on data that is perfectly well defined.*/
				   for (size_t j = 0; j < len; j++) {
					   SV** tv = av_fetch(av, j, 0);
					   if (tv) SvGETMAGIC(*tv);
					   if (tv && SvOK(*tv)) {
						   nums[k++] = SvNV(*tv);
					   } else {
						   if (nums != stackbuf) Safefree(nums);
						   /*UVuf, not %zu: croak() runs perl's own formatter, which does not
						   understand the C99 z modifier and prints it literally on older
						   perls (5.10 and 5.12 both do)*/
						   croak("median: undefined value at array ref index %" UVuf " (argument %" UVuf ")", (UV)j, (UV)i);
					   }
				   }
			   } else {
				   /*AvARRAY, not av_fetch: the length is known and the cells
				   are right there, so the bounds check and the call per
				   element buy nothing*/
				   SV** src = AvARRAY(av);
				   for (size_t j = 0; j < len; j++) {
					   SV* tv = src[j];
					   if (tv && SvOK(tv)) {
						   nums[k++] = SvNV(tv);
					   } else {
						   if (nums != stackbuf) Safefree(nums);
						   croak("median: undefined value at array ref index %" UVuf " (argument %" UVuf ")", (UV)j, (UV)i);
					   }
				   }
			   }
		   } else if (SvOK(arg)) {
			   nums[k++] = SvNV(arg);
		   } else {
			   if (nums != stackbuf) Safefree(nums);
			   croak("median: undefined value at argument index %" UVuf, (UV)i);
		   }
	  }
  /*Select the middle value(s) rather than sorting all of them.  For an
  even count the lower of the pair is the largest value left below the
  upper one, which a scan of that side finds without a second select.*/
	  if (total_count & 1) {
		   nv_select(nums, total_count, total_count / 2);
		   median_val = nums[total_count / 2];
	  } else {
		   const size_t up = total_count / 2;
		   nv_select(nums, total_count, up);
		   NV lower = nums[0];
		   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 &&
		strcmp(method, "kendall")  != 0)
		  croak("cor: unknown method '%s' (use 'pearson', 'spearman', or 'kendall')",
				method);

	// validate x
	if (!SvROK(x_sv) || SvTYPE(SvRV(x_sv)) != SVt_PVAV)
		  croak("cor: x must be an ARRAY reference");

	AV*x_av = (AV*)SvRV(x_sv);
	size_t nx   = av_len(x_av) + 1;
	if (nx == 0) croak("cor: x is empty");

	// detect whether x is a flat vector or a matrix (AoA)
	bool x_is_matrix = 0;
	{
		SV**fp = av_fetch(x_av, 0, 0);
		if (fp && SvROK(*fp) && SvTYPE(SvRV(*fp)) == SVt_PVAV)
			x_is_matrix = 1;
	}

	// detect y
	bool has_y = (SvOK(y_sv) && SvROK(y_sv) &&
				   SvTYPE(SvRV(y_sv)) == SVt_PVAV);

	AV*y_av = has_y ? (AV*)SvRV(y_sv) : NULL;
	size_t ny = has_y ? av_len(y_av) + 1 : 0;

	bool y_is_matrix = 0;
	if (has_y && ny > 0) {
		SV**fp = av_fetch(y_av, 0, 0);
		if (fp && SvROK(*fp) && SvTYPE(SvRV(*fp)) == SVt_PVAV)
			y_is_matrix = 1;
	}

	CODE:
	// Branch 1: both inputs are flat vectors  →  scalar result
	if (!x_is_matrix && !y_is_matrix) {
		if (!has_y) {
			// cor(vector) == 1 by definition
			RETVAL = newSVnv(1.0);
		} else {
			if (nx != ny)
				croak("cor: x and y must have the same length (%" UVuf " vs %" UVuf ")",
					   (UV)nx, (UV)ny);
			if (nx < 2)
				croak("cor: need at least 2 observations");
			NV *xd, *yd;
			Newx(xd, nx, NV);
			Newx(yd, ny, NV);
			/* Read both columns first, then look for zero variance in the NV
			buffers.  Splitting the pass costs one more sweep over memory the
			extraction has just left in cache, and buys the extraction the
			direct AvARRAY() walk.  nv_all_equal() stops at the first pair
			that differs, so that sweep is two elements long on any column
			that actually varies. */
			av_extract_or_nan(aTHX_ x_av, (SSize_t)nx, xd);
			av_extract_or_nan(aTHX_ y_av, (SSize_t)ny, yd);
			const bool x_sd0 = nv_all_equal(xd, nx);
			const bool y_sd0 = nv_all_equal(yd, ny);
			if (x_sd0 || y_sd0) {
				Safefree(xd); Safefree(yd);
				if (x_sd0) croak("cor: standard deviation of x is 0");
				croak("cor: standard deviation of y is 0");
			}
			NV r = compute_cor(xd, yd, nx, method);
			Safefree(xd); Safefree(yd);
			RETVAL = newSVnv(r);
		}
	} else {//Branch 2: x is a matrix (or y is a matrix)  →  AoA result
		// resolve x matrix dimensions
		if (!x_is_matrix)
			croak("cor: x must be a matrix (array ref of array refs) "
				   "when y is a matrix");

		SV**xr0 = av_fetch(x_av, 0, 0);
		if (!xr0 || !SvROK(*xr0) || SvTYPE(SvRV(*xr0)) != SVt_PVAV)
			croak("cor: each row of x must be an ARRAY reference");

		size_t ncols_x = av_len((AV*)SvRV(*xr0)) + 1;
		if (ncols_x == 0) croak("cor: x matrix has zero columns");

		size_t nrows   = nx;    //observations
		size_t ncols_y = 0;
		/*Everything a croak below this point has to hand back, in one place.
		All of it is NULL until it is fully built -- a col_* table is only
		published once every column in it is allocated -- so the macro can
		free unconditionally.  Safefree(NULL) is a no-op.*/
		AV **xrows = NULL, **yrows = NULL;
		NV **col_x = NULL, **col_y = NULL;
		NV *rowbuf = NULL;
		bool symmetric = FALSE;
#define COR_MAT_FREE STMT_START {						\
	if (col_x) { for (size_t f_ = 0; f_ < ncols_x; f_++) Safefree(col_x[f_]); }	\
	Safefree(col_x);								\
	if (col_y && !symmetric) {							\
		for (size_t f_ = 0; f_ < ncols_y; f_++) Safefree(col_y[f_]);		\
		Safefree(col_y);							\
	}										\
	Safefree(rowbuf); Safefree(xrows); Safefree(yrows);				\
} STMT_END
		/*PRE-VALIDATION PASS: every row must be an array ref.  It keeps the
		row AVs it resolves instead of throwing them away, so the extraction
		below does not have to fetch them again -- once per row here against
		once per (row, column) cell before.*/
		Newx(xrows, nrows, AV*);
		for (size_t i = 0; i < nrows; i++) {
			SV**rv = av_fetch(x_av, i, 0);
			if (!rv || !*rv || !SvROK(*rv) || SvTYPE(SvRV(*rv)) != SVt_PVAV) {
				 COR_MAT_FREE;
				 croak("cor: x row %" UVuf " is not an array ref", (UV)i);
			}
			xrows[i] = (AV*)SvRV(*rv);
		}

		if (has_y && y_is_matrix) {
			if (ny != nrows) {
				COR_MAT_FREE;
				croak("cor: x and y must have the same number of rows (%" UVuf " vs %" UVuf ")", (UV)nrows, (UV)ny);
			}
			Newx(yrows, nrows, AV*);
			for (size_t i = 0; i < nrows; i++) {
				 SV**rv = av_fetch(y_av, i, 0);
				 if (!rv || !*rv || !SvROK(*rv) || SvTYPE(SvRV(*rv)) != SVt_PVAV) {
					 COR_MAT_FREE;
					 croak("cor: y row %" UVuf " is not an array ref", (UV)i);
				 }
				 yrows[i] = (AV*)SvRV(*rv);
			}
		}
		//one row wide, reused for every row of both matrices
		Newx(rowbuf, ncols_x, NV);
		// -- extract x columns
		{
			NV **cx;
			Newx(cx, ncols_x, NV*);
			for (size_t j = 0; j < ncols_x; j++) Newx(cx[j], nrows, NV);
			col_x = cx;
		}
		cor_extract_cols(aTHX_ xrows, nrows, col_x, ncols_x, rowbuf);
		for (size_t j = 0; j < ncols_x; j++) {
			if (nv_all_equal(col_x[j], nrows)) {
				 COR_MAT_FREE;
				 croak("cor: standard deviation is 0 in x column %" UVuf, (UV)j);
			}
		}
		// resolve y: separate matrix or re-use x (symmetric)
		if (has_y && y_is_matrix) {
			// cross-correlation: X (nrows × p) vs Y (nrows × q)
			ncols_y = av_len(yrows[0]) + 1;
			if (ncols_y == 0) { COR_MAT_FREE; croak("cor: y matrix has zero columns"); }
			if (ncols_y > ncols_x) Renew(rowbuf, ncols_y, NV);	//a wider y needs a wider scratch row
			{
				NV **cy;
				Newx(cy, ncols_y, NV*);
				for (size_t j = 0; j < ncols_y; j++) Newx(cy[j], nrows, NV);
				col_y = cy;
			}
			cor_extract_cols(aTHX_ yrows, nrows, col_y, ncols_y, rowbuf);
			for (size_t j = 0; j < ncols_y; j++) {
				 if (nv_all_equal(col_y[j], nrows)) {
					 COR_MAT_FREE;
					 croak("cor: standard deviation is 0 in y column %" UVuf, (UV)j);
				 }
			}
		} else { // cor(X) — symmetric p×p result; share column arrays
			ncols_y  = ncols_x;
			col_y    = col_x;
			symmetric = TRUE;
		}
		if (nrows < 2) {
			COR_MAT_FREE;
			croak("cor: need at least 2 observations (got %" UVuf ")", (UV)nrows);
		}
		/*The rows themselves are not read again: every value is in col_x /
		col_y from here on.*/
		Safefree(rowbuf); rowbuf = NULL;
		Safefree(xrows);  xrows  = NULL;
		Safefree(yrows);  yrows  = NULL;
		// -- build cache for symmetric case: compute upper triangle, store results, mirror to lower triangle
		AV*result_av = newAV();
		av_extend(result_av, ncols_x - 1);
		// Allocate per-row AVs up front so we can fill them in order
		AV **rows_out;
		Newx(rows_out, ncols_x, AV*);
		for (size_t i = 0; i < ncols_x; i++) {
			rows_out[i] = newAV();
			av_extend(rows_out[i], ncols_y - 1);
		}
		if (symmetric) {
		// Upper triangle + diagonal, then mirror. r_cache[i][j] (j >= i) holds the computed value
			NV **r_cache;
			Newx(r_cache, ncols_x, NV*);
			for (size_t i = 0; i < ncols_x; i++)
				 Newx(r_cache[i], ncols_x, NV);
			for (size_t i = 0; i < ncols_x; i++) {
				 r_cache[i][i] = 1.0; // diagonal
				 for (size_t j = i + 1; j < ncols_x; j++) {
					 NV r = compute_cor(col_x[i], col_x[j], nrows, method);
					 r_cache[i][j] = r;
					 r_cache[j][i] = r; // symmetry
				 }
			}
			// fill output AoA from cache
			for (size_t i = 0; i < ncols_x; i++)
				 for (size_t j = 0; j < ncols_x; j++)
					 av_store(rows_out[i], j, newSVnv(r_cache[i][j]));

			for (size_t i = 0; i < ncols_x; i++) Safefree(r_cache[i]);
			Safefree(r_cache); r_cache = NULL;
		} else {// cross-correlation: every (i,j) pair is independent
			for (size_t i = 0; i < ncols_x; i++)
				for (size_t j = 0; j < ncols_y; j++)
					av_store(rows_out[i], j, newSVnv(compute_cor(col_x[i], col_y[j], nrows, method)));
		}
		// push row AVs into result
		for (size_t i = 0; i < ncols_x; i++)
			av_store(result_av, i, newRV_noinc((SV*)rows_out[i]));
		Safefree(rows_out); rows_out = NULL;
		COR_MAT_FREE;		//the column tables; rowbuf and the row tables are already gone
#undef COR_MAT_FREE
		RETVAL = newRV_noinc((SV*)result_av);
	}
	OUTPUT:
		RETVAL

void scale(...)
	PROTOTYPE: @
	PPCODE:
	{
		bool do_center_mean = 1, do_scale_sd = 1;
		NV center_val = 0.0, scale_val = 1.0;
		size_t data_items = items;
		if (items > 0) {// 1. Parse Options Hash (if it exists as the last argument)
			SV*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*opt_hv = (HV*)SvRV(last_arg);
				// Parse 'center'
				SV**center_sv = hv_fetch(opt_hv, "center", 6, 0);
				if (center_sv) {
				  SV*val_sv = *center_sv;
				  if (!SvOK(val_sv)) {
						do_center_mean = 0; center_val = 0.0;
				  } else {
						char *str = SvPV_nolen(val_sv);
						//Trap booleans and empty strings before numeric checks
						if (str_ieq_ascii(str, "mean") || str_ieq_ascii(str, "true") || strcmp(str, "1") == 0) {
							 do_center_mean = 1;
						} else if (str_ieq_ascii(str, "none") || str_ieq_ascii(str, "false") || strcmp(str, "0") == 0 || strcmp(str, "") == 0) {
							 do_center_mean = 0; center_val = 0.0;
						} else if (looks_like_number(val_sv)) {
							 do_center_mean = 0; center_val = SvNV(val_sv);
						} else if (SvTRUE(val_sv)) {
							 do_center_mean = 1;
						} else {
							 do_center_mean = 0; center_val = 0.0;
						}
				  }
				}
				// Parse 'scale'
				SV**scale_sv = hv_fetch(opt_hv, "scale", 5, 0);
				if (scale_sv) {
				  SV*val_sv = *scale_sv;
				  if (!SvOK(val_sv)) {
						do_scale_sd = 0; scale_val = 1.0;
				  } else {
						char *str = SvPV_nolen(val_sv);
						if (str_ieq_ascii(str, "sd") || str_ieq_ascii(str, "true") || strcmp(str, "1") == 0) {
							 do_scale_sd = 1;
						} else if (str_ieq_ascii(str, "none") || str_ieq_ascii(str, "false") || strcmp(str, "0") == 0 || strcmp(str, "") == 0) {
							 do_scale_sd = 0; scale_val = 1.0;
						} else if (looks_like_number(val_sv)) {
							 do_scale_sd = 0; scale_val = SvNV(val_sv);
							 if (scale_val == 0.0) scale_val = 1.0; //Prevent Division By Zero
						} else if (SvTRUE(val_sv)) {
							 do_scale_sd = 1;
						} else {
							 do_scale_sd = 0; scale_val = 1.0;
						}
				  }
				}
			}
		}
		// 2. Detect if the input is a Matrix (Array of Arrays)
		bool is_matrix = 0;
		if (data_items == 1) {
			SV*first_arg = ST(0);
			if (SvROK(first_arg) && SvTYPE(SvRV(first_arg)) == SVt_PVAV) {
				 AV*av = (AV*)SvRV(first_arg);
				 if (av_len(av) >= 0) {
					 SV**first_elem = av_fetch(av, 0, 0);
					 if (first_elem && SvROK(*first_elem) && SvTYPE(SvRV(*first_elem)) == SVt_PVAV) {
						 is_matrix = TRUE;
					 }
				 }
			}
		}
		if (is_matrix) {// MATRIX MODE: Scale columns independently (Just like R)
			AV*mat_av = (AV*)SvRV(ST(0));
			size_t nrow = av_len(mat_av) + 1, ncol = 0;
			SV**first_row = av_fetch(mat_av, 0, 0);
			ncol = av_len((AV*)SvRV(*first_row)) + 1;
			if (nrow == 0 || ncol == 0) croak("scale requires non-empty matrix");
			// Create a new matrix for the scaled output
			AV*result_av = newAV();
			av_extend(result_av, nrow - 1);
			AV**row_ptrs = (AV**)safemalloc(nrow * sizeof(AV*));
			for (size_t r = 0; r < nrow; r++) {
				row_ptrs[r] = newAV();
				av_extend(row_ptrs[r], ncol - 1);
				av_push(result_av, newRV_noinc((SV*)row_ptrs[r]));
			}
			for (size_t c = 0; c < ncol; c++) {// Calculate and apply scale per column
				 NV col_sum = 0.0;
				 NV *col_data;
				 Newx(col_data, nrow, NV);
				 for (size_t r = 0; r < nrow; r++) {// Extract the column data
					 SV**row_sv = av_fetch(mat_av, r, 0);
					 if (row_sv && SvROK(*row_sv)) {
						 AV*row_av = (AV*)SvRV(*row_sv);
						 SV**cell_sv = av_fetch(row_av, c, 0);
						 col_data[r] = (cell_sv && SvOK(*cell_sv)) ? SvNV(*cell_sv) : 0.0;
					 } else {
						 col_data[r] = 0.0;
					 }
					 col_sum += col_data[r];
				 }
				 NV col_center = do_center_mean ? (col_sum / nrow) : center_val;
				 NV col_scale = scale_val;
				 // Calculate Standard Deviation for this specific column if needed
				 if (do_scale_sd) {
					 if (nrow <= 1) {
						 Safefree(col_data);
						 safefree(row_ptrs);
						 croak("scale needs >= 2 rows to calculate standard deviation for a matrix column");
					 }
					 NV sum_sq = 0.0;
					 for (size_t r = 0; r < nrow; r++) {
						 NV diff = col_data[r] - col_center;
						 sum_sq += diff * diff;
					 }
					 col_scale = nv_sqrt(sum_sq / (nrow - 1));
				 }
				 // Store scaled values back into the new matrix rows
				 for (size_t r = 0; r < nrow; r++) {
					 NV centered = col_data[r] - col_center;
					 NV final_val = (col_scale == 0.0) ? (0.0 / 0.0) : (centered / col_scale);
					 av_store(row_ptrs[r], c, newSVnv(final_val));
				 }
				 Safefree(col_data);
			}
			safefree(row_ptrs);
	// Push the resulting matrix as a single Reference onto the Perl stack
			EXTEND(SP, 1);
			PUSHs(sv_2mortal(newRV_noinc((SV*)result_av)));
		} else {// FLAT LIST MODE: Original functionality
			size_t total_count = 0, k = 0;
			NV *nums;
			NV sum = 0.0;
			for (size_t i = 0; i < data_items; i++) {
				SV*arg = ST(i);
				if (SvROK(arg) && SvTYPE(SvRV(arg)) == SVt_PVAV) {
					AV*av = (AV*)SvRV(arg);
					size_t len = av_len(av) + 1;
					for (unsigned int j = 0; j < len; j++) {
						SV**tv = av_fetch(av, j, 0);
						if (tv && SvOK(*tv)) { total_count++; }
					}
				} else if (SvOK(arg)) {
					total_count++;
				}
			}
			if (total_count == 0) croak("scale requires at least 1 numeric element");
			Newx(nums, total_count, NV);
			for (size_t i = 0; i < data_items; i++) {
				 SV*arg = ST(i);
				 if (SvROK(arg) && SvTYPE(SvRV(arg)) == SVt_PVAV) {
					 AV*av = (AV*)SvRV(arg);
					 size_t len = av_len(av) + 1;
					 for (size_t j = 0; j < len; j++) {
						 SV**tv = av_fetch(av, j, 0);
						 if (tv && SvOK(*tv)) { 
							 NV val = SvNV(*tv);
							 nums[k++] = val; sum += val;
						 }
					 }
				 } else if (SvOK(arg)) {
					 NV val = SvNV(arg);
					 nums[k++] = val; sum += val;
				 }
			}
			if (do_center_mean) center_val = sum / total_count;
			if (do_scale_sd) {
				 if (total_count <= 1) {
					 Safefree(nums);
					 croak("scale needs >= 2 elements to calculate SD");
				 }
				 NV sum_sq = 0.0;
				 for (size_t i = 0; i < total_count; i++) {
					 NV diff = nums[i] - center_val;
					 sum_sq += diff * diff;
				 }
				 scale_val = nv_sqrt(sum_sq / (total_count - 1));
			}
			EXTEND(SP, total_count);
			for (size_t i = 0; i < total_count; i++) {
				NV centered = nums[i] - center_val;
				NV final_val = (scale_val == 0.0) ? (0.0 / 0.0) : (centered / scale_val);
				PUSHs(sv_2mortal(newSVnv(final_val)));
			}
			Safefree(nums); nums = NULL;
		}
	}

SV* matrix(...) 
CODE:
	SV*data_sv = NULL;
	size_t nrow = 0, ncol = 0;
	bool byrow = 0, nrow_set = 0, ncol_set = 0;
	//Hybrid Argument Parser
	if (items > 0 && SvROK(ST(0)) && SvTYPE(SvRV(ST(0))) == SVt_PVAV) {
		//POSITIONAL: matrix($data_ref, $nrow, $ncol, $byrow)
		data_sv = ST(0);
		if (items > 1 && SvOK(ST(1))) {
			nrow = (size_t)SvUV(ST(1));
			nrow_set = TRUE;
		}
		if (items > 2 && SvOK(ST(2))) {
			ncol = (size_t)SvUV(ST(2));
			ncol_set = TRUE;
		}
		if (items > 3 && SvOK(ST(3))) {
			byrow = SvTRUE(ST(3));
		}
	} else if (items % 2 == 0) {// NAMED: matrix(data => [...], nrow => $n, ncol => $m)
		for (Stack_off_t i = 0; i < items; i += 2) {
			char*key = SvPV_nolen(ST(i));
			SV*val   = ST(i + 1);
			if (strEQ(key, "data")) {
				 data_sv = val;
			} else if (strEQ(key, "nrow")) {
				 if (SvOK(val)) { nrow = (size_t)SvUV(val); nrow_set = TRUE; }
			} else if (strEQ(key, "ncol")) {
				 if (SvOK(val)) { ncol = (size_t)SvUV(val); ncol_set = TRUE; }
			} else if (strEQ(key, "byrow")) {
				 byrow = SvTRUE(val);
			} else {
				 croak("Unknown option: %s", key);
			}
		}
	} else {
		croak("Usage: matrix($data_ref, $nrow, $ncol, $byrow) OR matrix(data => $data_ref, ...)");
	}
	// Validate data input
	if (!data_sv || !SvROK(data_sv) || SvTYPE(SvRV(data_sv)) != SVt_PVAV) {
		croak("The 'data' option must be an array reference (e.g. [1..6] or rnorm(6))");
	}
	AV*data_av = (AV*)SvRV(data_sv);
	size_t data_len = (UV)(av_top_index(data_av) + 1);
	if (data_len == 0) {
		croak("Data array cannot be empty");
	}
	// R-style dimension inference
	if (!nrow_set && !ncol_set) {
		nrow = data_len;
		ncol = 1;
	} else if (nrow_set && !ncol_set) {
		ncol = (data_len + nrow - 1) / nrow;
	} else if (!nrow_set && ncol_set) {
		nrow = (data_len + ncol - 1) / ncol;
	}
	// Final safety check for dimensions
	if (nrow == 0 || ncol == 0) {
	croak("Dimensions must be greater than 0");
	}
	// Create the matrix (Array of Arrays)
	AV*result_av = newAV();
	av_extend(result_av, nrow - 1);
	size_t r, c; // Use unsigned types for counters to prevent negative indexing
	AV**row_ptrs = (AV**)safemalloc(nrow * sizeof(AV*)); //Pre-allocate row pointers
	for (r = 0; r < nrow; r++) {
		row_ptrs[r] = newAV();
		av_extend(row_ptrs[r], ncol - 1);
		av_push(result_av, newRV_noinc((SV*)row_ptrs[r]));
	}
	// Fill the matrix
	size_t total_cells = nrow * ncol;
	for (size_t i = 0; i < total_cells; i++) {// Vector recycling logic
		SV**fetched = av_fetch(data_av, i % data_len, 0);
		SV*val = fetched ? newSVsv(*fetched) : newSV(0);
		if (byrow) {
			r = i / ncol;
			c = i % ncol;
		} else {
			r = i % nrow;
			c = i / nrow;
		}
		av_store(row_ptrs[r], c, val);
	}
	safefree(row_ptrs);
	RETVAL = newRV_noinc((SV*)result_av);
OUTPUT:
	RETVAL

SV *lm(...)
	CODE:
	{
		const char *formula = NULL;
		SV   *data_sv = NULL;
		char *f_cpy   = NULL;
		char *lhs = NULL, *rhs = NULL, **terms = NULL, **uniq_terms = NULL;
		LmDesign *design = NULL;
		unsigned int num_terms = 0, num_uniq = 0, p = 0;
		size_t n = 0, valid_n = 0, i, j, k;
		bool has_intercept = 1;
		char **row_names = NULL, **restrict valid_row_names = NULL;
		HV  **row_hashes = NULL;
		HV   *data_hoa = NULL;
		NV   *X = NULL, *Y = NULL, *XtX = NULL, *XtY = NULL;
		bool *restrict aliased = NULL;
		NV   *beta = NULL;
		int   final_rank = 0, df_res = 0;
		HV   *res_hv, *coef_hv, *fitted_hv, *resid_hv, *summary_hv;
		AV   *terms_av;
		HV   *xlevels_hv = NULL;
		NV    rss = 0.0, rse_sq = 0.0;
		if (items % 2 != 0)
			croak("Usage: lm(formula => 'mpg ~ wt * hp', data => \\%%mtcars)");
		for (I32 i_arg = 0; i_arg < items; i_arg += 2) {
			const char *key = SvPV_nolen(ST(i_arg));
			SV *val = ST(i_arg + 1);
			if      (strEQ(key, "formula")) formula = SvPV_nolen(val);
			else if (strEQ(key, "data"))    data_sv = val;
			else croak("lm: unknown argument '%s'", key);
		}
		if (!formula) croak("lm: formula is required");
		if (!data_sv || !SvROK(data_sv)) croak("lm: data is required and must be a reference");
	/*Split the formula before touching the data: a malformed one croaks
	with nothing else allocated. '.' needs the columns, so the term list
	has to wait until after the rows are read.*/
		f_cpy = lm_formula_split(aTHX_ formula, "lm", &lhs, &rhs, &has_intercept);
		n = lm_read_rows(aTHX_ data_sv, "lm", f_cpy, &data_hoa, &row_hashes, &row_names);
		lm_formula_terms(aTHX_ rhs, lhs, data_hoa, row_hashes, n, has_intercept, "lm",
		                 &terms, &num_terms, &uniq_terms, &num_uniq);
			xlevels_hv = newHV(); sv_2mortal((SV*)xlevels_hv);
		design = lm_design_build(aTHX_ data_hoa, row_hashes, n,
		                         uniq_terms, num_uniq, has_intercept, xlevels_hv);
		p = design->ncol;
		Newx(X, n * (p ? p : 1), NV); Newx(Y, n, NV);
		Newx(valid_row_names, n, char*);

		for (i = 0; i < n; i++) {
			NV y_val = evaluate_term(aTHX_ data_hoa, row_hashes, i, lhs);
			if (nv_isnan(y_val)) { Safefree(row_names[i]); continue; }

			if (!lm_design_row(aTHX_ design, data_hoa, row_hashes, i,
			                   X + valid_n * (size_t)p)) {
				Safefree(row_names[i]); continue;
			}
			Y[valid_n] = y_val;
			valid_row_names[valid_n] = row_names[i];
			valid_n++;
		}
		Safefree(row_names);
		if (valid_n <= p) {
			for (i = 0; i < num_terms; i++) Safefree(terms[i]); Safefree(terms);
			for (i = 0; i < num_uniq; i++) Safefree(uniq_terms[i]); Safefree(uniq_terms);
			lm_design_free(aTHX_ design);
			for (i = 0; i < valid_n; i++) Safefree(valid_row_names[i]);
			Safefree(X); Safefree(Y); Safefree(valid_row_names);
			if (row_hashes) Safefree(row_hashes);
			Safefree(f_cpy);
			croak("lm: 0 degrees of freedom (too many NAs or parameters > observations)");
		}
		Safefree(f_cpy); f_cpy = NULL;

		if (valid_n < n) Renew(X, valid_n * (size_t)p, NV);

		Newxz(XtX, p * p, NV);
		for (i = 0; i < p; i++)
			for (j = 0; j < p; j++) {
				NV sum = 0.0;
				for (k = 0; k < valid_n; k++) sum += X[k * p + i] * X[k * p + j];
				XtX[i * p + j] = sum;
			}
		Newxz(XtY, p, NV);
		for (i = 0; i < p; i++) {
			NV sum = 0.0;
			for (k = 0; k < valid_n; k++) sum += X[k * p + i] * Y[k];
			XtY[i] = sum;
		}
		Newx(aliased, p, bool);
		final_rank = sweep_matrix_ols(XtX, p, aliased);
		Newxz(beta, p, NV);
		for (i = 0; i < p; i++) {
			if (aliased[i]) { beta[i] = NAN; }
			else {
				NV sum = 0.0;
				for (j = 0; j < p; j++) if (!aliased[j]) sum += XtX[i * p + j] * XtY[j];
				beta[i] = sum;
			}
		}

		res_hv = newHV(); coef_hv = newHV(); fitted_hv = newHV(); resid_hv = newHV();
		summary_hv = newHV(); terms_av = newAV();
		df_res = (int)valid_n - final_rank;
		NV sum_y = 0.0, mss = 0.0;
		for (i = 0; i < valid_n; i++) sum_y += Y[i];
		NV mean_y = sum_y / (NV)valid_n;
		for (i = 0; i < valid_n; i++) {
			NV y_hat = 0.0;
			for (j = 0; j < p; j++) if (!aliased[j]) y_hat += X[i * p + j] * beta[j];
			NV res    = Y[i] - y_hat;
			rss      += res * res;
			NV diff_m = has_intercept ? (y_hat - mean_y) : y_hat;
			mss      += diff_m * diff_m;
			hv_store(fitted_hv, valid_row_names[i], strlen(valid_row_names[i]), newSVnv(y_hat), 0);
			hv_store(resid_hv,  valid_row_names[i], strlen(valid_row_names[i]), newSVnv(res),   0);
			Safefree(valid_row_names[i]);
		}
		Safefree(valid_row_names);
		rse_sq = (df_res > 0) ? (rss / (NV)df_res) : NAN;

		int df_int = has_intercept ? 1 : 0;
		NV r_squared = 0.0, adj_r_squared = 0.0, f_stat = NAN, f_pvalue = NAN;
		int numdf = final_rank - df_int;

		if (final_rank != df_int && (mss + rss) > 0.0) {
			r_squared     = mss / (mss + rss);
			adj_r_squared = 1.0 - (1.0 - r_squared) * ((NV)(valid_n - df_int) / (NV)df_res);
			if (rse_sq > 0.0 && numdf > 0) {
				f_stat   = (mss / (NV)numdf) / rse_sq;
				f_pvalue = pf_upper(f_stat, (NV)numdf, (NV)df_res);
			} else if (rse_sq == 0.0) {
				f_stat   = INFINITY;
				f_pvalue = 0.0;
			}
		} else if (final_rank == df_int) {
			r_squared = 0.0; adj_r_squared = 0.0;
		}
		for (j = 0; j < p; j++) {
			const char *cname = design->col[j].name;
			hv_store(coef_hv, cname, strlen(cname), newSVnv(beta[j]), 0);
			av_push(terms_av, newSVpv(cname, 0));
			HV *row_hv = newHV();
			if (aliased[j]) {
				hv_store(row_hv, "Estimate",   8,  newSVpv("NaN", 0), 0);
				hv_store(row_hv, "Std. Error", 10, newSVpv("NaN", 0), 0);
				hv_store(row_hv, "t value",    7,  newSVpv("NaN", 0), 0);
				hv_store(row_hv, "Pr(>|t|)",   8,  newSVpv("NaN", 0), 0);
			} else {
				NV se    = nv_sqrt(rse_sq * XtX[j * p + j]);
				NV t_val = (se > 0.0) ? (beta[j] / se) : (INFINITY * (beta[j] >= 0.0 ? 1.0 : -1.0));
				NV p_val = get_t_pvalue(t_val, df_res, "two.sided");
				hv_store(row_hv, "Estimate",   8,  newSVnv(beta[j]), 0);
				hv_store(row_hv, "Std. Error", 10, newSVnv(se),      0);
				hv_store(row_hv, "t value",    7,  newSVnv(t_val),   0);
				hv_store(row_hv, "Pr(>|t|)",   8,  newSVnv(p_val),   0);
			}
			hv_store(summary_hv, cname, strlen(cname), newRV_noinc((SV*)row_hv), 0);
		}
		hv_store(res_hv, "coefficients",  12, newRV_noinc((SV*)coef_hv),   0);
		hv_store(res_hv, "fitted.values", 13, newRV_noinc((SV*)fitted_hv), 0);
		hv_store(res_hv, "residuals",      9, newRV_noinc((SV*)resid_hv),  0);
		hv_store(res_hv, "df.residual",   11, newSVuv(df_res),             0);
		hv_store(res_hv, "rank",           4, newSVuv(final_rank),         0);
		hv_store(res_hv, "rss",            3, newSVnv(rss),                0);
		hv_store(res_hv, "summary",        7, newRV_noinc((SV*)summary_hv),0);
		hv_store(res_hv, "terms",          5, newRV_noinc((SV*)terms_av),  0);
		hv_store(res_hv, "r.squared",      9, newSVnv(r_squared),          0);
		hv_store(res_hv, "adj.r.squared", 13, newSVnv(adj_r_squared),      0);
		hv_store(res_hv, "xlevels",       7, newRV_inc((SV*)xlevels_hv), 0);
		if (!nv_isnan(f_stat)) {
			AV *fstat_av = newAV();
			av_push(fstat_av, newSVnv(f_stat));
			av_push(fstat_av, newSViv(numdf));
			av_push(fstat_av, newSViv(df_res));
			hv_store(res_hv, "fstatistic", 10, newRV_noinc((SV*)fstat_av), 0);
			hv_store(res_hv, "f.pvalue",    8, newSVnv(f_pvalue),          0);
		}
		for (i = 0; i < num_terms; i++) Safefree(terms[i]); Safefree(terms);
		for (i = 0; i < num_uniq; i++) Safefree(uniq_terms[i]); Safefree(uniq_terms);
		lm_design_free(aTHX_ design);
		Safefree(X); Safefree(Y); Safefree(XtX); Safefree(XtY);
		Safefree(beta); Safefree(aliased);
		if (row_hashes) Safefree(row_hashes);

		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");
			}
		}
		if ((from < to && by < 0.0) || (from > to && by > 0.0)) {
			croak("wrong sign in 'by' argument");
		}// Check for wrong direction / infinite loop
	/*Calculate number of elements.
	R uses a small epsilon (like 1e-10) to avoid dropping the last
	element due to floating point inaccuracies.*/
		NV n_elements_d = (to - from) / by;
		if (n_elements_d < 0.0) n_elements_d = 0.0;
		size_t n_elements = (n_elements_d + 1e-10) + 1;
		// Pre-extend the stack to avoid reallocating inside the loop
		EXTEND(SP, n_elements);
		for (size_t i = 0; i < n_elements; i++) {
			mPUSHn(from + i * by);
		}
		XSRETURN(n_elements);
	}

SV* rnorm(...)
	CODE:
	{
	  // Auto-seed the PRNG if the Perl script hasn't done so yet
	  AUTO_SEED_PRNG();
	  size_t n = 0;
	  NV mean = 0.0, sd = 1.0;
	  int arg_start = 0;
	  // Check if the first argument is a simple integer (rnorm(33))
	  if (items > 0 && SvIOK(ST(0)) && (items == 1 || items % 2 != 0)) {
		   n = (unsigned int)SvUV(ST(0));
		   arg_start = 1; // Start parsing named arguments from the second element
	  }
	  // Parse remaining named arguments from the flat stack
	  if ((items - arg_start) % 2 != 0) {
		   croak("Usage: rnorm(n), rnorm(n => 10, mean => 0, sd => 1), or rnorm(33, mean => 0)");
	  }

	  for (int i = arg_start; i < items; i += 2) {
		   const char* key = SvPV_nolen(ST(i));
		   SV* val = ST(i + 1);

		   if      (strEQ(key, "n"))    n    = (unsigned int)SvUV(val);
		   else if (strEQ(key, "mean")) mean = SvNV(val);
		   else if (strEQ(key, "sd"))   sd   = SvNV(val);
		   else croak("rnorm: unknown argument '%s'", key);
	  }
	  if (sd < 0.0) croak("rnorm: standard deviation must be non-negative");
	  AV *result_av = newAV();
	  if (n > 0) {
		   av_extend(result_av, n - 1);
		   // Generate random normals using the Box-Muller transform
		   for (size_t i = 0; i < n; ) {
				NV u, v, s;
				do {
					// Drand01() hooks into Perl's internal PRNG, respecting Perl's srand()
					u = 2.0 * Drand01() - 1.0;
					v = 2.0 * Drand01() - 1.0;
					s = u * u + v * v;
				} while (s >= 1.0 || s == 0.0);
				NV mul = nv_sqrt(-2.0 * nv_log(s) / s);
				// Box-Muller generates two independent values per iteration
				av_store(result_av, i++, newSVnv(mean + sd * u * mul));
				if (i < n) {
					av_store(result_av, i++, newSVnv(mean + sd * v * mul));
				}
		   }
	  }
	  RETVAL = newRV_noinc((SV*)result_av);
	}
	OUTPUT:
	RETVAL

SV* aov(data_sv, formula_sv = &PL_sv_undef)
	SV* data_sv
	SV* formula_sv
	CODE:
	{
	const char *formula;
	SV *orig_data_sv = data_sv; // dropped `restrict` — this aliases data_sv (UB)
	bool is_stacked = FALSE;
	/*
	 PHASE 0: R-style stack() for missing formula
	*/
	if (!formula_sv || !SvOK(formula_sv) || SvCUR(formula_sv) == 0) {
		if (!SvROK(data_sv) || SvTYPE(SvRV(data_sv)) != SVt_PVHV) {
		  croak("aov: Without a formula, data must be a HashRef of ArrayRefs (mimicking R's named list)");
		}
		is_stacked = 1;
		HV *input_hv = (HV*)SvRV(data_sv);
		HV *stacked_hv = newHV();
		AV *val_av = newAV();
		AV *grp_av = newAV();
		hv_iterinit(input_hv);
		HE *entry;
		while ((entry = hv_iternext(input_hv))) {
		  SV *grp_name_sv = hv_iterkeysv(entry);
		  SV *arr_ref = hv_iterval(input_hv, entry);
		  if (SvROK(arr_ref) && SvTYPE(SvRV(arr_ref)) == SVt_PVAV) {
				AV *arr = (AV*)SvRV(arr_ref);
				SSize_t len = av_len(arr);           // signed — av_len is -1 when empty
				for (SSize_t k = 0; k <= len; k++) { // SSize_t, no SIZE_MAX underflow
					SV **v = av_fetch(arr, k, 0);
					if (v && *v && SvOK(*v)) {
						av_push(val_av, newSVsv(*v));
						av_push(grp_av, newSVsv(grp_name_sv));
					}
				}
		  } else {
				SvREFCNT_dec(val_av); SvREFCNT_dec(grp_av); SvREFCNT_dec(stacked_hv);
				croak("aov: Hash values must be ArrayRefs when no formula is provided");
		  }
		}
		hv_stores(stacked_hv, "Value", newRV_noinc((SV*)val_av));
		hv_stores(stacked_hv, "Group", newRV_noinc((SV*)grp_av));
		// sv_2mortal ensures memory is freed automatically on return or croak
		data_sv = sv_2mortal(newRV_noinc((SV*)stacked_hv));
		formula = "Value~Group";
	} else {
		 formula = SvPV_nolen(formula_sv);
	}
	char f_cpy[512];
	char *src, *dst, *tilde, *lhs, *rhs, *chunk;
	char **terms = NULL, **uniq_terms = NULL, **exp_terms = NULL, **parent_term = NULL;
	bool *is_dummy = NULL, *is_interact = NULL;
	char **dummy_base = NULL, **dummy_level = NULL;
	int *term_map = NULL, *left_idx = NULL, *right_idx = NULL;
	unsigned int term_cap = 64, exp_cap = 64, num_terms = 0, num_uniq = 0, p = 0, p_exp = 0;
	size_t n = 0, valid_n = 0, i, j;
	bool has_intercept = TRUE;
	char **row_names = NULL;
	HV **row_hashes = NULL;
	HV *data_hoa = NULL;
	SV *ref = NULL;
	HE *entry;
	NV **X_mat = NULL;
	NV *Y = NULL;
	char **term_base_level = NULL;  //reference level for each uniq_term (NULL if not categorical)
	if (!SvROK(data_sv)) croak("aov: data is required and must be a reference");
	// PHASE 1: Data Extraction
	ref = SvRV(data_sv);
	if (SvTYPE(ref) == SVt_PVHV) {
		HV*hv = (HV*)ref;
		if (hv_iterinit(hv) == 0) croak("aov: Data hash is empty");
		entry = hv_iternext(hv);
		if (entry) {
			 SV*val = hv_iterval(hv, entry);
			 if (SvROK(val) && SvTYPE(SvRV(val)) == SVt_PVAV) {
				  data_hoa = hv;
				  n = av_len((AV*)SvRV(val)) + 1;
				  Newx(row_names, n, char*);
				  for(i = 0; i < n; i++) {
					  char buf[32]; snprintf(buf, sizeof(buf), "%lu", (unsigned long)(i+1));
					  row_names[i] = savepv(buf);
				  }
			 } else if (SvROK(val) && SvTYPE(SvRV(val)) == SVt_PVHV) {
				  n = (size_t)HvUSEDKEYS(hv);     //CHANGED: real key count, not hv_iterinit's return
				  hv_iterinit(hv);
				  Newx(row_names, n, char*); Newx(row_hashes, n, HV*);
				  i = 0;
				  while ((entry = hv_iternext(hv))) {
					  I32 len;
					  row_names[i] = savepv(hv_iterkey(entry, &len));
					  row_hashes[i] = (HV*)SvRV(hv_iterval(hv, entry));
					  i++;
				  }
			 } else croak("aov: Hash values must be ArrayRefs (HoA) or HashRefs (HoH)");
		}
	} else if (SvTYPE(ref) == SVt_PVAV) {
		AV*av = (AV*)ref;
		n = av_len(av) + 1;
		Newx(row_names, n, char*);
		Newx(row_hashes, n, HV*);
		for (i = 0; i < n; i++) {
			SV**val = av_fetch(av, i, 0);
			if (val && SvROK(*val) && SvTYPE(SvRV(*val)) == SVt_PVHV) {
			  row_hashes[i] = (HV*)SvRV(*val);
			  char buf[32];
			  snprintf(buf, sizeof(buf), "%lu", (unsigned long)(i + 1));
			  row_names[i] = savepv(buf);
			} else {
			  for (size_t k = 0; k < i; k++) Safefree(row_names[k]);
			  Safefree(row_names); Safefree(row_hashes);
			  croak("aov: Array values must be HashRefs (AoH)");
			}
		}
	} else croak("aov: Data must be an Array or Hash reference");
	/*
	 PHASE 2: Formula Parsing & `.` Expansion
	*/
	src = (char*)formula; dst = f_cpy;
	while (*src && (dst - f_cpy < 511)) { if (!isspace(*src)) { *dst++ = *src; } src++; }
	*dst = '\0';
	tilde = strchr(f_cpy, '~');
	if (!tilde) {
		  for (i = 0; i < n; i++) Safefree(row_names[i]);
		  Safefree(row_names); if (row_hashes) Safefree(row_hashes);
		  croak("aov: invalid formula, missing '~'");
	}
	*tilde = '\0';
	lhs = f_cpy;
	rhs = tilde + 1;
	char *p_idx;
	while ((p_idx = strstr(rhs, "-1")) != NULL) { has_intercept = FALSE; memmove(p_idx, p_idx + 2, strlen(p_idx + 2) + 1); }
	while ((p_idx = strstr(rhs, "+0")) != NULL) { has_intercept = FALSE; memmove(p_idx, p_idx + 2, strlen(p_idx + 2) + 1); }
	while ((p_idx = strstr(rhs, "0+")) != NULL) { has_intercept = FALSE; memmove(p_idx, p_idx + 2, strlen(p_idx + 2) + 1); }
	if (rhs[0] == '0' && rhs[1] == '\0')        { has_intercept = FALSE; rhs[0] = '\0'; }
	while ((p_idx = strstr(rhs, "+1")) != NULL) { memmove(p_idx, p_idx + 2, strlen(p_idx + 2) + 1); }
	if (rhs[0] == '1' && rhs[1] == '\0')        { rhs[0] = '\0'; }
	else if (rhs[0] == '1' && rhs[1] == '+')    { memmove(rhs, rhs + 2, strlen(rhs + 2) + 1); }

	while ((p_idx = strstr(rhs, "++")) != NULL) memmove(p_idx, p_idx + 1, strlen(p_idx + 1) + 1);
	if (rhs[0] == '+') memmove(rhs, rhs + 1, strlen(rhs + 1) + 1);
	size_t len_rhs = strlen(rhs);
	if (len_rhs > 0 && rhs[len_rhs - 1] == '+') rhs[len_rhs - 1] = '\0';
	char rhs_expanded[2048] = "";
	size_t rhs_len = 0;
	chunk = strtok(rhs, "+");
	while (chunk != NULL) {
		if (strcmp(chunk, ".") == 0) {
			AV *cols = get_all_columns(aTHX_ data_hoa, row_hashes, n);
			SSize_t ncols = av_len(cols); // signed bound
			for (SSize_t c = 0; c <= ncols; c++) { // SSize_t loop
			  SV **col_sv = av_fetch(cols, c, 0);
			  if (col_sv && SvOK(*col_sv)) {
					const char *col_name = SvPV_nolen(*col_sv);
					if (strcmp(col_name, lhs) != 0) {
						 size_t slen = strlen(col_name);
						 if (rhs_len + slen + 2 < sizeof(rhs_expanded)) {
							 if (rhs_len > 0) { strcat(rhs_expanded, "+"); rhs_len++; }
							 strcat(rhs_expanded, col_name);
							 rhs_len += slen;
						 }
					}
			  }
			}
			SvREFCNT_dec(cols);
		} else {
			 size_t slen = strlen(chunk);
			 if (rhs_len + slen + 2 < sizeof(rhs_expanded)) {
				  if (rhs_len > 0) { strcat(rhs_expanded, "+"); rhs_len++; }
				  strcat(rhs_expanded, chunk);
				  rhs_len += slen;
			 }
		}
		chunk = strtok(NULL, "+");
	}
	// Setup arrays safely
	Newx(terms, term_cap, char*);
	Newx(uniq_terms, term_cap, char*);
	Newx(exp_terms, exp_cap, char*); Newx(parent_term, exp_cap, char*);
	Newx(is_dummy, exp_cap, bool); Newx(is_interact, exp_cap, bool);
	Newx(dummy_base, exp_cap, char*); Newx(dummy_level, exp_cap, char*);
	Newx(term_map, exp_cap, int); Newx(left_idx, exp_cap, int); Newx(right_idx, exp_cap, int);
	if (has_intercept) { terms[num_terms++] = savepv("Intercept"); }
	if (strlen(rhs_expanded) > 0) {
		chunk = strtok(rhs_expanded, "+");
		while (chunk != NULL) {
			 if (num_terms >= term_cap - 3) {
				  term_cap *= 2;
				  Renew(terms, term_cap, char*); Renew(uniq_terms, term_cap, char*);
			 }
			 char *star = strchr(chunk, '*');
			 if (star) {
				  *star = '\0';
				  char *left = chunk;
				  char *right = star + 1;
				  char *c_l = strchr(left, '^');
				  if (c_l && strncmp(left, "I(", 2) != 0) *c_l = '\0';
				  char *c_r = strchr(right, '^'); if (c_r && strncmp(right, "I(", 2) != 0) *c_r = '\0';
				  terms[num_terms++] = savepv(left);
				  terms[num_terms++] = savepv(right);
				  size_t inter_len = strlen(left) + strlen(right) + 2;
				  terms[num_terms] = (char*)safemalloc(inter_len);
				  snprintf(terms[num_terms++], inter_len, "%s:%s", left, right);
			 } else {
				  char *c_chunk = strchr(chunk, '^');
				  if (c_chunk && strncmp(chunk, "I(", 2) != 0) *c_chunk = '\0';
				  terms[num_terms++] = savepv(chunk);
			 }
			 chunk = strtok(NULL, "+");
		}
	}
	for (i = 0; i < num_terms; i++) {
		bool found = FALSE;
		for (size_t k = 0; k < num_uniq; k++) {
			if (strcmp(terms[i], uniq_terms[k]) == 0) { found = TRUE; break; }
		}
		if (!found) uniq_terms[num_uniq++] = savepv(terms[i]);
	}
	p = num_uniq;
	Newxz(term_base_level, num_uniq, char*);
	HV *xlevels_hv = newHV();   //factor base -> [sorted levels], idx 0 = reference
	//PHASE 3: Categorical & Interaction Expansion
	for (j = 0; j < p; j++) {
		if (p_exp + 64 >= exp_cap) {
			exp_cap *= 2;
			Renew(exp_terms, exp_cap, char*); Renew(parent_term, exp_cap, char*);
			Renew(is_dummy, exp_cap, bool); Renew(is_interact, exp_cap, bool);
			Renew(dummy_base, exp_cap, char*); Renew(dummy_level, exp_cap, char*);
			Renew(term_map, exp_cap, int); Renew(left_idx, exp_cap, int); Renew(right_idx, exp_cap, int);
		}

		if (strcmp(uniq_terms[j], "Intercept") == 0) {
			exp_terms[p_exp] = savepv("Intercept");
			parent_term[p_exp] = savepv("Intercept");
			is_dummy[p_exp] = FALSE; is_interact[p_exp] = FALSE;
			term_map[p_exp] = j;
			p_exp++;
			continue;
		}

		char *colon = strchr(uniq_terms[j], ':');
		if (colon) {
			char left[256], right[256];
			strncpy(left, uniq_terms[j], colon - uniq_terms[j]);
			left[colon - uniq_terms[j]] = '\0';
			snprintf(right, sizeof(right), "%s", colon + 1);   //CHANGED: snprintf, was strcpy (overflow)
			int *restrict l_indices = (int*)safemalloc(p_exp * sizeof(int)); int l_count = 0;
			int *restrict r_indices = (int*)safemalloc(p_exp * sizeof(int)); int r_count = 0;
			for (size_t e = 0; e < p_exp; e++) {
				if (strcmp(parent_term[e], left) == 0) l_indices[l_count++] = e;
				if (strcmp(parent_term[e], right) == 0) r_indices[r_count++] = e;
			}

			if (l_count == 0 || r_count == 0) {
				Safefree(l_indices); Safefree(r_indices);
				SvREFCNT_dec((SV*)xlevels_hv);   //NEW
				croak("aov: Interaction term '%s' requires its main effects to be explicitly included in the formula", uniq_terms[j]);
			} else {
				for (unsigned int li = 0; li < l_count; li++) {
					for (unsigned int ri = 0; ri < r_count; ri++) {
						if (p_exp >= exp_cap) {
							exp_cap *= 2;
							Renew(exp_terms, exp_cap, char*); Renew(parent_term, exp_cap, char*);
							Renew(is_dummy, exp_cap, bool); Renew(is_interact, exp_cap, bool);
							Renew(dummy_base, exp_cap, char*); Renew(dummy_level, exp_cap, char*);
							Renew(term_map, exp_cap, int); Renew(left_idx, exp_cap, int); Renew(right_idx, exp_cap, int);
						}
						size_t t_len = strlen(exp_terms[l_indices[li]]) + strlen(exp_terms[r_indices[ri]]) + 2;
						exp_terms[p_exp] = (char*)safemalloc(t_len);
						snprintf(exp_terms[p_exp], t_len, "%s:%s", exp_terms[l_indices[li]], exp_terms[r_indices[ri]]);
						parent_term[p_exp] = savepv(uniq_terms[j]);
						is_dummy[p_exp] = FALSE; is_interact[p_exp] = TRUE;
						left_idx[p_exp] = l_indices[li];
						right_idx[p_exp] = r_indices[ri];
						term_map[p_exp] = j;
						p_exp++;
					}
				}
			}
			Safefree(l_indices); Safefree(r_indices);
		} else {
			if (is_column_categorical(aTHX_ data_hoa, row_hashes, n, uniq_terms[j])) {
				char **levels = NULL;
				unsigned int num_levels = 0, levels_cap = 8;
				Newx(levels, levels_cap, char*);
				for (i = 0; i < n; i++) {
					 char*str_val = get_data_string_alloc(aTHX_ data_hoa, row_hashes, i, uniq_terms[j]);
					 if (str_val) {
						  bool found = FALSE;
						  for (size_t l = 0; l < num_levels; l++) {
							  if (strcmp(levels[l], str_val) == 0) { found = TRUE; break; }
						  }
						  if (!found) {
							  if (num_levels >= levels_cap) { levels_cap *= 2; Renew(levels, levels_cap, char*); }
							  levels[num_levels++] = savepv(str_val);
						  }
						  Safefree(str_val);
					 }
				}
				if (num_levels > 0) {
					for (size_t l1 = 0; l1 < num_levels - 1; l1++) {
						for (size_t l2 = l1 + 1; l2 < num_levels; l2++) {
							if (strcmp(levels[l1], levels[l2]) > 0) {
								char *tmp = levels[l1]; levels[l1] = levels[l2]; levels[l2] = tmp;
							}
						}
					}
					 term_base_level[j] = savepv(levels[0]);
					 // expose full sorted level list for predict (idx 0 = reference)
					 {
						 AV *lv_av = newAV();
						 for (size_t l = 0; l < num_levels; l++)
							 av_push(lv_av, newSVpv(levels[l], 0));
						 hv_store(xlevels_hv, uniq_terms[j], (I32)strlen(uniq_terms[j]),
							 newRV_noinc((SV*)lv_av), 0);
					 }

					 for (size_t l = 1; l < num_levels; l++) {
						  if (p_exp >= exp_cap) {
							  exp_cap *= 2;
							  Renew(exp_terms, exp_cap, char*); Renew(parent_term, exp_cap, char*);
							  Renew(is_dummy, exp_cap, bool); Renew(is_interact, exp_cap, bool);
							  Renew(dummy_base, exp_cap, char*); Renew(dummy_level, exp_cap, char*);
							  Renew(term_map, exp_cap, int); Renew(left_idx, exp_cap, int); Renew(right_idx, exp_cap, int);
						  }
						  size_t t_len = strlen(uniq_terms[j]) + strlen(levels[l]) + 1;
						  exp_terms[p_exp] = (char*)safemalloc(t_len);
						  snprintf(exp_terms[p_exp], t_len, "%s%s", uniq_terms[j], levels[l]);
						  parent_term[p_exp] = savepv(uniq_terms[j]);
						  is_dummy[p_exp] = TRUE; is_interact[p_exp] = FALSE;
						  dummy_base[p_exp] = savepv(uniq_terms[j]);
						  dummy_level[p_exp] = savepv(levels[l]);
						  term_map[p_exp] = j;
						  p_exp++;
					 }
					 for (size_t l = 0; l < num_levels; l++) Safefree(levels[l]);
					 Safefree(levels);
				} else {
					 Safefree(levels);
					 exp_terms[p_exp] = savepv(uniq_terms[j]);
					 parent_term[p_exp] = savepv(uniq_terms[j]);
					 is_dummy[p_exp] = FALSE; is_interact[p_exp] = FALSE;
					 term_map[p_exp] = j;
					 p_exp++;
				}
			} else {
				exp_terms[p_exp] = savepv(uniq_terms[j]);
				parent_term[p_exp] = savepv(uniq_terms[j]);
				is_dummy[p_exp] = FALSE; is_interact[p_exp] = FALSE;
				term_map[p_exp] = j;
				p_exp++;
			}
		}
	}
	X_mat = (NV**)safemalloc(n * sizeof(NV*));
	for(i = 0; i < n; i++) X_mat[i] = (NV*)safemalloc(p_exp * sizeof(NV));
	NV **Dsav = (NV**)safemalloc(n * sizeof(NV*)); //preserved design rows for fitted.values
	char **surv_names = NULL; //row names of surviving rows
	Newx(surv_names, n ? n : 1, char*);
	Newx(Y, n, NV);
	// PHASE 4: Matrix Construction & Listwise Deletion
	for (i = 0; i < n; i++) {
		NV y_val = evaluate_term(aTHX_ data_hoa, row_hashes, i, lhs);
		if (nv_isnan(y_val)) { Safefree(row_names[i]); row_names[i] = NULL; continue; }
		bool row_ok = 1;
		NV *row_x = X_mat[valid_n];   //CHANGED: build straight into the QR row (no per-row temp)
		for (j = 0; j < p_exp; j++) {
			if (strcmp(exp_terms[j], "Intercept") == 0) {
				row_x[j] = 1.0;
			} else if (is_interact[j]) {
				row_x[j] = row_x[left_idx[j]] * row_x[right_idx[j]];   //left/right already filled this row
			} else if (is_dummy[j]) {
				char*str_val = get_data_string_alloc(aTHX_ data_hoa, row_hashes, i, dummy_base[j]);
				if (str_val) {
					 row_x[j] = (strcmp(str_val, dummy_level[j]) == 0) ? 1.0 : 0.0;
					 Safefree(str_val);
				} else { row_ok = FALSE; break; }
			} else {
				row_x[j] = evaluate_term(aTHX_ data_hoa, row_hashes, i, parent_term[j]);
				if (nv_isnan(row_x[j])) { row_ok = FALSE; break; }
			}
		}
		if (!row_ok) { Safefree(row_names[i]); row_names[i] = NULL; continue; }  //X_mat[valid_n] reused next iter
		Y[valid_n] = y_val;
		Dsav[valid_n] = (NV*)safemalloc(p_exp * sizeof(NV)); //snapshot before QR destroys X_mat
		memcpy(Dsav[valid_n], row_x, p_exp * sizeof(NV));
		surv_names[valid_n] = row_names[i]; //transfer ownership
		row_names[i] = NULL;
		valid_n++;
	}
	Safefree(row_names);   //entries either transferred to surv_names or already freed
	if (valid_n <= p_exp) {// Full Clean Up
		for (i = 0; i < num_terms; i++) Safefree(terms[i]); Safefree(terms);
		for (i = 0; i < num_uniq; i++) Safefree(uniq_terms[i]); Safefree(uniq_terms);
		for (j = 0; j < p_exp; j++) {
			 Safefree(exp_terms[j]); Safefree(parent_term[j]);
			 if (is_dummy[j]) { Safefree(dummy_base[j]); Safefree(dummy_level[j]); }
		}
		Safefree(exp_terms); Safefree(parent_term);
		Safefree(is_dummy); Safefree(is_interact);
		Safefree(dummy_base); Safefree(dummy_level);
		Safefree(term_map); Safefree(left_idx); Safefree(right_idx);
		for(i = 0; i < n; i++) Safefree(X_mat[i]);
		Safefree(X_mat); Safefree(Y);
		for (i = 0; i < valid_n; i++) Safefree(Dsav[i]);
		Safefree(Dsav);
		for (i = 0; i < valid_n; i++) Safefree(surv_names[i]);
		Safefree(surv_names);
		SvREFCNT_dec((SV*)xlevels_hv);
		if (row_hashes) Safefree(row_hashes);
		for (i = 0; i < num_uniq; i++) { if (term_base_level[i]) Safefree(term_base_level[i]); }
		Safefree(term_base_level);
		croak("aov: 0 degrees of freedom (too many NAs or parameters > observations)");
	}
	// PHASE 5: Math & Output Formatting
	bool *aliased_qr = (bool*)safemalloc(p_exp * sizeof(bool));
	size_t *rank_map = (size_t*)safemalloc(p_exp * sizeof(size_t));
	apply_householder_aov(X_mat, Y, valid_n, p_exp, aliased_qr, rank_map);
	NV *term_ss;
	int *restrict term_df;
	Newxz(term_ss, num_uniq, NV);
	Newxz(term_df, num_uniq, int);
	for (i = 0; i < p_exp; i++) {
		if (strcmp(exp_terms[i], "Intercept") == 0) continue;
		if (aliased_qr[i]) continue;
		int t_idx = term_map[i];
		size_t r_k = rank_map[i];
		term_ss[t_idx] += Y[r_k] * Y[r_k];
		term_df[t_idx] += 1;
	}
	int rank = 0;
	for (i = 0; i < p_exp; i++) {
		  if (!aliased_qr[i]) rank++;
	}
	NV rss_prev = 0.0;
	for (i = rank; i < valid_n; i++) {
		  rss_prev += Y[i] * Y[i];
	}
	int res_df = valid_n - rank;
	NV ms_res = (res_df > 0) ? rss_prev / res_df : 0.0;
	HV*ret_hash = newHV();
	for (j = 0; j < num_uniq; j++) {
		if (strcmp(uniq_terms[j], "Intercept") == 0) continue;
		HV*term_stats = newHV();
		NV ss = term_ss[j];
		int df = term_df[j];
		NV ms = (df > 0) ? ss / df : 0.0;

		hv_stores(term_stats, "Df", newSViv(df));
		hv_stores(term_stats, "Sum Sq", newSVnv(ss));
		hv_stores(term_stats, "Mean Sq", newSVnv(ms));
		if (ms_res > 0.0 && df > 0) {
			NV f_val = ms / ms_res;
			hv_stores(term_stats, "F value", newSVnv(f_val));
			hv_stores(term_stats, "Pr(>F)", newSVnv(pf_upper(f_val, (NV)df, (NV)res_df)));
		} else {
			hv_stores(term_stats, "F value", newSVnv(NAN));
			hv_stores(term_stats, "Pr(>F)", newSVnv(NAN));
		}
		hv_store(ret_hash, uniq_terms[j], strlen(uniq_terms[j]), newRV_noinc((SV*)term_stats), 0);
	}
	HV*res_stats = newHV();
	hv_stores(res_stats, "Df", newSViv(res_df));
	hv_stores(res_stats, "Sum Sq", newSVnv(rss_prev));
	hv_stores(res_stats, "Mean Sq", newSVnv(ms_res));
	hv_stores(ret_hash, "Residuals", newRV_noinc((SV*)res_stats));
	{
		HV *tgt_hoa = data_hoa;
		HV **tgt_row_hashes = row_hashes;
		size_t tgt_n = n;
		// Route evaluation to the original unstacked HoA when a formula was implied
		if (is_stacked) {
			tgt_hoa = (HV*)SvRV(orig_data_sv);
			tgt_row_hashes = NULL;
			hv_iterinit(tgt_hoa);
			HE *e = hv_iternext(tgt_hoa);
			if (e) {
				 SV *val = hv_iterval(tgt_hoa, e);
				 if (SvROK(val) && SvTYPE(SvRV(val)) == SVt_PVAV) {
					 tgt_n = av_len((AV*)SvRV(val)) + 1;
				 }
			}
		}
		AV *all_cols = get_all_columns(aTHX_ tgt_hoa, tgt_row_hashes, tgt_n);
		HV *mean_hv  = newHV();
		HV *size_hv  = newHV();
		SSize_t ncols = av_len(all_cols);                  //CHANGED: signed bound
		for (SSize_t c = 0; c <= ncols; c++) {              //CHANGED: SSize_t loop
			SV **col_sv = av_fetch(all_cols, c, 0);
			if (!col_sv || !SvOK(*col_sv)) continue;
			const char *col_name = SvPV_nolen(*col_sv);
			NV col_sum = 0.0;
			IV      col_count = 0;
			for (i = 0; i < tgt_n; i++) {
				 NV val = evaluate_term(aTHX_ tgt_hoa, tgt_row_hashes, i, col_name);
				 if (!nv_isnan(val)) { col_sum += val; col_count++; }
			}
			NV col_mean = (col_count > 0) ? col_sum / col_count : NAN;
			hv_store(mean_hv, col_name, strlen(col_name), newSVnv(col_mean), 0);
			hv_store(size_hv, col_name, strlen(col_name), newSViv(col_count), 0);
		}
		SvREFCNT_dec(all_cols);
		HV *gs_hv = newHV();
		hv_stores(gs_hv, "mean", newRV_noinc((SV*)mean_hv));
		hv_stores(gs_hv, "size", newRV_noinc((SV*)size_hv));
		hv_stores(ret_hash, "group.stats", newRV_noinc((SV*)gs_hv));
	}
	/*	predict-compatible output -- coefficients, fitted.values, xlevels, family
	 X_mat now holds R (rows 0..rank-1, original column index, original units);
	 Y holds Q'y (effects in y[0..rank-1]). Recover beta by back-substitution*/
	{
		size_t *restrict col_of_rank = (size_t*)safemalloc((rank ? (size_t)rank : 1) * sizeof(size_t));
		NV *beta = (NV*)safemalloc((p_exp ? p_exp : 1) * sizeof(NV));
		for (j = 0; j < p_exp; j++) {
			beta[j] = NAN;
			if (!aliased_qr[j]) col_of_rank[rank_map[j]] = j;   //rank row -> actual column
		}
		for (size_t mi = (size_t)rank; mi-- > 0; ) {            //unsigned countdown
			size_t km = col_of_rank[mi];
			NV acc = Y[mi];
			for (size_t l = mi + 1; l < (size_t)rank; l++) {
				size_t kl = col_of_rank[l];
				acc -= X_mat[mi][kl] * beta[kl];                //R[mi][kl] * beta[kl]
			}
			beta[km] = acc / X_mat[mi][km];                     //diagonal nonzero by construction
		}

		HV *coef_hv = newHV();
		for (j = 0; j < p_exp; j++)
			hv_store(coef_hv, exp_terms[j], (I32)strlen(exp_terms[j]), newSVnv(beta[j]), 0);
		hv_stores(ret_hash, "coefficients", newRV_noinc((SV*)coef_hv));

		//fitted.values: Xb over non-aliased columns, keyed by surviving row name
		HV *fitted_hv = newHV();
		for (i = 0; i < valid_n; i++) {
			NV fit = 0.0;
			for (j = 0; j < p_exp; j++)
				if (!aliased_qr[j]) fit += Dsav[i][j] * beta[j];
			hv_store(fitted_hv, surv_names[i], (I32)strlen(surv_names[i]), newSVnv(fit), 0);
		}
		hv_stores(ret_hash, "fitted.values", newRV_noinc((SV*)fitted_hv));

		hv_stores(ret_hash, "xlevels", newRV_noinc((SV*)xlevels_hv));
		hv_stores(ret_hash, "family",  newSVpvn("gaussian", 8));

		Safefree(col_of_rank);
		Safefree(beta);
	}
	// Deep Cleanup
	for (i = 0; i < num_terms; i++) Safefree(terms[i]); Safefree(terms);
	for (i = 0; i < num_uniq; i++) Safefree(uniq_terms[i]); Safefree(uniq_terms);
	for (j = 0; j < p_exp; j++) {
		  Safefree(exp_terms[j]); Safefree(parent_term[j]);
		  if (is_dummy[j]) { Safefree(dummy_base[j]); Safefree(dummy_level[j]); }
	}
	Safefree(exp_terms); Safefree(parent_term);
	Safefree(is_dummy); Safefree(is_interact);
	Safefree(dummy_base); Safefree(dummy_level);
	Safefree(term_map); Safefree(left_idx); Safefree(right_idx);
	Safefree(term_ss); Safefree(term_df);
	for (i = 0; i < n; i++) Safefree(X_mat[i]);
	Safefree(X_mat); Safefree(Y);
	for (i = 0; i < valid_n; i++) Safefree(Dsav[i]);        //NEW
	Safefree(Dsav);                                          //NEW
	for (i = 0; i < valid_n; i++) Safefree(surv_names[i]);   //NEW
	Safefree(surv_names);                                    //NEW
	Safefree(aliased_qr); Safefree(rank_map);
	for (i = 0; i < num_uniq; i++) { if (term_base_level[i]) Safefree(term_base_level[i]); }
	Safefree(term_base_level);
	if (row_hashes) Safefree(row_hashes);
	//xlevels_hv ownership transferred to ret_hash; do not dec here
	RETVAL = newRV_noinc((SV*)ret_hash);
	}
OUTPUT:
	RETVAL

PROTOTYPES: DISABLE

SV* fisher_test(...)
CODE:
{
	if (items < 1) croak("fisher_test requires at least a data reference");

	SV *data_ref = ST(0);
	NV conf_level = NV_CONF_95;
	const char *alternative = "two.sided";

	for (Stack_off_t i = 1; i < items; i += 2) {
		if (i + 1 >= items) croak("fisher_test: odd number of named arguments");
		const char *key = SvPV_nolen(ST(i));
		SV *val = ST(i + 1);
		if (strEQ(key, "conf_level") || strEQ(key, "conf.level")) {
			conf_level = SvNV(val);
			if (!(conf_level > 0 && conf_level < 1))
				 croak("fisher_test: conf_level must be between 0 and 1");
		} else if (strEQ(key, "alternative")) {
			alternative = SvPV_nolen(val);
			if (strNE(alternative, "two.sided") && strNE(alternative, "less") &&
				 strNE(alternative, "greater"))
				 croak("fisher_test: alternative must be 'two.sided', 'less' or 'greater'");
		} else {
			croak("fisher_test: unknown argument '%s'", key);
		}
	}
	if (!SvROK(data_ref)) croak("fisher_test requires a reference to a 2D Array or Hash");
	SV *deref = SvRV(data_ref);
	/*Parse the input into a flat nrow x ncol table of nonnegative counts.
	Both a 2D array-of-arrays and a 2D hash-of-hashes are accepted, and any
	dimensions >= 2x2 are supported (2x2 keeps the exact odds-ratio path;
	everything else uses the R x C enumeration below).*/
	unsigned nrow = 0, ncol = 0;
	long *cells = NULL;
	if (SvTYPE(deref) == SVt_PVAV) {
		AV *outer = (AV *)deref;
		nrow = (int)(av_len(outer) + 1);
		if (nrow < 2) croak("Outer array must have at least 2 rows");
		SV **r0p = av_fetch(outer, 0, 0);
		if (!r0p || !SvROK(*r0p) || SvTYPE(SvRV(*r0p)) != SVt_PVAV)
			croak("Invalid 2D array structure: each row must be an array ref");
		ncol = (int)(av_len((AV *)SvRV(*r0p)) + 1);
		if (ncol < 2) croak("Each row must have at least 2 columns");
		Newx(cells, (size_t)nrow * ncol, long);
		for (unsigned rr = 0; rr < nrow; rr++) {
			SV **rp = av_fetch(outer, rr, 0);
			if (!rp || !SvROK(*rp) || SvTYPE(SvRV(*rp)) != SVt_PVAV) {
				Safefree(cells);
				croak("Invalid 2D array structure: each row must be an array ref");
			}
			AV *row = (AV *)SvRV(*rp);
			if ((int)(av_len(row) + 1) != ncol) {
				Safefree(cells);
				croak("All rows must have the same number of columns (%d)", ncol);
			}
			for (int cc = 0; cc < ncol; cc++)
				cells[rr * ncol + cc] = ft_cell(aTHX_ *av_fetch(row, cc, 0), "array cell");
		}
		} else if (SvTYPE(deref) == SVt_PVHV) {
		/*Rows are ordered by lexical key sort, and columns by the sorted keys
		of the first row, so the result is deterministic regardless of
		Perl's hash randomization.  Every row must expose that same column
		key set.*/
		HV *outer = (HV *)deref;
		nrow = (int)HvUSEDKEYS(outer);
		if (nrow < 2) croak("Outer hash must have at least 2 keys");
		ft_kv *rows = NULL; Newx(rows, nrow, ft_kv);
		hv_iterinit(outer);
		for (unsigned int i = 0; i < nrow; i++) {
			HE *e = hv_iternext(outer);
			rows[i].k = SvPV_nolen(hv_iterkeysv(e));
			rows[i].v = hv_iterval(outer, e);
		}
		qsort(rows, nrow, sizeof(ft_kv), ft_kv_cmp);

		if (!SvROK(rows[0].v) || SvTYPE(SvRV(rows[0].v)) != SVt_PVHV) {
			Safefree(rows); croak("Inner elements must be hash refs");
		}
		HV *first = (HV *)SvRV(rows[0].v);
		ncol = (int)HvUSEDKEYS(first);
		if (ncol < 2) { Safefree(rows); croak("Inner hashes must have at least 2 keys"); }
		ft_kv *cols = NULL; Newx(cols, ncol, ft_kv);
		hv_iterinit(first);
		for (unsigned int j = 0; j < ncol; j++) {
			HE *e = hv_iternext(first);
			cols[j].k = SvPV_nolen(hv_iterkeysv(e));
			cols[j].v = NULL;
		}
		qsort(cols, ncol, sizeof(ft_kv), ft_kv_cmp);

		Newx(cells, (size_t)nrow * ncol, long);
		for (unsigned int rr = 0; rr < nrow; rr++) {
			if (!SvROK(rows[rr].v) || SvTYPE(SvRV(rows[rr].v)) != SVt_PVHV) {
				Safefree(cells); Safefree(cols); Safefree(rows);
				croak("Inner elements must be hash refs");
			}
			HV *in = (HV *)SvRV(rows[rr].v);
			if ((int)HvUSEDKEYS(in) != ncol) {
				Safefree(cells); Safefree(cols); Safefree(rows);
				croak("All rows must have the same %d column keys", ncol);
			}
			for (unsigned int cc = 0; cc < ncol; cc++) {
				SV **vp = hv_fetch(in, cols[cc].k, (I32)strlen(cols[cc].k), 0);
				if (!vp) {
	/*Capture the key pointers (they point into still-live mortal SV
	buffers, not into rows/cols) before freeing the arrays --
	otherwise croak() reads freed memory, which SIGBUSes on
	strict allocators such as FreeBSD's.*/
					const char *rk = rows[rr].k;
					const char *ck = cols[cc].k;
					Safefree(cells); Safefree(cols); Safefree(rows);
					croak("Row '%s' is missing column key '%s'", rk, ck);
				}
				cells[rr * ncol + cc] = ft_cell(aTHX_ *vp, "hash cell");
			}
		}
		Safefree(cols); Safefree(rows);
	} else {
	  croak("Input must be a 2D Array or 2D Hash");
	}

	long total = 0;
	for (unsigned i = 0; i < nrow * ncol; i++) total += cells[i];
	if (total == 0) { Safefree(cells); croak("fisher_test: table is all zeros"); }
	HV *ret = newHV();
	hv_stores(ret, "method", newSVpv("Fisher's Exact Test for Count Data", 0));
	hv_stores(ret, "conf.level", newSVnv(conf_level));
	if (nrow == 2 && ncol == 2) {// 2x2: full exact test with the conditional MLE odds ratio and CI
	  long a = cells[0], b = cells[1], c = cells[2], d = cells[3];
	  NV p_val = exact_p_value(a, b, c, d, alternative);
	  NV mle_or, ci_low, ci_high;
	  calculate_exact_stats(a, b, c, d, conf_level, alternative, &mle_or, &ci_low, &ci_high);
	  hv_stores(ret, "alternative", newSVpv(alternative, 0));
	  AV *ci = newAV();
	  av_push(ci, newSVnv(ci_low));
	  av_push(ci, newSVnv(ci_high));
	  hv_stores(ret, "conf.int", newRV_noinc((SV *)ci));
	  HV *est = newHV();
	  hv_stores(est, "odds ratio", newSVnv(mle_or));
	  hv_stores(ret, "estimate", newRV_noinc((SV *)est));
	  hv_stores(ret, "p.value", newSVnv(p_val));
	} else { //R x C: only the two-sided p-value is defined (no odds ratio / CI)
	  NV p_val = fisher_rxc_pvalue(aTHX_ cells, nrow, ncol);
	  if (p_val < 0) {
		   Safefree(cells);
		   croak("fisher_test: %dx%d table is too large for exact enumeration", nrow, ncol);
	  }
	  hv_stores(ret, "alternative", newSVpv("two.sided", 0));
	  hv_stores(ret, "p.value", newSVnv(p_val));
	}
	Safefree(cells);
	RETVAL = newRV_noinc((SV *)ret);
}
OUTPUT:
  RETVAL

SV* power_t_test(...)
CODE:
{
	SV*sv_n = NULL;
	SV*sv_delta = NULL;
	SV*sv_sd = NULL;
	SV*sv_sig_level = NULL;
	SV*sv_power = NULL;

	const char*type = "two.sample", *alternative = "two.sided";
	bool strict = FALSE;
	/*R's default is .Machine$double.eps^0.25 (1.2e-4) on uniroot's bracket
	width, which leaves its own delta and sig.level good to four or five
	digits. ptt_root() converges superlinearly, so a tolerance this tight
	costs a couple of extra p_body() calls and still runs in fewer than the
	bisection it replaced.*/
	NV tol = 1e-12;

	if (items % 2 != 0) croak("Usage: power_t_test(n => 30, delta => 0.5, sd => 1.0, ...)");
	for (unsigned short int i = 0; i < items; i += 2) {
	  const char*key = SvPV_nolen(ST(i));
	  SV* val = ST(i+1);

	  if      (strEQ(key, "n"))           sv_n = val;
	  else if (strEQ(key, "delta"))       sv_delta = val;
	  else if (strEQ(key, "sd"))          sv_sd = val;
	  else if (strEQ(key, "sig.level") || strEQ(key, "sig_level")) sv_sig_level = val;
	  else if (strEQ(key, "power"))       sv_power = val;
	  else if (strEQ(key, "type"))        type = SvPV_nolen(val);
	  else if (strEQ(key, "alternative")) alternative = SvPV_nolen(val);
	  else if (strEQ(key, "strict"))      strict = SvTRUE(val);
	  else if (strEQ(key, "tol"))         tol = SvNV(val);
	  else croak("power_t_test: unknown argument '%s'", key);
	}

	bool is_null_n = (!sv_n || !SvOK(sv_n));
	bool is_null_delta = (!sv_delta || !SvOK(sv_delta));
	bool is_null_power = (!sv_power || !SvOK(sv_power));
	bool is_null_sd = (sv_sd && !SvOK(sv_sd)); 
	bool is_null_sig_level = (sv_sig_level && !SvOK(sv_sig_level));

	unsigned short int missing_count = 0;
	if (is_null_n) missing_count++;
	if (is_null_delta) missing_count++;
	if (is_null_power) missing_count++;
	if (is_null_sd) missing_count++;
	if (is_null_sig_level) missing_count++;

	if (missing_count != 1) {
	  croak("power_t_test: exactly one of 'n', 'delta', 'sd', 'power', and 'sig_level' must be undef/NULL");
	}

	NV n = is_null_n ? 0.0 : SvNV(sv_n);
	NV delta = is_null_delta ? 0.0 : SvNV(sv_delta);
	NV sd = (!sv_sd || is_null_sd) ? 1.0 : SvNV(sv_sd);
	NV sig_level = (!sv_sig_level || is_null_sig_level) ? 0.05 : SvNV(sv_sig_level);
	NV power = is_null_power ? 0.0 : SvNV(sv_power);

	/*R's assert_NULL_or_prob(): a probability outside [0, 1] is a typo, not a
	place to start searching from. power => 1.5 used to run the n bracket out
	to 1.3e12 and hand that back as the required sample size.*/
	if (!is_null_sig_level && !(sig_level >= 0.0 && sig_level <= 1.0))
	  croak("power_t_test: 'sig_level' must be numeric in [0, 1]");
	if (!is_null_power && !(power >= 0.0 && power <= 1.0))
	  croak("power_t_test: 'power' must be numeric in [0, 1]");
	/*nu = (n - 1) * tsample, so below n = 2 there is no variance left to
	estimate: the critical value runs off to infinity and exact_pnt()'s grid
	loses the whole chi density, which is how n => 1 used to report a power
	of 0.99998. R hides the same degeneracy behind pmax(1e-07, n - 1) and
	returns a power of 0; saying so outright is more use than either number.*/

	/*croak() formats through Perl, not the C library, so an NV needs NVgf
	("g", "Lg", or "Qg") rather than a bare %g: a quadmath build rejects a
	format without the Q modifier outright ("panic: quadmath invalid
	format"), and casting the argument to double cannot rescue it.
	croak_nv() (see the top of this file) is croak() minus the format
	attribute, which the compiler's format checker mis-flags on "Qg".*/
	if (!is_null_n && !(n >= 2.0))
	  croak_nv("power_t_test: 'n' must be at least 2, not %" NVgf, n);
	if (!is_null_sd && sd < 0.0)
	  croak_nv("power_t_test: 'sd' must not be negative, not %" NVgf, sd);

	/*R reaches these through match.arg(), so a misspelling is an error there.
	Silently reading an unrecognised type as "two.sample" turned every typo
	into a plausible-looking answer for the wrong test.*/
	short int tsample;
	if      (strEQ(type, "two.sample")) tsample = 2;
	else if (strEQ(type, "one.sample") || strEQ(type, "paired")) tsample = 1;
	else croak("power_t_test: 'type' must be 'two.sample', 'one.sample', or 'paired', not '%s'", type);

	short int tside;
	if      (strEQ(alternative, "two.sided")) tside = 2;
	else if (strEQ(alternative, "one.sided") || strEQ(alternative, "greater")
			  || strEQ(alternative, "less")) tside = 1;
	else croak("power_t_test: 'alternative' must be 'two.sided', 'one.sided', 'greater', or 'less', not '%s'", alternative);

	if (tside == 2 && !is_null_delta) delta = nv_fabs(delta);

	ptt_ctx c;
	c.n = n; c.delta = delta; c.sd = sd; c.sig_level = sig_level;
	c.tsample = tsample; c.tside = tside; c.strict = strict; c.target = power;

	if (is_null_power) {
	  power = p_body(n, delta, sd, sig_level, tsample, tside, strict);
	} else if (is_null_n) {
	  //power rises with n; R's bracket is c(2, 1e7), grown upward as needed
	  c.which = PTT_N;
	  NV low = 2.0, high = 1e7;
	  while (high < 1e12 && ptt_f(&c, high) < 0.0) high *= 2.0;
	  n = ptt_root(&c, low, high, tol);
	  if (n != n) croak_nv("power_t_test: no 'n' in [%" NVgf ", %" NVgf "] gives a power of %" NVgf " "
			  "(delta = %" NVgf ", sd = %" NVgf ", sig_level = %" NVgf ")",
			  low, high, power, delta, sd, sig_level);
	} else if (is_null_sd) {
  /*power falls as sd rises. The bracket scales with |delta|, so a delta of
  0 collapses it to a single point -- R fails there with "lower < upper is
  not fulfilled"; this says why.*/
	  if (delta == 0.0) croak("power_t_test: cannot solve for 'sd' when 'delta' is 0");
	  c.which = PTT_SD;
	  NV ad = nv_fabs(delta), low = ad * 1e-7, high = ad * 1e7;
	  while (high < ad * 1e12 && ptt_f(&c, high) > 0.0) high *= 2.0;
	  while (low > ad * 1e-12 && ptt_f(&c, low) < 0.0) low *= 0.5;
	  sd = ptt_root(&c, low, high, tol);
	  if (sd != sd) croak_nv("power_t_test: no 'sd' in [%" NVgf ", %" NVgf "] gives a power of %" NVgf " "
			  "(n = %" NVgf ", delta = %" NVgf ", sig_level = %" NVgf ")",
			  low, high, power, n, delta, sig_level);
	} else if (is_null_delta) {
	  if (!(sd > 0.0)) croak("power_t_test: cannot solve for 'delta' unless 'sd' is positive");
	  c.which = PTT_DELTA;
	  NV low = sd * 1e-7, high = sd * 1e7;
	  while (high < sd * 1e12 && ptt_f(&c, high) < 0.0) high *= 2.0;
	  delta = ptt_root(&c, low, high, tol);
	  if (delta != delta) croak_nv("power_t_test: no 'delta' in [%" NVgf ", %" NVgf "] gives a power of %" NVgf " "
			  "(n = %" NVgf ", sd = %" NVgf ", sig_level = %" NVgf ")",
			  low, high, power, n, sd, sig_level);
	} else { //is_null_sig_level

	  /*A significance level is a probability, so unlike the others this bracket
	  cannot be widened. R widens it anyway (extendInt = "yes") and will
	  happily return a sig.level above 1; refusing is the honest answer.*/
	  c.which = PTT_SIG;
	  sig_level = ptt_root(&c, 1e-10, 1.0 - 1e-10, tol);
	  if (sig_level != sig_level) croak_nv("power_t_test: no 'sig_level' in (0, 1) gives a power of %" NVgf " "
			  "(n = %" NVgf ", delta = %" NVgf ", sd = %" NVgf ")",
			  power, n, delta, sd);
	}
	HV*ret = newHV();
	hv_stores(ret, "n", newSVnv(n));
	hv_stores(ret, "delta", newSVnv(delta));
	hv_stores(ret, "sd", newSVnv(sd));
	hv_stores(ret, "sig.level", newSVnv(sig_level));
	hv_stores(ret, "power", newSVnv(power));
	hv_stores(ret, "alternative", newSVpv(alternative, 0));
	const char*m_str = (tsample == 1) ? (strEQ(type, "paired") ? "Paired t test power calculation" : "One-sample t test power calculation") : "Two-sample t test power calculation";
	hv_stores(ret, "method", newSVpv(m_str, 0));
	const char*n_str = (tsample == 2) ? "n is number in *each* group" : (strEQ(type, "paired") ? "n is number of *pairs*, sd is std.dev. of *differences* within pairs" : "");
	if (n_str[0] != '\0') hv_stores(ret, "note", newSVpv(n_str, 0));
	RETVAL = newRV_noinc((SV*)ret);
}
OUTPUT:
	RETVAL

SV* kruskal_test(...)
CODE:
{
	SV *x_sv = NULL, *g_sv = NULL, *h_sv = NULL;
	Stack_off_t arg_idx = 0;
	// 1. Shift positional arguments; Accept either: (arrayref, arrayref) or (hashref)
	if (arg_idx < items && SvROK(ST(arg_idx))) {
		svtype t = SvTYPE(SvRV(ST(arg_idx)));
		if (t == SVt_PVAV) {
			x_sv = ST(arg_idx++);
		} else if (t == SVt_PVHV) {
			h_sv = ST(arg_idx++); //hash-of-arrays shortcut
		}
	}
	if (!h_sv && arg_idx < items
			 && SvROK(ST(arg_idx))
			 && SvTYPE(SvRV(ST(arg_idx))) == SVt_PVAV) {
	  g_sv = ST(arg_idx++);
	}
	// 2. Parse named arguments (fallback)
	/*Without this the loop below reads ST(items), one past the argument stack,
	and the garbage it finds there changes which branch runs: a stray trailing
	key made kruskal_test(\%h, 'x') croak about mixing 'h' with 'x'/'g'.  Every
	sibling that takes named arguments guards the same way (binom_test,
	chisq_test, fisher_test, wilcox_test, var_test, prcomp).*/
	if ((items - arg_idx) % 2 != 0)
	  croak("kruskal_test: odd number of named arguments");
	for (; arg_idx < items; arg_idx += 2) {
	  /*No restrict: this points into an SV's PV, which the perl API may reach
	  by another route (a shared hash key, a COW buffer).*/
	  const char *key = SvPV_nolen(ST(arg_idx));
	  SV         *val = ST(arg_idx + 1);
	  if      (strEQ(key, "x")) x_sv = val;
	  else if (strEQ(key, "g")) g_sv = val;
	  else if (strEQ(key, "h")) h_sv = val;
	  else croak("kruskal_test: unknown argument '%s'", key);
	}
	// 3. Mutual-exclusion guard
	if (h_sv && (x_sv || g_sv))
	  croak("kruskal_test: cannot mix 'h' (hash-of-arrays) with 'x'/'g' inputs");
	// Shared state filled by whichever input branch runs
	KWObs *obs = NULL;
	GroupLabel *group_names = NULL; //Track labels to build group_stats
	size_t valid_n = 0, k       = 0;
	/*Groups that contributed no usable observation.  R drops NA (and NaN is NA
	to R) per group first and then refuses the test -- "all groups must contain
	data" -- so this only ever needs to be reported, never worked around.*/
	size_t empty_groups = 0;
	//4a. Hash-of-arrays input path
	//my %x = ( group1 => [...], group2 => [...], ... )
	if (h_sv) {
		if (!SvROK(h_sv) || SvTYPE(SvRV(h_sv)) != SVt_PVHV)
			croak("kruskal_test: 'h' must be a HASH reference");
		HV *h_hv = (HV*)SvRV(h_sv);
		// First pass – validate values and tally total elements
		size_t total = 0;
		hv_iterinit(h_hv);
		HE *he;
		while ((he = hv_iternext(h_hv))) {
			SV *val = HeVAL(he);
			if (!SvROK(val) || SvTYPE(SvRV(val)) != SVt_PVAV)
				croak("kruskal_test: every value in 'h' must be an ARRAY reference");
			total += (size_t)(av_len((AV*)SvRV(val)) + 1);
		}
		/*No early "not enough observations" here: R filters each group, refuses
		an empty one, and only then counts, so list(numeric(0), numeric(0)) is
		"all groups must contain data" to R and the tally below has to run
		before that can be decided.  The count is floored at one because a zero
		allocation is not worth relying on.*/
		Newx(obs, total ? total : 1, KWObs);
		size_t num_keys = HvKEYS(h_hv);
		Newxz(group_names, num_keys, GroupLabel);
		//2nd pass – fill obs[], assigning one group_id per hash key
		size_t group_id = 0;
		hv_iterinit(h_hv);
		while ((he = hv_iternext(h_hv))) {
			STRLEN klen;
			/*No restrict: HePV() hands back the hash entry's own key buffer,
			which may be a shared hash key perl also reaches elsewhere.*/
			const char *key_str = HePV(he, klen);
			group_names[group_id].name = savepvn(key_str, klen); // Save string key
			group_names[group_id].klen = HeUTF8(he) ? -(I32)klen : (I32)klen;
			AV *av  = (AV*)SvRV(HeVAL(he));
			size_t n_g = (size_t)(av_len(av) + 1);
			size_t n_valid_g = 0;
			for (size_t i = 0; i < n_g; i++) {
				 SV **el = av_fetch(av, i, 0);
				 if (el && SvOK(*el) && looks_like_number(*el)) {
					 NV v = SvNV(*el);
					 /*NaN is NA to R, so complete.cases() drops it before
					 ranking.  Ranking it instead moved the statistic (H = 4.5
					 where R gives 3.857 on one NaN among six values) and fed
					 cmp_nv3 a comparison that is never true, leaving qsort
					 without the strict weak ordering it is entitled to.  +/-Inf
					 is neither NA nor NaN and a rank test has no trouble with
					 it, so it stays.  wilcox_test() drops NaN for the same
					 reasons.*/
					 if (nv_isnan(v)) continue;
					 obs[valid_n].val = v;
					 obs[valid_n].gid = group_id; //group identity
					 valid_n++;
					 n_valid_g++;
				 }
			}
			if (n_valid_g == 0) empty_groups++;
			group_id++;
		}
		k = group_id; // number of unique groups = number of hash keys
	} else {// 4b. Original x / g array-pair input path
		if (!x_sv || !SvROK(x_sv) || SvTYPE(SvRV(x_sv)) != SVt_PVAV)
			croak("kruskal_test: 'x' is a required argument and must be an ARRAY reference");
		if (!g_sv || !SvROK(g_sv) || SvTYPE(SvRV(g_sv)) != SVt_PVAV)
			croak("kruskal_test: 'g' is a required argument and must be an ARRAY reference");

		AV *x_av = (AV*)SvRV(x_sv), *g_av = (AV*)SvRV(g_sv);
		size_t nx = (size_t)(av_len(x_av) + 1);
		size_t ng = (size_t)(av_len(g_av) + 1);
		if (nx != ng) croak("kruskal_test: 'x' and 'g' must have the same length");
		if (nx < 2)   croak("not enough observations");
		Newx(obs, nx ? nx : 1, KWObs);
		/*Grown on demand rather than sized at nx: a label array indexed by
		group id needs one slot per distinct group, and the usual call has a
		handful of groups over millions of rows -- sizing it at nx cost 8 bytes
		per observation (40 MB at n = 5e6) to hold three pointers.*/
		size_t names_cap = 8;
		Newxz(group_names, names_cap, GroupLabel);
		// Map string group names → contiguous integer IDs
		HV *group_map    = newHV();
		size_t          next_group_id = 0;
		for (size_t i = 0; i < nx; i++) {
			SV **x_el = av_fetch(x_av, i, 0);
			SV **g_el = av_fetch(g_av, i, 0);
			if (x_el && SvOK(*x_el) && looks_like_number(*x_el)
					  && g_el && SvOK(*g_el)) {
				NV v = SvNV(*x_el);
				if (nv_isnan(v)) continue; //NA to R; see the 'h' path
				/*SvPV() with the length, not SvPV_nolen() plus strlen(): a
				label with an embedded NUL was truncated at it, so "a\0X" and
				"a\0Y" collapsed into one group and deflated the degrees of
				freedom.  It also drops a strlen() pass per observation.*/
				STRLEN glen;
				const char *g_str = SvPV(*g_el, glen);
				const I32 klen = SvUTF8(*g_el) ? -(I32)glen : (I32)glen;
				SV   **id_sv = hv_fetch(group_map, g_str, klen, 0);
				size_t group_id;
				if (id_sv) {
				  group_id = SvUV(*id_sv);
				} else {
				  group_id = next_group_id++;
				  hv_store(group_map, g_str, klen, newSVuv(group_id), 0);
				  if (group_id == names_cap) {
					   size_t old_cap = names_cap;
					   names_cap *= 2;
					   Renew(group_names, names_cap, GroupLabel);
					   Zero(group_names + old_cap, names_cap - old_cap, GroupLabel);
				  }
				  group_names[group_id].name = savepvn(g_str, glen); // Save string key
				  group_names[group_id].klen = klen;
				}
				obs[valid_n].val = v;
				obs[valid_n].gid = group_id;
				valid_n++;
			}
		}
		k = next_group_id;
		SvREFCNT_dec(group_map);
	}
	//5. Shared post-extraction validation
	/*empty_groups is only ever non-zero on the 'h' path: the 'x'/'g' path mints
	a group id the first time an observation survives the filter, so it cannot
	produce a group with no data.  R's list interface refuses this case outright
	rather than guessing, and it has to: counting the empty key in k inflated
	the degrees of freedom, which turned the correct df = 1, p = 0.0253 into
	df = 2, p = 0.0821 on {a=>[1,1,1], b=>[2,2,2], c=>[]}.*/
	if (valid_n < 2 || k < 2 || empty_groups) {
	  Safefree(obs);
	  if (group_names) {
		   for (size_t i = 0; i < k; i++) { if (group_names[i].name) Safefree(group_names[i].name); }
		   Safefree(group_names);
	  }
	  /*R's order: it drops each group's NAs, refuses an empty group, and only
	  then checks that anything is left.*/
	  if (empty_groups) croak("all groups must contain data");
	  if (valid_n < 2) croak("not enough observations");
	  croak("all observations are in the same group");
	}
	// 6-7. Rank, accumulate the tie correction, and aggregate by group
	/*One pass over the sorted array does all three.  Each tie block gets the
	average of the ranks it spans -- R's rank(x) default, ties.method="average"
	-- which for positions i+1..j is (i+1+j)/2, and that goes straight into the
	group sums.  The shared rank_and_count_ties() would instead write the rank
	back into every element for a second pass to read.

	Aggregating in sorted-value order rather than input order is also better
	conditioned for group_val_sums: each group's values are added smallest
	first, which is the classic ordering for a same-sign sum.  The group means
	are ours, not R's -- R's kruskal.test() reports no per-group statistics --
	so there is no reference to hold them to beyond that.*/
	NV *restrict group_rank_sums = NULL;
	NV *restrict group_val_sums  = NULL;   // For Mean
	size_t *restrict group_counts = NULL;
	Newxz(group_rank_sums, k, NV);
	Newxz(group_val_sums,  k, NV);
	Newxz(group_counts,    k, size_t);
	kw_sort(obs, valid_n, kw_depth_limit(valid_n));
	NV tie_adj = 0.0;
	for (size_t i = 0; i < valid_n; ) {
		size_t j = i + 1;
		while (j < valid_n && obs[j].val == obs[i].val) j++;
		const NV r = (NV)(i + 1 + j) / 2.0;
		for (size_t m = i; m < j; m++) {
			const size_t g_id = obs[m].gid;
			group_rank_sums[g_id] += r;
			group_val_sums[g_id]  += obs[m].val;
			group_counts[g_id]++;
		}
		const size_t t = j - i;
		if (t > 1) tie_adj += ((NV)t * t * t - (NV)t);
		i = j;
	}
	// 8. Calculate STATISTIC
	/*sum(R_i^2 / n_i), added smallest term first.

	Each group's rank sum is already order-independent: within one tie block
	every observation carries the same averaged rank, so the sequence of values
	added to a given group is fixed by the data.  This sum was not.  It walked
	the groups by group id, and on the hash-of-arrays path an id is minted in
	hv_iternext() order -- perl's per-process hash order -- so the same input
	gave answers up to 1.2e-14 apart between runs.  Sorting the k terms makes
	the order canonical and puts the sum in the better-conditioned direction at
	the same time.  k is the number of groups, not the number of observations,
	so this costs nothing next to the ranking; kw_sort() is reused rather than
	writing a second sort, with the term in .val and the group in .gid.*/
	KWObs *restrict terms = NULL;
	Newx(terms, k, KWObs);
	size_t n_terms = 0;
	for (size_t i = 0; i < k; i++) {
	  if (group_counts[i] > 0) {
		   terms[n_terms].val = (group_rank_sums[i] * group_rank_sums[i])
								/ (NV)group_counts[i];
		   terms[n_terms].gid = i;
		   n_terms++;
	  }
	}
	kw_sort(terms, n_terms, kw_depth_limit(n_terms));
	NV stat_base = 0.0;
	for (size_t i = 0; i < n_terms; i++) stat_base += terms[i].val;
	Safefree(terms);
	NV n_d  = (NV)valid_n;
	NV stat = (12.0 * stat_base / (n_d * (n_d + 1.0))) - 3.0 * (n_d + 1.0);
	if (tie_adj > 0.0) {
	  NV tie_denom = 1.0 - (tie_adj / (n_d * n_d * n_d - n_d));
	  stat /= tie_denom;
	}
	/*k is bounded by valid_n, but get_p_value() takes the chi-squared df as an
	int, so the narrowing happens here where it is visible.*/
	int df = (int)(k - 1);
	NV p_val = get_p_value(stat, df);
	// 9. Return structured data exactly like R's htest
	HV *res = newHV();
	hv_stores(res, "statistic", newSVnv(stat));
	hv_stores(res, "parameter", newSViv(df));
	hv_stores(res, "p.value",   newSVnv(p_val));
	hv_stores(res, "method",    newSVpv("Kruskal-Wallis rank sum test", 0));
	// 10. Build the group_stats hash
	HV *group_stats = newHV(), *stats_mean  = newHV(), *stats_size  = newHV();
	for (size_t i = 0; i < k; i++) {
	  if (group_counts[i] > 0 && group_names[i].name) {
		   NV mean = group_val_sums[i] / (NV)group_counts[i];
		   /*Signed klen: negative is hv_store()'s "this key is UTF-8".  The
		   old strlen() both truncated a label at an embedded NUL and dropped
		   the UTF-8 flag, so "groupe\x{301}" came back as mojibake and the two
		   input paths disagreed with each other.*/
		   hv_store(stats_mean, group_names[i].name, group_names[i].klen, newSVnv(mean), 0);
		   hv_store(stats_size, group_names[i].name, group_names[i].klen, newSVuv(group_counts[i]), 0);
	  }
	  if (group_names[i].name) Safefree(group_names[i].name); // Clean up name copy
	}
	// Embed the nested hashes
	hv_stores(group_stats, "mean", newRV_noinc((SV*)stats_mean));
	hv_stores(group_stats, "size", newRV_noinc((SV*)stats_size));
	hv_stores(res, "group.stats",  newRV_noinc((SV*)group_stats));
	// Memory Cleanup
	Safefree(group_names);    Safefree(group_rank_sums); 
	Safefree(group_val_sums); Safefree(group_counts); Safefree(obs);

	RETVAL = newRV_noinc((SV*)res);
}
OUTPUT:
	RETVAL

SV* var_test(...)
CODE:
{
	SV* x_sv = NULL;
	SV* y_sv = NULL;
	NV ratio = 1.0, conf_level = NV_CONF_95;
	const char*alternative = "two.sided";
	Stack_off_t arg_idx = 0;
	// 1. Shift positional argument 'x' if it's an array reference
	if (arg_idx < items && SvROK(ST(arg_idx)) && SvTYPE(SvRV(ST(arg_idx))) == SVt_PVAV) {
	  x_sv = ST(arg_idx);
	  arg_idx++;
	}
	// 2. Shift positional argument 'y' if it's an array reference
	if (arg_idx < items && SvROK(ST(arg_idx)) && SvTYPE(SvRV(ST(arg_idx))) == SVt_PVAV) {
	  y_sv = ST(arg_idx);
	  arg_idx++;
	}
	// Ensure the remaining arguments form complete key-value pairs
	if ((items - arg_idx) % 2 != 0) {
	  croak("Usage: var_test(\\@x, \\@y, key => value, ...)");
	}
	// Parse named arguments from the remaining flat stack
	for (; arg_idx < items; arg_idx += 2) {
	  const char*key = SvPV_nolen(ST(arg_idx));
	  SV* val = ST(arg_idx + 1);

	  if      (strEQ(key, "x"))           x_sv  = val;
	  else if (strEQ(key, "y"))           y_sv  = val;
	  else if (strEQ(key, "ratio"))       ratio = SvNV(val);
	  else if (strEQ(key, "conf_level") || strEQ(key, "conf.level")) conf_level = SvNV(val);
	  else if (strEQ(key, "alternative")) alternative = SvPV_nolen(val);
	  else croak("var_test: unknown argument '%s'", key);
	}
	// Validate required inputs / types
	if (!x_sv || !SvROK(x_sv) || SvTYPE(SvRV(x_sv)) != SVt_PVAV)
	  croak("var_test: 'x' is a required argument and must be an ARRAY reference");
	if (!y_sv || !SvROK(y_sv) || SvTYPE(SvRV(y_sv)) != SVt_PVAV)
	  croak("var_test: 'y' is a required argument and must be an ARRAY reference");

	if (ratio <= 0.0 || !nv_isfinite(ratio)) 
	  croak("var_test: 'ratio' must be a single positive number");
	if (conf_level <= 0.0 || conf_level >= 1.0 || !nv_isfinite(conf_level))
	  croak("var_test: 'conf.level' must be a single number between 0 and 1");
	AV* x_av = (AV*)SvRV(x_sv);
	AV* y_av = (AV*)SvRV(y_sv);
	size_t nx_raw = av_len(x_av) + 1, ny_raw = av_len(y_av) + 1;
	// Computation via Welford's Algorithm (ignoring NaNs)
	NV mean_x = 0.0, M2_x = 0.0;
	size_t nx = 0;
	for (size_t i = 0; i < nx_raw; i++) {
		SV** tv = av_fetch(x_av, i, 0);
		if (tv && SvOK(*tv) && looks_like_number(*tv)) {
			NV val = SvNV(*tv);
			if (!nv_isnan(val) && nv_isfinite(val)) {
				nx++;
				NV delta = val - mean_x;
				mean_x += delta / nx;
				M2_x += delta * (val - mean_x);
			}
		}
	}
	NV mean_y = 0.0, M2_y = 0.0;
	size_t ny = 0;
	for (size_t i = 0; i < ny_raw; i++) {
		SV** tv = av_fetch(y_av, i, 0);
		if (tv && SvOK(*tv) && looks_like_number(*tv)) {
			NV val = SvNV(*tv);
			if (!nv_isnan(val) && nv_isfinite(val)) {
				ny++;
				NV delta = val - mean_y;
				mean_y += delta / ny;
				M2_y += delta * (val - mean_y);
			}
		}
	}
	if (nx < 2) croak("not enough 'x' observations");
	if (ny < 2) croak("not enough 'y' observations");
	NV df_x = (NV)(nx - 1);
	NV df_y = (NV)(ny - 1);
	NV var_x = M2_x / df_x;
	NV var_y = M2_y / df_y;
	if (var_y == 0.0) croak("var_test: variance of 'y' is zero (cannot divide by zero)");
	// Statistics Math
	NV estimate = var_x / var_y;
	NV statistic = estimate / ratio;
	NV p_val = pf(statistic, df_x, df_y);
	NV ci_lower = 0.0, ci_upper = INFINITY;
	if (strcmp(alternative, "less") == 0) {
	  ci_upper = estimate / qf_bisection(1.0 - conf_level, df_x, df_y);
	} else if (strcmp(alternative, "greater") == 0) {
	  p_val = 1.0 - p_val;
	  ci_lower = estimate / qf_bisection(conf_level, df_x, df_y);
	} else {// two.sided
	  NV p1 = p_val;
	  NV p2 = 1.0 - p_val;
	  p_val = 2.0 * (p1 < p2 ? p1 : p2);
	  NV beta = (1.0 - conf_level) / 2.0;
	  ci_lower = estimate / qf_bisection(1.0 - beta, df_x, df_y);
	  ci_upper = estimate / qf_bisection(beta, df_x, df_y);
	}
	// Pack Results
	HV* results = newHV();
	hv_store(results, "statistic", 9, newSVnv(statistic), 0);
	AV* param_av = newAV();
	av_push(param_av, newSVnv(df_x));
	av_push(param_av, newSVnv(df_y));
	hv_store(results, "parameter", 9, newRV_noinc((SV*)param_av), 0);
	hv_store(results, "p.value", 7, newSVnv(p_val), 0);
	AV* conf_int = newAV();
	av_push(conf_int, newSVnv(ci_lower));
	av_push(conf_int, newSVnv(ci_upper));
	hv_store(results, "conf.int", 8, newRV_noinc((SV*)conf_int), 0);
	hv_store(results, "estimate", 8, newSVnv(estimate), 0);
	hv_store(results, "null.value", 10, newSVnv(ratio), 0);
	hv_store(results, "alternative", 11, newSVpv(alternative, 0), 0);
	hv_store(results, "method", 6, newSVpv("F test to compare two variances", 0), 0);
	RETVAL = newRV_noinc((SV*)results);
}
OUTPUT:
	RETVAL

SV *sample(ref, n = 1)
	SV *ref
	IV n
PREINIT:
	SV *ret = &PL_sv_undef;
CODE:
	if (!PL_srand_called) {
	  (void)seedDrand01((Rand_seed_t)Perl_seed(aTHX));
	  PL_srand_called = TRUE;
	}
	if (n < 0) n = 0;
	if (SvROK(ref)) {
		SV *rv = SvRV(ref);
		if (SvTYPE(rv) == SVt_PVHV) {// HASH REFERENCE
			HV *hv    = (HV *)rv;
			unsigned count = hv_iterinit(hv);
			unsigned limit = (n < (IV)count) ? (I32)n : count;
			HV *ret_hv = newHV();
			if (count > 0 && limit > 0) {
				HE **entries;
				HE  *entry;
				unsigned i = 0;
				Newx(entries, count, HE *);
				while ((entry = hv_iternext(hv))) // Collect all HE pointers in one pass
				 entries[i++] = entry;

				//Partial Fisher-Yates (only 'limit' passes)
				for (i = 0; i < limit; i++) {
				 I32 j    = i + (I32)(Drand01() * (count - i));
				 HE *tmp  = entries[i];
				 entries[i] = entries[j];
				 entries[j] = tmp;
				}
	//Pre-size result hash to avoid rehashing during population
				hv_ksplit(ret_hv, limit);

				for (i = 0; i < limit; i++) {
				 HEK *hek = HeKEY_hek(entries[i]);
				 /*hv_store() with a precomputed hash skips the hash
				 computation entirely.  Negative klen signals UTF-8.*/
				 (void)hv_store(
					 ret_hv,
					 HEK_KEY(hek),
					 HEK_UTF8(hek) ? -(I32)HEK_LEN(hek) : (I32)HEK_LEN(hek),
					 SvREFCNT_inc(HeVAL(entries[i])),  //HeVAL: direct macro, no call
					 HeHASH(entries[i])                //reuse precomputed hash
				 );
				}
				Safefree(entries);
			}
			ret = newRV_noinc((SV *)ret_hv);
		} else if (SvTYPE(rv) == SVt_PVAV) {// ARRAY REFERENCE
			AV    *av    = (AV *)rv;
			size_t count = av_top_index(av) + 1;  //signed; 0 for empty AV
			size_t limit = (n < count) ? (size_t)n : count;
			AV    *ret_av = newAV();
			//Pre-allocate the result array to avoid incremental reallocs
			if (n > 0)
				 av_extend(ret_av, (size_t)n - 1);
			if (count > 0) {
				 SV    **src = AvARRAY(av); //direct pointer into AV's C array
				 size_t *restrict idx;

				 //Shuffle indices rather than SV** to keep the original AV intact
				 Newx(idx, count, size_t);
				 for (size_t i = 0; i < count; i++)
					 idx[i] = i;
				 // Partial Fisher-Yates on the index array
				 for (size_t i = 0; i < limit; i++) {
					 size_t j   = i + (size_t)(Drand01() * (count - i));
					 size_t tmp = idx[i];
					 idx[i]  = idx[j];
					 idx[j]  = tmp;
				 }

				 for (size_t i = 0; i < (size_t)n; i++) {
					 if (i < limit) {
						 SV *sv = src[idx[i]];   //AvARRAY direct access — no av_fetch call
						 SV *push_sv;
							if (sv && sv != &PL_sv_undef)
								 push_sv = SvREFCNT_inc(sv);
							else
								 push_sv = newSV(0);
							av_push(ret_av, push_sv);
					 } else {
						 av_push(ret_av, newSV(0));
					 }
				 }
				 Safefree(idx);
			} else {
				for (size_t i = 0; i < (size_t)n; i++)
					av_push(ret_av, newSV(0));
			}
			ret = newRV_noinc((SV *)ret_av);
		}
	}
	RETVAL = ret;
OUTPUT:
	RETVAL

SV* dnorm(...)
CODE:
{
	if (items < 1) {
	  croak("Usage: dnorm(x), dnorm(x, mean => 0, sd => 1, log => 0)");
	}
	SV*x_sv = ST(0);
	NV mean = 0.0, sd = 1.0; //defaults
	bool give_log = 0;
	// --- Parse remaining named arguments from the flat stack
	if ((items - 1) % 2 != 0) {
	  croak("dnorm: Expected an even number of key-value named arguments after 'x'");
	}
	for (Stack_off_t i = 1; i < items; i += 2) {
	  const char* key = SvPV_nolen(ST(i));
	  SV* val = ST(i + 1);
	  if      (strEQ(key, "mean")) mean     = SvNV(val);
	  else if (strEQ(key, "sd"))   sd       = SvNV(val);
	  else if (strEQ(key, "log"))  give_log = SvTRUE(val) ? 1 : 0;
	  else croak("dnorm: unknown argument '%s'", key);
	}
	// Branch based on scalar vs. arrayref for 'x'
	if (SvROK(x_sv) && SvTYPE(SvRV(x_sv)) == SVt_PVAV) {
	  // x is an array reference
	  AV *x_av = (AV*)SvRV(x_sv);
	  IV n = av_len(x_av) + 1;
	  AV *result_av = newAV();
	  if (n > 0) {
		   av_extend(result_av, n - 1);
		   for (IV i = 0; i < n; i++) {
			   SV **elem = av_fetch(x_av, i, 0);
			   NV x_val = (elem && *elem) ? SvNV(*elem) : NAN;
			   NV res = c_dnorm(x_val, mean, sd, give_log);
			   av_store(result_av, i, newSVnv(res));
		   }
	  }
	  RETVAL = newRV_noinc((SV*)result_av);
	} else {
	  // 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 *left  = ST(0);
	SV *right = ST(1);

	SV *how_sv = NULL, *on_sv = NULL;
	SV *lon_sv = NULL, *ron_sv = NULL;
	SV *suf_sv = NULL, *out_sv = NULL;
	for (Stack_off_t oi = 2; oi < items; oi += 2) {
		STRLEN ol;
		const char *on = SvPV(ST(oi), ol);
		SV *ov = ST(oi + 1);
		if      (strEQ(on, "how"))                              how_sv = ov;
		else if (strEQ(on, "on") || strEQ(on, "by"))            on_sv  = ov;
		else if (strEQ(on, "left.on")  || strEQ(on, "left_on")
		      || strEQ(on, "by.x"))                             lon_sv = ov;
		else if (strEQ(on, "right.on") || strEQ(on, "right_on")
		      || strEQ(on, "by.y"))                             ron_sv = ov;
		else if (strEQ(on, "suffixes"))                         suf_sv = ov;
		else if (strEQ(on, "output.type") || strEQ(on, "output_type")
		      || strEQ(on, "out"))                              out_sv = ov;
		else croak("merge: unknown option '%s'", on);
	}
	int how = MG_INNER;
	if (how_sv && SvOK(how_sv)) {
		const char *h = SvPV_nolen(how_sv);
		if      (strEQ(h, "inner"))  how = MG_INNER;
		else if (strEQ(h, "left"))   how = MG_LEFT;
		else if (strEQ(h, "right"))  how = MG_RIGHT;
		else if (strEQ(h, "outer") || strEQ(h, "full")) how = MG_OUTER;
		else if (strEQ(h, "cross"))  how = MG_CROSS;
		else croak("merge: how must be 'inner', 'left', 'right', 'outer', or "
		           "'cross' (got '%s')", h);
	}

	if (on_sv && (lon_sv || ron_sv))
		croak("merge: give either 'on'/'by' or 'left.on'/'right.on', not both");
	if ((lon_sv && !ron_sv) || (ron_sv && !lon_sv))
		croak("merge: 'left.on' and 'right.on' must be given together");
	if (how == MG_CROSS && (on_sv || lon_sv || ron_sv))
		croak("merge: a cross join takes no join keys");

	ENTER; SAVETMPS;
	//suffixes
	SV *suf0 = NULL, *suf1 = NULL;
	if (suf_sv) {
		if (!SvROK(suf_sv) || SvTYPE(SvRV(suf_sv)) != SVt_PVAV
		    || av_len((AV *)SvRV(suf_sv)) != 1)
			croak("merge: suffixes must be a two-element array-ref, e.g. ['.x','.y']");
		AV *sa = (AV *)SvRV(suf_sv);
		suf0 = *av_fetch(sa, 0, 0);
		suf1 = *av_fetch(sa, 1, 0);
	} else {
		suf0 = sv_2mortal(newSVpvs(".x"));
		suf1 = sv_2mortal(newSVpvs(".y"));
	}
	//default output shape follows the left frame
	int def_shape = SvROK(left) ? mg_shape(aTHX_ left) : 0;
	int out_hoa = (def_shape == 1);	//AoH & HoH default to AoH
	if (out_sv && SvOK(out_sv)) {
		const char *os = SvPV_nolen(out_sv);
		if      (strEQ(os, "aoh")) out_hoa = 0;
		else if (strEQ(os, "hoa")) out_hoa = 1;
		else croak("merge: output.type must be 'aoh' or 'hoa' (got '%s')", os);
	}
	mg_frame Lf, Rf;
	mg_prep(aTHX_ left,  "left",  &Lf);
	mg_prep(aTHX_ right, "right", &Rf);
	SSize_t nL = Lf.nrows;
	SSize_t nR = Rf.nrows;
	AV *Lall  = Lf.names, *Rall  = Rf.names;
	HV *Lseen = Lf.seen,  *Rseen = Rf.seen;
	//resolve join keys into lkeys / rkeys
	AV *lkeys, *rkeys;
	if (how == MG_CROSS) {
		lkeys = (AV *)sv_2mortal((SV *)newAV());
		rkeys = (AV *)sv_2mortal((SV *)newAV());
	} else if (lon_sv) {
		lkeys = mg_names(aTHX_ lon_sv);
		rkeys = mg_names(aTHX_ ron_sv);
		if (av_len(lkeys) != av_len(rkeys))
			croak("merge: 'left.on' and 'right.on' must name the same number of columns");
	} else if (on_sv) {
		lkeys = mg_names(aTHX_ on_sv);
		rkeys = lkeys;
	} else {
	/*natural join: sorted intersection of column names. Gather the
	shared names (aliases into Lall), insertion-sort the pointers,
	then copy them into lkeys.*/
		lkeys = (AV *)sv_2mortal((SV *)newAV());
		SSize_t na = av_len(Lall) + 1;
		SV **names;
		Newx(names, (size_t)(na > 0 ? na : 1), SV *);
		SAVEFREEPV(names);
		SSize_t cnt = 0;
		for (SSize_t i = 0; i < na; i++) {
			SV *kn = *av_fetch(Lall, i, 0);
			if (hv_exists_ent(Rseen, kn, 0)) names[cnt++] = kn;
		}
		if (cnt == 0)
			croak("merge: no common columns to join on; pass 'on' or "
			      "'left.on'/'right.on'");
		for (SSize_t a = 1; a < cnt; a++) {
			SV *cur = names[a];
			STRLEN al; const char *ap = SvPV_const(cur, al);
			SSize_t b = a - 1;
			while (b >= 0) {
				STRLEN bl; const char *bp = SvPV_const(names[b], bl);
				int cmp = memcmp(bp, ap, bl < al ? bl : al);
				if (cmp == 0) cmp = (bl > al) - (bl < al);
				if (cmp <= 0) break;
				names[b + 1] = names[b];
				b--;
			}
			names[b + 1] = cur;
		}
		for (SSize_t c = 0; c < cnt; c++) av_push(lkeys, newSVsv(names[c]));
		rkeys = lkeys;
	}
	SSize_t nkeys = av_len(lkeys) + 1;
	//validate that the named keys exist in each frame
	for (SSize_t j = 0; j < nkeys; j++) {
		SV *kn = *av_fetch(lkeys, j, 0);
		if (!hv_exists_ent(Lseen, kn, 0))
			croak("merge: left frame has no join column '%s'", SvPV_nolen(kn));
	}
	for (SSize_t j = 0; j < nkeys; j++) {
		SV *kn = *av_fetch(rkeys, j, 0);
		if (!hv_exists_ent(Rseen, kn, 0))
			croak("merge: right frame has no join column '%s'", SvPV_nolen(kn));
	}
	//key-name sets, to exclude keys from the data-column universe
	HV *lkset = (HV *)sv_2mortal((SV *)newHV());
	HV *rkset = (HV *)sv_2mortal((SV *)newHV());
	for (SSize_t j = 0; j < nkeys; j++) {
		(void)hv_store_ent(lkset, *av_fetch(lkeys, j, 0), newSViv(1), 0);
		(void)hv_store_ent(rkset, *av_fetch(rkeys, j, 0), newSViv(1), 0);
	}
	//non-key data columns for each side, plus name-membership sets
	AV *lc_src = (AV *)sv_2mortal((SV *)newAV());
	HV *lc_set = (HV *)sv_2mortal((SV *)newHV());
	for (SSize_t i = 0, n = av_len(Lall) + 1; i < n; i++) {
		SV *kn = *av_fetch(Lall, i, 0);
		if (hv_exists_ent(lkset, kn, 0)) continue;
		av_push(lc_src, newSVsv(kn));
		(void)hv_store_ent(lc_set, kn, newSViv(1), 0);
	}
	AV *rc_src = (AV *)sv_2mortal((SV *)newAV());
	HV *rc_set = (HV *)sv_2mortal((SV *)newHV());
	for (SSize_t i = 0, n = av_len(Rall) + 1; i < n; i++) {
		SV *kn = *av_fetch(Rall, i, 0);
		if (hv_exists_ent(rkset, kn, 0)) continue;
		av_push(rc_src, newSVsv(kn));
		(void)hv_store_ent(rc_set, kn, newSViv(1), 0);
	}
	SSize_t nlc = av_len(lc_src) + 1;
	SSize_t nrc = av_len(rc_src) + 1;
	/*output column names: overlapping non-key columns get suffixed. Guard
	the resulting universe against accidental collisions.*/
	AV *lc_out = (AV *)sv_2mortal((SV *)newAV());
	AV *rc_out = (AV *)sv_2mortal((SV *)newAV());
	HV *uni = (HV *)sv_2mortal((SV *)newHV());
	for (SSize_t j = 0; j < nkeys; j++) {
		SV *kn = *av_fetch(lkeys, j, 0);
		if (hv_exists_ent(uni, kn, 0))
			croak("merge: duplicate join column '%s'", SvPV_nolen(kn));
		(void)hv_store_ent(uni, kn, newSViv(1), 0);
	}
	for (SSize_t c = 0; c < nlc; c++) {
		SV *kn = *av_fetch(lc_src, c, 0);
		SV *outn;
		if (hv_exists_ent(rc_set, kn, 0)) {
			outn = newSVsv(kn); sv_catsv(outn, suf0);
		} else outn = newSVsv(kn);
		if (hv_exists_ent(uni, outn, 0))
			croak("merge: output column '%s' collides; adjust 'suffixes'",
			      SvPV_nolen(outn));
		(void)hv_store_ent(uni, outn, newSViv(1), 0);
		av_push(lc_out, outn);
	}
	for (SSize_t c = 0; c < nrc; c++) {
		SV *kn = *av_fetch(rc_src, c, 0);
		SV *outn;
		if (hv_exists_ent(lc_set, kn, 0)) {
			outn = newSVsv(kn); sv_catsv(outn, suf1);
		} else outn = newSVsv(kn);
		if (hv_exists_ent(uni, outn, 0))
			croak("merge: output column '%s' collides; adjust 'suffixes'",
			      SvPV_nolen(outn));
		(void)hv_store_ent(uni, outn, newSViv(1), 0);
		av_push(rc_out, outn);
	}
	// resolve every column that will be read, once for the whole join
	SSize_t nu = nkeys + nlc + nrc;
	mg_col *lk, *rk, *lc, *rc;
	SV **oname;
	Newx(lk,    (size_t)(nkeys > 0 ? nkeys : 1), mg_col); SAVEFREEPV(lk);
	Newx(rk,    (size_t)(nkeys > 0 ? nkeys : 1), mg_col); SAVEFREEPV(rk);
	Newx(lc,    (size_t)(nlc   > 0 ? nlc   : 1), mg_col); SAVEFREEPV(lc);
	Newx(rc,    (size_t)(nrc   > 0 ? nrc   : 1), mg_col); SAVEFREEPV(rc);
	Newx(oname, (size_t)(nu    > 0 ? nu    : 1), SV *);   SAVEFREEPV(oname);
	{
		SSize_t o = 0;
		for (SSize_t j = 0; j < nkeys; j++, o++) {
			mg_resolve(aTHX_ &Lf, *av_fetch(lkeys, j, 0), &lk[j]);
			mg_resolve(aTHX_ &Rf, *av_fetch(rkeys, j, 0), &rk[j]);
			oname[o] = mg_shared(aTHX_ *av_fetch(lkeys, j, 0));	//keys keep the left name
		}
		for (SSize_t c = 0; c < nlc; c++, o++) {
			mg_resolve(aTHX_ &Lf, *av_fetch(lc_src, c, 0), &lc[c]);
			oname[o] = mg_shared(aTHX_ *av_fetch(lc_out, c, 0));
		}
		for (SSize_t c = 0; c < nrc; c++, o++) {
			mg_resolve(aTHX_ &Rf, *av_fetch(rc_src, c, 0), &rc[c]);
			oname[o] = mg_shared(aTHX_ *av_fetch(rc_out, c, 0));
		}
	}

	// the join itself: probe into a pair list, then build the result
	mg_join J;
	J.L = &Lf; J.R = &Rf;
	J.lk = lk; J.rk = rk; J.lc = lc; J.rc = rc;
	J.nkeys = nkeys; J.nlc = nlc; J.nrc = nrc;
	J.oname = oname; J.out_hoa = out_hoa;

	mg_pairs *P;
	Newxz(P, 1, mg_pairs);
	SAVEDESTRUCTOR_X(mg_pairs_free, P);	//freed on croak too

	if (how == MG_CROSS) {
		/*No reservation: nL * nR overflows long before it runs out of
		memory, and the list doubles its way there like any other.*/
		for (SSize_t i = 0; i < nL; i++)
			for (SSize_t j = 0; j < nR; j++)
				mg_pair(aTHX_ P, i, j);
	} else {
	/*Index the right frame: join key -> the first row carrying it, with the
	rest of its rows chained through next[].  grp[] holds each row's group so
	the chains can be linked in a second, forward pass -- dd_intern() records
	the row that created a group, which walking forwards makes the first row
	of the chain, and forwards is also the order the rows come out in.*/
		dd_ctx *T;
		Newxz(T, 1, dd_ctx);
		SAVEDESTRUCTOR_X(dd_ctx_free, T);
		T->fast_nv = nk_fast_nv_ok(aTHX);	//asked once for the join
		dd_presize(aTHX_ T, nR);
		SSize_t *grp, *next, *last;
		Newx(grp,  (size_t)(nR > 0 ? nR : 1), SSize_t); SAVEFREEPV(grp);
		Newx(next, (size_t)(nR > 0 ? nR : 1), SSize_t); SAVEFREEPV(next);
		for (SSize_t j = 0; j < nR; j++) {
			const size_t start = T->len;
			grp[j]  = mg_key(aTHX_ T, &Rf, rk, nkeys, j, start)
			        ? dd_intern(aTHX_ T, start, j) : -1;
			next[j] = -1;
		}
		Newx(last, (size_t)(T->ng > 0 ? T->ng : 1), SSize_t); SAVEFREEPV(last);
		for (SSize_t g = 0; g < T->ng; g++) last[g] = -1;
		for (SSize_t j = 0; j < nR; j++) {
			const SSize_t g = grp[j];
			if (g < 0) continue;
			if (last[g] >= 0) next[last[g]] = j;
			last[g] = j;
		}

		char *restrict matched = NULL;
		if (how == MG_RIGHT || how == MG_OUTER) {
			Newxz(matched, (size_t)(nR > 0 ? nR : 1), char);
			SAVEFREEPV(matched);
		}
		/*An upper bound on the output rows: exact for a one-to-one key,
		which is what a join on an id column is.*/
		mg_pairs_reserve(aTHX_ P, (how == MG_OUTER) ? nL + nR
		                        : (how == MG_RIGHT) ? nR : nL);

		for (SSize_t i = 0; i < nL; i++) {
			const size_t start = T->len;
			const SSize_t g = mg_key(aTHX_ T, &Lf, lk, nkeys, i, start)
			                ? dd_find(T, start) : -1;
			if (g >= 0) {
				for (SSize_t j = T->first[g]; j >= 0; j = next[j]) {
					mg_pair(aTHX_ P, i, j);
					if (matched) matched[j] = 1;
				}
			} else if (how == MG_LEFT || how == MG_OUTER) {
				mg_pair(aTHX_ P, i, -1);
			}
		}
		if (matched) {
			for (SSize_t j = 0; j < nR; j++)
				if (!matched[j]) mg_pair(aTHX_ P, -1, j);
		}
	}

	SV *retval = mg_build(aTHX_ &J, P);

	FREETMPS; LEAVE;
	XPUSHs(sv_2mortal(retval));
	XSRETURN(1);
}

void ljoin(h_ref, i_ref)
	SV *h_ref;
	SV *i_ref;
PREINIT:
	HV *h_hv, *i_hv;
	HE *h_entry;
CODE:
	// 1. Validate inputs are hash references
	if (!SvROK(h_ref) || SvTYPE(SvRV(h_ref)) != SVt_PVHV) {
	  croak("First argument to ljoin must be a hash reference");
	}
	if (!SvROK(i_ref) || SvTYPE(SvRV(i_ref)) != SVt_PVHV) {
	  croak("Second argument to ljoin must be a hash reference");
	}
	h_hv = (HV *)SvRV(h_ref);
	i_hv = (HV *)SvRV(i_ref);
	// 2. Iterate through the primary hash ($h)
	hv_iterinit(h_hv);
	while ((h_entry = hv_iternext(h_hv))) {
		SV *row_key_sv = hv_iterkeysv(h_entry);
		SV *h_row_sv   = hv_iterval(h_hv, h_entry);
		// 3. Check if this row key exists in the secondary hash ($i)
		HE *i_fetch_he = hv_fetch_ent(i_hv, row_key_sv, 0, 0);
		if (i_fetch_he) {
			SV *i_row_sv = HeVAL(i_fetch_he);
			// 4. Ensure $h->{row} is a Hash and $i->{row} is a valid reference
			if (SvROK(h_row_sv) && SvTYPE(SvRV(h_row_sv)) == SVt_PVHV && SvROK(i_row_sv)) {
				HV *h_row_hv = (HV *)SvRV(h_row_sv);
				//Case A: $i->{row} is a Hash Reference
				if (SvTYPE(SvRV(i_row_sv)) == SVt_PVHV) {
					HV *i_row_hv = (HV *)SvRV(i_row_sv);
					HE *i_entry;
					hv_iterinit(i_row_hv);
					while ((i_entry = hv_iternext(i_row_hv))) {
						SV *col_key_sv = hv_iterkeysv(i_entry);
						SV *col_val    = hv_iterval(i_row_hv, i_entry);
						hv_store_ent(h_row_hv, col_key_sv, SvREFCNT_inc(col_val), 0);
					}
				} else if (SvTYPE(SvRV(i_row_sv)) == SVt_PVAV) {
					// Case B: $i->{row} is an Array Reference
					AV *i_row_av = (AV *)SvRV(i_row_sv);
					// av_len returns the top index (length - 1)
					SSize_t top_idx = av_len(i_row_av); 
					// Iterate through the array in chunks of 2 (key-value pairs)
					for (SSize_t idx = 0; idx < top_idx; idx += 2) {
						SV **key_svp = av_fetch(i_row_av, idx, 0);
						SV **val_svp = av_fetch(i_row_av, idx + 1, 0);
						// Ensure both the key and value exist in the array
						if (key_svp && val_svp) {
							hv_store_ent(h_row_hv, *key_svp, SvREFCNT_inc(*val_svp), 0);
						}
					}
				}
			}
		}
	}

void add_data(h_ref, i_ref)
	SV *h_ref;
	SV *i_ref;
PREINIT:
	short int target_root_mode = 0; // 1 = Hash, 2 = Array
	short int i_root_mode = 0; // 1 = Hash, 2 = Array
	short int target_inner_mode = 0; // 0 = Unknown, 1 = Hash, 2 = Array
CODE:
	// 1. Validate inputs (Allow both Hash and Array references at the root)
	if (!SvROK(h_ref) || (SvTYPE(SvRV(h_ref)) != SVt_PVHV && SvTYPE(SvRV(h_ref)) != SVt_PVAV)) {
		croak("1st argument to add_data must be a hash or array reference");
	}
	if (!SvROK(i_ref) || (SvTYPE(SvRV(i_ref)) != SVt_PVHV && SvTYPE(SvRV(i_ref)) != SVt_PVAV)) {
		croak("2nd argument to add_data must be a hash or array reference");
	}
	target_root_mode = (SvTYPE(SvRV(h_ref)) == SVt_PVHV) ? 1 : 2;
	i_root_mode      = (SvTYPE(SvRV(i_ref)) == SVt_PVHV) ? 1 : 2;
	// Probe h_ref for inner structure
	if (target_root_mode == 1) {
		HV *h_hv = (HV *)SvRV(h_ref);
		if (HvKEYS(h_hv) > 0) {
			HE **probe_array = HvARRAY(h_hv);
			STRLEN probe_max = HvMAX(h_hv);
			for (STRLEN p_idx = 0; p_idx <= probe_max && target_inner_mode == 0; p_idx++) {
				for (HE *p_entry = probe_array[p_idx]; p_entry && target_inner_mode == 0; p_entry = HeNEXT(p_entry)) {
					SV *val = HeVAL(p_entry);
					if (SvROK(val)) {
						if (SvTYPE(SvRV(val)) == SVt_PVHV) target_inner_mode = 1;
						else if (SvTYPE(SvRV(val)) == SVt_PVAV) target_inner_mode = 2;
					}
				}
			}
		}
	} else {
		AV *h_av = (AV *)SvRV(h_ref);
		SSize_t top = av_len(h_av);
		for (SSize_t p_idx = 0; p_idx <= top && target_inner_mode == 0; p_idx++) {
			SV **svp = av_fetch(h_av, p_idx, 0);
			if (svp && *svp && SvROK(*svp)) {
				if (SvTYPE(SvRV(*svp)) == SVt_PVHV) target_inner_mode = 1;
				else if (SvTYPE(SvRV(*svp)) == SVt_PVAV) target_inner_mode = 2;
			}
		}
	}
	// Target is empty, infer intent from source hash/array
	if (target_inner_mode == 0) {
		if (i_root_mode == 1) {
			HV *i_hv = (HV *)SvRV(i_ref);
			if (HvKEYS(i_hv) > 0) {
				HE **probe_array = HvARRAY(i_hv);
				STRLEN probe_max = HvMAX(i_hv);
				for (STRLEN p_idx = 0; p_idx <= probe_max && target_inner_mode == 0; p_idx++) {
					for (HE *p_entry = probe_array[p_idx]; p_entry && target_inner_mode == 0; p_entry = HeNEXT(p_entry)) {
						SV *val = HeVAL(p_entry);
						if (SvROK(val)) {
							if (SvTYPE(SvRV(val)) == SVt_PVHV) target_inner_mode = 1;
							else if (SvTYPE(SvRV(val)) == SVt_PVAV) target_inner_mode = 2;
						}
					}
				}
			}
		} else {
			AV *i_av = (AV *)SvRV(i_ref);
			SSize_t top = av_len(i_av);
			for (SSize_t p_idx = 0; p_idx <= top && target_inner_mode == 0; p_idx++) {
				SV **svp = av_fetch(i_av, p_idx, 0);
				if (svp && *svp && SvROK(*svp)) {
					if (SvTYPE(SvRV(*svp)) == SVt_PVHV) target_inner_mode = 1;
					else if (SvTYPE(SvRV(*svp)) == SVt_PVAV) target_inner_mode = 2;
				}
			}
		}
	}
	if (target_inner_mode == 0) { target_inner_mode = 1; }
	// 2. Iterate through the SECONDARY structure ($i) using a unified loop
	SSize_t i_idx = 0, i_top = -1;
	HV *i_hv = NULL;
	AV *i_av = NULL;
	if (i_root_mode == 1) {
		i_hv = (HV *)SvRV(i_ref);
		hv_iterinit(i_hv);
	} else {
		i_av = (AV *)SvRV(i_ref);
		i_top = av_len(i_av);
	}
	while (1) {
		SV *row_key_sv = NULL;
		SV *i_row_sv   = NULL;
		SSize_t current_idx = 0;
		if (i_root_mode == 1) {
			HE *i_entry = hv_iternext(i_hv);
			if (!i_entry) break;
			row_key_sv = hv_iterkeysv(i_entry);
			i_row_sv   = hv_iterval(i_hv, i_entry);
			// Prep integer index in case target is an Array (Suppress warnings for non-numeric string keys)
			current_idx = looks_like_number(row_key_sv) ? SvIV(row_key_sv) : -1; 
		} else {
			if (i_idx > i_top) break;
			current_idx = i_idx++;
			SV **svp = av_fetch(i_av, current_idx, 0);
			if (!svp || !*svp) continue;
			i_row_sv = *svp;
			// Prep string key in case target is a Hash
			row_key_sv = sv_2mortal(newSViv(current_idx)); 
		}
		if (SvROK(i_row_sv)) {
			SV *h_row_sv   = NULL;
			HV *h_row_hv   = NULL;
			AV *h_row_av   = NULL;
			// 3. Fetch from $h
			if (target_root_mode == 1) {
				HE *h_fetch_he = hv_fetch_ent((HV *)SvRV(h_ref), row_key_sv, 0, 0);
				if (h_fetch_he) h_row_sv = HeVAL(h_fetch_he);
			} else {
				if (current_idx >= 0) {
					SV **h_fetch_svp = av_fetch((AV *)SvRV(h_ref), current_idx, 0);
					if (h_fetch_svp && *h_fetch_svp) h_row_sv = *h_fetch_svp;
				}
			}
			if (h_row_sv && SvROK(h_row_sv)) {
				if (SvTYPE(SvRV(h_row_sv)) == SVt_PVHV) {
					h_row_hv = (HV *)SvRV(h_row_sv);
				} else if (SvTYPE(SvRV(h_row_sv)) == SVt_PVAV) {
					h_row_av = (AV *)SvRV(h_row_sv);
				}
			}
			// 4. Row DOES NOT exist (or is incompatible type): Create it matching target_inner_mode
			if (!h_row_hv && !h_row_av) {
				if (target_inner_mode == 2) {
					h_row_av = newAV();
					h_row_sv = newRV_noinc((SV *)h_row_av);
				} else {
					h_row_hv = newHV();
					h_row_sv = newRV_noinc((SV *)h_row_hv);
				}
				if (target_root_mode == 1) {
					hv_store_ent((HV *)SvRV(h_ref), row_key_sv, h_row_sv, 0);
				} else {
					if (current_idx >= 0) {
						av_store((AV *)SvRV(h_ref), current_idx, h_row_sv);
					}
				}
			}
			// 5. Merge data across potentially mismatched inner structures
			if (h_row_hv) {
				if (SvTYPE(SvRV(i_row_sv)) == SVt_PVHV) {
					// Hash into Hash (Direct copy)
					HV *i_inner_hv = (HV *)SvRV(i_row_sv);
					HE *i_inner_entry;
					hv_iterinit(i_inner_hv);
					while ((i_inner_entry = hv_iternext(i_inner_hv))) {
						SV *col_key_sv = hv_iterkeysv(i_inner_entry);
						SV *col_val    = hv_iterval(i_inner_hv, i_inner_entry);
						hv_store_ent(h_row_hv, col_key_sv, SvREFCNT_inc(col_val), 0);
					}
				} else if (SvTYPE(SvRV(i_row_sv)) == SVt_PVAV) {
					// Array into Hash (Read pairs)
					AV *i_inner_av = (AV *)SvRV(i_row_sv);
					SSize_t inner_top_idx = av_len(i_inner_av);
					for (SSize_t idx = 0; idx < inner_top_idx; idx += 2) {
						SV **key_svp = av_fetch(i_inner_av, idx, 0);
						SV **val_svp = av_fetch(i_inner_av, idx + 1, 0);
						if (key_svp && *key_svp && val_svp) {
							SV *val_to_store = *val_svp ? *val_svp : &PL_sv_undef;
							hv_store_ent(h_row_hv, *key_svp, SvREFCNT_inc(val_to_store), 0);
						}
					}
				}
			} else if (h_row_av) {
				if (SvTYPE(SvRV(i_row_sv)) == SVt_PVAV) {
					// Array into Array (Direct push with non-null pointer assurance)
					AV *i_inner_av = (AV *)SvRV(i_row_sv);
					SSize_t inner_top_idx = av_len(i_inner_av);
					for (SSize_t idx = 0; idx <= inner_top_idx; ++idx) {
						SV **val_svp = av_fetch(i_inner_av, idx, 0);
						if (val_svp) {
							SV *val_to_push = *val_svp ? *val_svp : &PL_sv_undef;
							SV *sv_inc = SvREFCNT_inc(val_to_push);
							if (sv_inc) {
								av_push(h_row_av, sv_inc);
							}
						}
					}
				} else if (SvTYPE(SvRV(i_row_sv)) == SVt_PVHV) {
					// Hash into Array (Flatten and push pairs with non-null pointer assurance)
					HV *i_inner_hv = (HV *)SvRV(i_row_sv);
					HE *i_inner_entry;
					hv_iterinit(i_inner_hv);
					while ((i_inner_entry = hv_iternext(i_inner_hv))) {
						SV *col_key_sv = hv_iterkeysv(i_inner_entry);
						SV *col_val    = hv_iterval(i_inner_hv, i_inner_entry);
						if (col_key_sv && col_val) {
							SV *sv_key_inc = SvREFCNT_inc(col_key_sv);
							SV *sv_val_inc = SvREFCNT_inc(col_val);
							if (sv_key_inc && sv_val_inc) {
								av_push(h_row_av, sv_key_inc);
								av_push(h_row_av, sv_val_inc);
							}
						}
					}
				}
			}
		}
	}

SV* value_counts(...)
PREINIT:
	HV*counts_hv;
	SV*arg1;
	bool fast_nv;
CODE:
// 1. CHECK FOR DATA FIRST to prevent memory leaks if we die
	if (items == 0) {
	  croak("value_counts: no data provided. At least one argument is required.");
	}
	arg1 = ST(0);
	if (!SvOK(arg1)) {
	  croak("First argument to value_counts is NOT defined");
	}
	// 2. Allocate memory only after we know we are proceeding
	fast_nv = nk_fast_nv_ok(aTHX);   // asked once, used for every cell below
	counts_hv = newHV();
	// CASE 1: Flattened Array (or single scalar)
	if (!SvROK(arg1)) {
	  for (Stack_off_t i = 0; i < items; i++) {
		   increment_count(aTHX_ counts_hv, ST(i), fast_nv);
	  }
	} else {// CASE 2: Array Reference
		SV*rv = SvRV(arg1);
		if (SvTYPE(rv) == SVt_PVAV) {
			AV*av = (AV*)rv;
			size_t len = av_len(av) + 1;
			if (items > 1) {
				// CASE 2b: Array of Hashes (string key) or Array of Arrays (numeric index)
				SV*arg2 = ST(1);
				STRLEN klen;
				const char*key = SvPV(arg2, klen);
				for (unsigned i = 0; i < len; i++) {
					SV**elemp = av_fetch(av, i, 0);
					if (!elemp) continue;
					SV*elem = *elemp;
					if (!SvROK(elem)) {
						SvREFCNT_dec((SV*)counts_hv);
						croak("value_counts: array element %u is not a reference; a HASH ref (Array of Hashes) or ARRAY ref (Array of Arrays) is required when a key/index is given", i);
					}
					SV*inner_rv = SvRV(elem);
					if (SvTYPE(inner_rv) == SVt_PVHV) {// Array of Hashes: extract column by key
						HV*inner_hv = (HV*)inner_rv;
						SV**valp = hv_fetch(inner_hv, key, klen, 0);
						if (valp) increment_count(aTHX_ counts_hv, *valp, fast_nv);// missing key -> skip row
					} else if (SvTYPE(inner_rv) == SVt_PVAV) {// Array of Arrays: extract column by index
						if (!looks_like_number(arg2)) {
							SvREFCNT_dec((SV*)counts_hv);
							croak("value_counts: array element %u is an ARRAY ref but index '%s' is not numeric", i, key);
						}
						AV*inner_av = (AV*)inner_rv;
						SSize_t idx = SvIV(arg2);
						SV**valp = av_fetch(inner_av, idx, 0);
						if (valp) increment_count(aTHX_ counts_hv, *valp, fast_nv);
					} else {
						SvREFCNT_dec((SV*)counts_hv);
						croak("value_counts: unsupported nested reference type in array element %u", i);
					}
				}
			} else {
				// CASE 2a: Flattened/simple array (one value per element)
				for (unsigned i = 0; i < len; i++) {
					SV**valp = av_fetch(av, i, 0);
					if (valp) increment_count(aTHX_ counts_hv, *valp, fast_nv);
				}
			}
		} else if (SvTYPE(rv) == SVt_PVHV) { // CASES 3, 4, 5: Hash Reference
			HV*hv = (HV*)rv;
			if (items > 1) {// CASES 4 & 5: Nested Structure requiring a 2nd Argument
				SV*arg2 = ST(1);
				STRLEN klen;
				const char*key = SvPV(arg2, klen);
				// DataFrame-style Column-Oriented data check
				SV**col_svp = hv_fetch(hv, key, klen, 0);
				if (col_svp && SvROK(*col_svp) && SvTYPE(SvRV(*col_svp)) == SVt_PVAV) {
					AV*av = (AV*)SvRV(*col_svp);
					size_t len = av_len(av) + 1;
					for (size_t i = 0; i < len; i++) {
						SV**valp = av_fetch(av, i, 0);
						if (valp) increment_count(aTHX_ counts_hv, *valp, fast_nv);
					}
				} else {// Fallback: Row-Oriented nested structure
					HE*he;
					hv_iterinit(hv);
					while ((he = hv_iternext(hv))) {
						SV*inner_sv = HeVAL(he);
						if (SvROK(inner_sv)) {
							 SV*inner_rv = SvRV(inner_sv);
							 if (SvTYPE(inner_rv) == SVt_PVHV) {// CASE 5: Hash of Hashes
								 HV*inner_hv = (HV*)inner_rv;
								 SV**valp = hv_fetch(inner_hv, key, klen, 0);
								 if (valp) increment_count(aTHX_ counts_hv, *valp, fast_nv);
							 } else if (SvTYPE(inner_rv) == SVt_PVAV) {// CASE 4: Hash of Arrays (Row-Oriented)
								if (looks_like_number(arg2)) {
									AV*inner_av = (AV*)inner_rv;
									SSize_t idx = SvIV(arg2);
									SV**valp = av_fetch(inner_av, idx, 0);
									if (valp) increment_count(aTHX_ counts_hv, *valp, fast_nv);
								}
							}
						}
					}
				}
			} else { // CASE 3: Hash Reference (No 2nd argument)
				 HE*he;
				 hv_iterinit(hv);
				 while ((he = hv_iternext(hv))) {
					 SV*val = HeVAL(he);
					 if (SvROK(val)) {// SAFETY CHECK
						 SV*inner_rv = SvRV(val);
						 // If it's a Hash of Arrays, count ALL elements in the inner arrays
						 if (SvTYPE(inner_rv) == SVt_PVAV) {
							 AV*inner_av = (AV*)inner_rv;
							 size_t len = av_len(inner_av) + 1;
							 for (size_t i = 0; i < len; i++) {
								 SV**valp = av_fetch(inner_av, i, 0);
								 if (valp) increment_count(aTHX_ counts_hv, *valp, fast_nv);
							 }
						 } else if (SvTYPE(inner_rv) == SVt_PVHV) {
						 // If it's a Hash of Hashes, count ALL elements across all inner keys
							 HV*inner_hv = (HV*)inner_rv;
							 HE*inner_he;
							 hv_iterinit(inner_hv);
							 while ((inner_he = hv_iternext(inner_hv))) {
								 SV*inner_val = HeVAL(inner_he);
								 increment_count(aTHX_ counts_hv, inner_val, fast_nv);
							 }
						 } else { //Unrecognized nested reference type
							 SvREFCNT_dec((SV*)counts_hv);
							 croak("value_counts: Unsupported nested reference type.");
						 }
					 } else {
						 //Simple scalar value
						 increment_count(aTHX_ counts_hv, val, fast_nv);
					 }
				 }
			}
		} else {// Safely decrement the reference count of our hash before dying to prevent a leak
			SvREFCNT_dec((SV*)counts_hv);
			croak("value_counts: Unsupported reference type.");
		}
	}
	RETVAL = newRV_noinc((SV*)counts_hv);
OUTPUT:
	RETVAL

#define EVAL_FILTER(sub_sv, val_sv, keep) do {        \
 dSP;                                                 \
 unsigned int count;                                  \
 SV *_ef_arg = (val_sv) ? (val_sv) : &PL_sv_undef; \
 ENTER;                                               \
 SAVETMPS;                                            \
 SAVE_DEFSV;                                          \
 SvREFCNT_inc(_ef_arg); /* Prevent LEAVE from stealing the refcount */ \
 DEFSV_set(_ef_arg);                                  \
 PUSHMARK(SP);                                        \
 XPUSHs(_ef_arg);                                     \
 PUTBACK;                                             \
 count = call_sv(sub_sv, G_SCALAR | G_EVAL);          \
 SPAGAIN;                                             \
 if (SvTRUE(ERRSV)) { FREETMPS; LEAVE; croak(NULL); } \
 if (count > 0) {                                     \
	 SV *ret_sv = POPs; \
	 keep = SvTRUE(ret_sv);      \
 } else {                        \
	 keep = 0;                   \
 }                               \
 PUTBACK;                        \
 FREETMPS;                       \
 LEAVE;                          \
} while (0)
#define FOR_EACH_FILTER(body) do {                                        \
 for (int _fi = 3; _fi < items && pass_filter; _fi++) {                   \
  SV *_f_ref = ST(_fi);                                          \
  if (!(SvROK(_f_ref) && SvTYPE(SvRV(_f_ref)) == SVt_PVHV)) continue;     \
  HV *_filter_hv = (HV *)SvRV(_f_ref);                           \
  HE *f_he;                                                      \
  hv_iterinit(_filter_hv);                                                \
  while ((f_he = hv_iternext(_filter_hv))) {                              \
   SV *f_col = hv_iterkeysv(f_he);                               \
   SV *f_sub = hv_iterval(_filter_hv, f_he);                     \
   bool keep;                                                             \
   body;                                                                  \
   if (!keep) { pass_filter = 0; break; }                                 \
  }                                                                       \
 }                                                                        \
} while (0)
#define FOR_EACH_FILTER_COL(colvar, body) do {                            \
 for (int _fi = 3; _fi < items; _fi++) {                                  \
  SV *_f_ref = ST(_fi);                                          \
  if (!(SvROK(_f_ref) && SvTYPE(SvRV(_f_ref)) == SVt_PVHV)) continue;     \
  HV *_filter_hv = (HV *)SvRV(_f_ref);                           \
  HE *_fc_he;                                                    \
  hv_iterinit(_filter_hv);                                                \
  while ((_fc_he = hv_iternext(_filter_hv))) {                            \
   SV *colvar = hv_iterkeysv(_fc_he);                            \
   body;                                                                  \
  }                                                                       \
 }                                                                        \
} while (0)
#define GROUP_BY_NO_COL(col_sv) \
 croak("group_by: \"%s\" is not present in the dataset", SvPV_nolen(col_sv))

SV *group_by(data_ref, target_key_sv, group_key_sv, ...)
	SV *data_ref;
	SV *target_key_sv;
	SV *group_key_sv;
PREINIT:
	HV *result_hv;
	SV *result_ref;
CODE:
	if (!SvOK(data_ref)) {
		croak("First argument to group_by is NOT defined");
	}
	if (!SvOK(target_key_sv)) {
		croak("Second argument to group_by is NOT defined");
	}
	if (!SvOK(group_key_sv)) {
		croak("Third argument to group_by is NOT defined");
	}
	//1. Validate the primary input is a reference
	if (!SvROK(data_ref)) {
	croak("First argument to group_by must be a reference (Array of Hashes, Hash of Arrays, or Hash of Hashes)");
	}
/*Optional filters are every argument from ST(3) onward. Each must be a
hashref of { column => sub }; all of them are ANDed together. The
FOR_EACH_FILTER macro walks the arg stack directly (rather than collecting
into a heap array) so a croaking filter sub can't leak anything: for each
{ column => sub } pair the body it wraps runs with f_col (column-name SV)
and f_sub (sub SV) in scope and sets `keep`; pass_filter is cleared and the
loop breaks as soon as any sub returns false. Non-hashref args are skipped.*/
	result_hv = newHV(); //2. Allocate the hash that we will return
//Mortalize immediately! If the callback croaks, the tmps stack will safely clean this up
	result_ref = sv_2mortal(newRV_noinc((SV *)result_hv)); 
	if (SvTYPE(SvRV(data_ref)) == SVt_PVAV) { // Input is an Array of Hashes (AoH)
		AV *data_av = (AV *)SvRV(data_ref);
		SSize_t len = av_len(data_av) + 1;
// A column must exist in at least one row; a missing column name is fatal
		{
			bool group_found = 0, target_found = 0;
			for (SSize_t i = 0; i < len && !(group_found && target_found); i++) {
				SV **rp = av_fetch(data_av, i, 0);
				if (rp && SvROK(*rp) && SvTYPE(SvRV(*rp)) == SVt_PVHV) {
					HV *rh = (HV *)SvRV(*rp);
					if (hv_exists_ent(rh, group_key_sv, 0))  group_found = 1;
					if (hv_exists_ent(rh, target_key_sv, 0)) target_found = 1;
				}
			}
			if (!group_found)  GROUP_BY_NO_COL(group_key_sv);
			if (!target_found) GROUP_BY_NO_COL(target_key_sv);
			FOR_EACH_FILTER_COL(fc, {
				bool found = 0;
				for (SSize_t i = 0; i < len && !found; i++) {
					SV **rp = av_fetch(data_av, i, 0);
					if (rp && SvROK(*rp) && SvTYPE(SvRV(*rp)) == SVt_PVHV
						&& hv_exists_ent((HV *)SvRV(*rp), fc, 0)) found = 1;
				}
				if (!found) GROUP_BY_NO_COL(fc);
			});
		}
		for (SSize_t i = 0; i < len; i++) {
			SV **row_svp = av_fetch(data_av, i, 0);
			if (row_svp && SvROK(*row_svp) && SvTYPE(SvRV(*row_svp)) == SVt_PVHV) {
				HV *row_hv = (HV *)SvRV(*row_svp);
				HE *group_he = hv_fetch_ent(row_hv, group_key_sv, 0, 0);
				HE *target_he = hv_fetch_ent(row_hv, target_key_sv, 0, 0);
				if (group_he) {
					SV *group_val = HeVAL(group_he);
					SV *target_val = target_he ? HeVAL(target_he) : NULL;
					if (target_val && SvOK(target_val)) {
						bool pass_filter = 1;
						FOR_EACH_FILTER({
							HE *val_he = hv_fetch_ent(row_hv, f_col, 0, 0);
							SV *val_sv = val_he ? HeVAL(val_he) : NULL;
							EVAL_FILTER(f_sub, val_sv, keep);
						});
						if (pass_filter) {
							HE *res_he = hv_fetch_ent(result_hv, group_val, 0, 0);
							AV *res_av;
							if (res_he) {
							  res_av = (AV *)SvRV(HeVAL(res_he));
							} else {
							  res_av = newAV();
							  hv_store_ent(result_hv, group_val, newRV_noinc((SV *)res_av), 0);
							}
							av_push(res_av, newSVsv(target_val));
						}
					}
				}
			}
		}
	} else if (SvTYPE(SvRV(data_ref)) == SVt_PVHV) {
		HV *data_hv = (HV *)SvRV(data_ref);
/*Classify: a Hash of Arrays has arrayref values (columns); a Hash of
 Hashes has hashref values (rows). Deciding by value type (rather than
 by whether the requested keys happen to exist) lets a mistyped column
 in a HoA die loudly instead of being mistaken for an empty HoH.*/
		bool is_hoa = 0;
		{
			HE *ce;
			hv_iterinit(data_hv);
			while ((ce = hv_iternext(data_hv))) {
				SV *cv = hv_iterval(data_hv, ce);
				if (SvROK(cv)) {
					U32 ct = SvTYPE(SvRV(cv));
					if (ct == SVt_PVHV) { is_hoa = 0; break; }
					if (ct == SVt_PVAV) { is_hoa = 1; break; }
				}
			}
		}
		if (is_hoa) {
			HE *group_he  = hv_fetch_ent(data_hv, group_key_sv, 0, 0);
			HE *target_he = hv_fetch_ent(data_hv, target_key_sv, 0, 0);
			if (!group_he  || !SvROK(HeVAL(group_he))  || SvTYPE(SvRV(HeVAL(group_he)))  != SVt_PVAV)
				GROUP_BY_NO_COL(group_key_sv);
			if (!target_he || !SvROK(HeVAL(target_he)) || SvTYPE(SvRV(HeVAL(target_he))) != SVt_PVAV)
				GROUP_BY_NO_COL(target_key_sv);
			FOR_EACH_FILTER_COL(fc, { if (!hv_exists_ent(data_hv, fc, 0)) GROUP_BY_NO_COL(fc); });
			AV *group_av = (AV *)SvRV(HeVAL(group_he));
			AV *target_av = (AV *)SvRV(HeVAL(target_he));
			SSize_t g_len = av_len(group_av) + 1;
			SSize_t t_len = av_len(target_av) + 1;
			SSize_t len = g_len < t_len ? g_len : t_len;
			for (SSize_t i = 0; i < len; i++) {
				SV **g_svp = av_fetch(group_av, i, 0);
				SV **t_svp = av_fetch(target_av, i, 0);
				if (g_svp && *g_svp) {
					SV *g_val = *g_svp;
					SV *t_val = (t_svp && *t_svp) ? *t_svp : NULL;
					if (t_val && SvOK(t_val)) {
						bool pass_filter = 1;
						FOR_EACH_FILTER({
							SV *val_sv = NULL;
							HE *arr_he = hv_fetch_ent(data_hv, f_col, 0, 0);
							if (arr_he && SvROK(HeVAL(arr_he)) && SvTYPE(SvRV(HeVAL(arr_he))) == SVt_PVAV) {
								AV *col_av = (AV *)SvRV(HeVAL(arr_he));
								SV **val_svp = av_fetch(col_av, i, 0);
								if (val_svp) val_sv = *val_svp;
							}
							EVAL_FILTER(f_sub, val_sv, keep);
						});
						if (pass_filter) {
							HE *res_he = hv_fetch_ent(result_hv, g_val, 0, 0);
							AV *res_av;
							if (res_he) {
								res_av = (AV *)SvRV(HeVAL(res_he));
							} else {
								res_av = newAV();
								hv_store_ent(result_hv, g_val, newRV_noinc((SV *)res_av), 0);
							}
							av_push(res_av, newSVsv(t_val));
						}
					}
				}
			}
		} else {//Hash of Hashes: a column must exist in at least one inner row
			bool group_found = 0, target_found = 0;
			HE *ve;
			hv_iterinit(data_hv);
			while ((ve = hv_iternext(data_hv))) {
				SV *rv = hv_iterval(data_hv, ve);
				if (SvROK(rv) && SvTYPE(SvRV(rv)) == SVt_PVHV) {
					HV *ih = (HV *)SvRV(rv);
					if (hv_exists_ent(ih, group_key_sv, 0))  group_found = 1;
					if (hv_exists_ent(ih, target_key_sv, 0)) target_found = 1;
				}
			}
			if (!group_found)  GROUP_BY_NO_COL(group_key_sv);
			if (!target_found) GROUP_BY_NO_COL(target_key_sv);
			FOR_EACH_FILTER_COL(fc, {
				bool found = 0;
				HE *ve2;
				hv_iterinit(data_hv);
				while ((ve2 = hv_iternext(data_hv))) {
					SV *rv2 = hv_iterval(data_hv, ve2);
					if (SvROK(rv2) && SvTYPE(SvRV(rv2)) == SVt_PVHV
						&& hv_exists_ent((HV *)SvRV(rv2), fc, 0)) { found = 1; break; }
				}
				if (!found) GROUP_BY_NO_COL(fc);
			});
			HE *row_he;
			hv_iterinit(data_hv);
			while ((row_he = hv_iternext(data_hv))) {
				SV *row_val = hv_iterval(data_hv, row_he);
				if (SvROK(row_val) && SvTYPE(SvRV(row_val)) == SVt_PVHV) {
					HV *inner_hv = (HV *)SvRV(row_val);
					HE *inner_group_he = hv_fetch_ent(inner_hv, group_key_sv, 0, 0);
					HE *inner_target_he = hv_fetch_ent(inner_hv, target_key_sv, 0, 0);
					if (inner_group_he) {
						SV *g_val = HeVAL(inner_group_he);
						SV *t_val = inner_target_he ? HeVAL(inner_target_he) : NULL;
						if (t_val && SvOK(t_val)) {
							bool pass_filter = 1;
							FOR_EACH_FILTER({
								HE *val_he = hv_fetch_ent(inner_hv, f_col, 0, 0);
								SV *val_sv = val_he ? HeVAL(val_he) : NULL;
								EVAL_FILTER(f_sub, val_sv, keep);
							});
							if (pass_filter) {
								HE *res_he = hv_fetch_ent(result_hv, g_val, 0, 0);
								AV *res_av;
								if (res_he) {
									res_av = (AV *)SvRV(HeVAL(res_he));
								} else {
									res_av = newAV();
									hv_store_ent(result_hv, g_val, newRV_noinc((SV *)res_av), 0);
								}
								av_push(res_av, newSVsv(t_val));
							}
						}
					}
				}
			}
		}
	} else {
	  croak("First argument to group_by must be an Array or Hash reference");
	}
	// Balance xsubpp's automatic sv_2mortal to prevent refcount dropping to -1
	RETVAL = SvREFCNT_inc(result_ref);
OUTPUT:
	RETVAL

SV* prcomp(...)
CODE:
{
	SV *x_sv = NULL;
	bool retx = 1, center = 1, do_scale = 0;
	NV tol = -1.0;
	long rank_opt = -1;
	Stack_off_t arg_idx = 0;
	// 1. Shift positional 'x' argument if provided
	if (arg_idx < items && SvROK(ST(arg_idx))) {
	  int t = SvTYPE(SvRV(ST(arg_idx)));
	  if (t == SVt_PVAV || t == SVt_PVHV) {
		   x_sv = ST(arg_idx);
		   arg_idx++;
	  }
	}
	// 2. Parse named arguments
	if ((items - arg_idx) % 2 != 0) croak("Usage: prcomp($data, key => value, ...)");
	for (; arg_idx < items; arg_idx += 2) {
	  const char *key = SvPV_nolen(ST(arg_idx));
	  SV *val = ST(arg_idx + 1);
	  if      (strEQ(key, "x"))      x_sv      = val;
	  else if (strEQ(key, "retx"))   retx      = SvTRUE(val);
	  else if (strEQ(key, "center")) center    = SvTRUE(val);
	  else if (strEQ(key, "scale"))  do_scale  = SvTRUE(val);
	  else if (strEQ(key, "tol"))    tol       = SvOK(val) ? SvNV(val) : -1.0;
	  else if (strEQ(key, "rank"))   rank_opt  = SvOK(val) ? (long)SvIV(val) : -1;
	  else croak("prcomp: unknown argument '%s'", key);
	}

	if (!x_sv || !SvROK(x_sv))
	  croak("prcomp: 'x' is a required argument and must be a reference");

	// 3. Detect Data Structure (AoA, AoH, HoA, HoH)
	bool is_aoa = 0, is_aoh = 0, is_hoa = 0, is_hoh = 0;
	size_t n_raw = 0, p = 0;
	char **colnames = NULL;
	SV *ref = SvRV(x_sv);

	if (SvTYPE(ref) == SVt_PVAV) {
	  AV *av = (AV*)ref;
	  n_raw = av_len(av) + 1;
	  if (n_raw > 0) {
		   SV **first = av_fetch(av, 0, 0);
		   if (first && SvROK(*first) && SvTYPE(SvRV(*first)) == SVt_PVAV) {
			   is_aoa = TRUE;
			   p = av_len((AV*)SvRV(*first)) + 1;
		   } else if (first && SvROK(*first) && SvTYPE(SvRV(*first)) == SVt_PVHV) {
			   is_aoh = TRUE;
		   } else croak("prcomp: Array reference must contain ArrayRefs (AoA) or HashRefs (AoH)");
	  }
	} else if (SvTYPE(ref) == SVt_PVHV) {
	  HV *hv = (HV*)ref;
	  if (hv_iterinit(hv) > 0) {
		   HE *entry = hv_iternext(hv);
		   SV *val = hv_iterval(hv, entry);
		   if (SvROK(val) && SvTYPE(SvRV(val)) == SVt_PVAV) {
			   is_hoa = TRUE;
			   n_raw = av_len((AV*)SvRV(val)) + 1;
		   } else if (SvROK(val) && SvTYPE(SvRV(val)) == SVt_PVHV) {
			   is_hoh = TRUE;
			   n_raw = hv_iterinit(hv);
		   } else croak("prcomp: Hash reference must contain ArrayRefs (HoA) or HashRefs (HoH)");
	  }
	}

	if (n_raw == 0 || (p == 0 && !is_aoh && !is_hoa && !is_hoh)) croak("prcomp: input matrix is empty or has zero columns");

	// 4. Extract and Sort Column Names (for named-column inputs)
	if (is_aoh) {
		AV *av = (AV*)ref;
		HV *first = (HV*)SvRV(*av_fetch(av, 0, 0));
		p = hv_iterinit(first);
		if (p == 0) croak("prcomp: row hashes cannot be empty");

		colnames = (char**)safemalloc(p * sizeof(char*));
		size_t c = 0;
		HE *entry;
		while ((entry = hv_iternext(first))) {
			colnames[c++] = savepv(SvPV_nolen(hv_iterkeysv(entry)));
		}
		qsort(colnames, p, sizeof(char*), cmp_string_wt);
	} else if (is_hoh) {
		HV *hv = (HV*)ref;
		hv_iterinit(hv);
		HE *entry = hv_iternext(hv);
		HV *inner = (HV*)SvRV(hv_iterval(hv, entry));
		p = hv_iterinit(inner);
		if (p == 0) croak("prcomp: inner hashes cannot be empty");

		colnames = (char**)safemalloc(p * sizeof(char*));
		size_t c = 0;
		while ((entry = hv_iternext(inner))) {
			colnames[c++] = savepv(SvPV_nolen(hv_iterkeysv(entry)));
		}
		qsort(colnames, p, sizeof(char*), cmp_string_wt);
	} else if (is_hoa) {
		HV *hv = (HV*)ref;
		p = hv_iterinit(hv);
		if (p == 0) croak("prcomp: input hash is empty");
		colnames = (char**)safemalloc(p * sizeof(char*));
		size_t c = 0;
		HE *entry;
		while ((entry = hv_iternext(hv))) {
			colnames[c++] = savepv(SvPV_nolen(hv_iterkeysv(entry)));
		}
		qsort(colnames, p, sizeof(char*), cmp_string_wt);
	}
	// 5. Extract data & apply listwise deletion for NaNs
	NV *restrict X_mat = (NV*)safemalloc(n_raw * p * sizeof(NV));
	size_t n = 0;
	if (is_aoa) {
	  AV *av = (AV*)ref;
	  for (size_t i = 0; i < n_raw; i++) {
		   SV **row_sv = av_fetch(av, i, 0);
		   if (row_sv && SvROK(*row_sv) && SvTYPE(SvRV(*row_sv)) == SVt_PVAV) {
			   AV *row_av = (AV*)SvRV(*row_sv);
			   bool row_ok = TRUE;
			   for (size_t j = 0; j < p; j++) {
				   SV **cell_sv = av_fetch(row_av, j, 0);
				   if (cell_sv && SvOK(*cell_sv) && looks_like_number(*cell_sv)) {
					   NV v = SvNV(*cell_sv);
					   if (!nv_isfinite(v)) row_ok = FALSE;
					   else X_mat[n * p + j] = v;
				   } else row_ok = FALSE;
			   }
			   if (row_ok) n++;
		   }
	  }
	} else if (is_aoh) {
	  AV *av = (AV*)ref;
	  for (size_t i = 0; i < n_raw; i++) {
		   SV **row_sv = av_fetch(av, i, 0);
		   if (row_sv && SvROK(*row_sv) && SvTYPE(SvRV(*row_sv)) == SVt_PVHV) {
			   HV *row_hv = (HV*)SvRV(*row_sv);
			   bool row_ok = TRUE;
			   for (size_t j = 0; j < p; j++) {
				   SV **cell = hv_fetch(row_hv, colnames[j], strlen(colnames[j]), 0);
				   if (cell && SvOK(*cell) && looks_like_number(*cell)) {
					   NV v = SvNV(*cell);
					   if (!nv_isfinite(v)) row_ok = FALSE;
					   else X_mat[n * p + j] = v;
				   } else row_ok = FALSE;
			   }
			   if (row_ok) n++;
		   }
	  }
	} else if (is_hoa) {
		HV *hv = (HV*)ref;
		AV **col_arrays = (AV**)safemalloc(p * sizeof(AV*));
		for (size_t j = 0; j < p; j++) {
			SV **val = hv_fetch(hv, colnames[j], strlen(colnames[j]), 0);
			col_arrays[j] = (AV*)SvRV(*val);
		}
		for (size_t i = 0; i < n_raw; i++) {
			bool row_ok = TRUE;
			for (size_t j = 0; j < p; j++) {
				SV **cell = av_fetch(col_arrays[j], i, 0);
				if (cell && SvOK(*cell) && looks_like_number(*cell)) {
				  NV v = SvNV(*cell);
				  if (!nv_isfinite(v)) row_ok = FALSE;
				  else X_mat[n * p + j] = v;
				} else row_ok = FALSE;
			}
			if (row_ok) n++;
		}
		Safefree(col_arrays);
	} else if (is_hoh) {
		HV *hv = (HV*)ref;
		hv_iterinit(hv);
		HE *entry;
		while ((entry = hv_iternext(hv))) {
			HV *row_hv = (HV*)SvRV(hv_iterval(hv, entry));
			bool row_ok = TRUE;
			for (size_t j = 0; j < p; j++) {
				SV **cell = hv_fetch(row_hv, colnames[j], strlen(colnames[j]), 0);
				if (cell && SvOK(*cell) && looks_like_number(*cell)) {
				  NV v = SvNV(*cell);
				  if (!nv_isfinite(v)) row_ok = FALSE;
				  else X_mat[n * p + j] = v;
				} else row_ok = FALSE;
			}
			if (row_ok) n++;
		}
	}
	if (n == 0) {
	  if (colnames) {
		   for (size_t i = 0; i < p; i++) Safefree(colnames[i]);
		   Safefree(colnames);
	  }
	  Safefree(X_mat);
	  croak("prcomp: 0 valid observations after listwise NA deletion");
	}
	// 6. Center and Scale
	NV *restrict cen_vec = (NV*)safecalloc(p, sizeof(NV));
	NV *restrict sc_vec  = (NV*)safecalloc(p, sizeof(NV));
	for (size_t j = 0; j < p; j++) {
	  NV col_sum = 0.0;
	  for (size_t i = 0; i < n; i++) col_sum += X_mat[i * p + j];
	  if (center) {
		   cen_vec[j] = col_sum / n;
		   for (size_t i = 0; i < n; i++) X_mat[i * p + j] -= cen_vec[j];
	  }
	  if (do_scale) {
		   NV sum_sq = 0.0;
		   for (size_t i = 0; i < n; i++) {
			   NV val = X_mat[i * p + j] - (center ? 0 : (col_sum / n));
			   sum_sq += val * val;
		   }
		   sc_vec[j] = (n > 1) ? nv_sqrt(sum_sq / (n - 1)) : 0.0;
		   if (sc_vec[j] <= 1e-15) {
			   Safefree(X_mat); Safefree(cen_vec); Safefree(sc_vec);
			   if (colnames) { for (size_t k = 0; k < p; k++) Safefree(colnames[k]); Safefree(colnames); }
			   croak("prcomp: cannot rescale a constant/zero column to unit variance");
		   }
		   for (size_t i = 0; i < n; i++) X_mat[i * p + j] /= sc_vec[j];
	  }
	}
	/*7. Construct Covariance Matrix X^T X

	The accumulator is stored to inside the innermost loop, so without restrict
	every iteration has to reload X[i*p+j] and X[i*p+k] in case the store
	landed in them -- perl is built with -fno-strict-aliasing, so nothing else
	rules that out. Measured on 20000 x 40 doubles, gcc 13 -O2: 8.8 ms without,
	7.8 ms with; -O3, 6.7 ms against 5.7.*/
	NV *restrict XtX = (NV*)safecalloc(p * p, sizeof(NV));
	for (size_t i = 0; i < n; i++) {
	  for (size_t j = 0; j < p; j++) {
		   for (size_t k = j; k < p; k++) {
			   XtX[j * p + k] += X_mat[i * p + j] * X_mat[i * p + k];
		   }
	  }
	}
	// Mirror the symmetric lower triangle
	for (size_t j = 0; j < p; j++) {
	  for (size_t k = 0; k < j; k++) {
		   XtX[j * p + k] = XtX[k * p + j];
	  }
	}
	// 8. Jacobi Eigen Decomposition
	NV *eigen_val = (NV*)safemalloc(p * sizeof(NV));
	NV *eigen_vec = (NV*)safemalloc(p * p * sizeof(NV));
	jacobi_eigen(XtX, p, eigen_val, eigen_vec);
	// 9. Calculate singular values (sdev) & handle dimensions (rank/tol)
	size_t k_cols = (n < p) ? n : p;
	if (rank_opt > 0 && rank_opt < (long)k_cols) k_cols = (size_t)rank_opt;
	NV *sdev = (NV*)safemalloc(k_cols * sizeof(NV));
	NV n_adj = (n > 1) ? (NV)(n - 1) : 1.0;
	for (size_t j = 0; j < k_cols; j++) {
	  NV e_val = eigen_val[j];
	  if (e_val < 0.0) e_val = 0.0; // clamp floating point inaccuracy
	  sdev[j] = nv_sqrt(e_val / n_adj);
	}
	if (tol >= 0.0) {
	  size_t rank_est = 0;
	  NV threshold = sdev[0] * tol;
	  for (size_t j = 0; j < k_cols; j++) {
		   if (sdev[j] > threshold) rank_est++;
	  }
	  if (rank_est < k_cols) k_cols = rank_est;
	}
	// 10. Build Return Hash
	HV *res_hv = newHV();
	AV *sdev_av = newAV();
	for (size_t j = 0; j < k_cols; j++) av_push(sdev_av, newSVnv(sdev[j]));
	hv_stores(res_hv, "sdev", newRV_noinc((SV*)sdev_av));
	AV *rot_av = newAV();
	for (size_t j = 0; j < p; j++) {
	  AV *row_rot = newAV();
	  for (size_t m = 0; m < k_cols; m++) {
		   av_push(row_rot, newSVnv(eigen_vec[j * p + m]));
	  }
	  av_push(rot_av, newRV_noinc((SV*)row_rot));
	}
	hv_stores(res_hv, "rotation", newRV_noinc((SV*)rot_av));
	if (retx) {
	  AV *x_ret_av = newAV();
	  for (size_t i = 0; i < n; i++) {
		   AV *row_x = newAV();
		   for (size_t m = 0; m < k_cols; m++) {
			   NV x_rot_val = 0.0;
			   for (size_t c = 0; c < p; c++) {
				   x_rot_val += X_mat[i * p + c] * eigen_vec[c * p + m];
			   }
			   av_push(row_x, newSVnv(x_rot_val));
		   }
		   av_push(x_ret_av, newRV_noinc((SV*)row_x));
	  }
	  hv_stores(res_hv, "x", newRV_noinc((SV*)x_ret_av));
	}
	if (colnames) {
	  AV *names_av = newAV();
	  for (size_t j = 0; j < p; j++) {
		   av_push(names_av, newSVpv(colnames[j], 0));
	  }
	  hv_stores(res_hv, "varnames", newRV_noinc((SV*)names_av));
	}
	if (center) {
	  AV *c_av = newAV();
	  for (size_t j = 0; j < p; j++) av_push(c_av, newSVnv(cen_vec[j]));
	  hv_stores(res_hv, "center", newRV_noinc((SV*)c_av));
	} else {
	  hv_stores(res_hv, "center", newSVsv(&PL_sv_no));
	}
	if (do_scale) {
	  AV *sc_av = newAV();
	  for (size_t j = 0; j < p; j++) av_push(sc_av, newSVnv(sc_vec[j]));
	  hv_stores(res_hv, "scale", newRV_noinc((SV*)sc_av));
	} else {
	  hv_stores(res_hv, "scale", newSVsv(&PL_sv_no));
	}
	// Cleanup
	if (colnames) {
	  for (size_t i = 0; i < p; i++) Safefree(colnames[i]);
	  Safefree(colnames);
	}
	Safefree(X_mat); Safefree(cen_vec); Safefree(sc_vec);
	Safefree(XtX); Safefree(eigen_val); Safefree(eigen_vec); Safefree(sdev);
	RETVAL = newRV_noinc((SV*)res_hv);
}
OUTPUT:
	RETVAL

SV *transpose(input_ref)
	SV *input_ref
PREINIT:
	svtype  ref_type;
	SV     *retval_sv;
CODE:
	SvGETMAGIC(input_ref);
	if (!SvROK(input_ref))
	  croak("Stats::LikeR::transpose: Input must be a hash ref or array ref");
	ref_type = SvTYPE(SvRV(input_ref));
	if (ref_type == SVt_PVHV) {// ── Hash-of-Hashes
		HV *in_hv  = (HV *)SvRV(input_ref);
		HV *out_hv = newHV();
		HE *he_row, *he_col, *out_inner_he;
		retval_sv = sv_2mortal(newRV_noinc((SV *)out_hv));
		hv_iterinit(in_hv);
		while ((he_row = hv_iternext(in_hv))) {
			SV *row_key_sv  = hv_iterkeysv(he_row);
			SV *row_val     = hv_iterval(in_hv, he_row);
			HV *in_inner_hv;
			SvGETMAGIC(row_val);

			if (!SvROK(row_val) || SvTYPE(SvRV(row_val)) != SVt_PVHV)
				 croak("Stats::LikeR::transpose: Hash mode – inner element is not a hash ref");
			in_inner_hv = (HV *)SvRV(row_val);
			hv_iterinit(in_inner_hv);
			while ((he_col = hv_iternext(in_inner_hv))) {
				SV *col_key_sv = hv_iterkeysv(he_col);
				SV *val        = hv_iterval(in_inner_hv, he_col);
				HV *out_inner_hv;
				SV *inner_ref;
				SvGETMAGIC(val);
				out_inner_he = hv_fetch_ent(out_hv, col_key_sv, 0, 0);
				if (out_inner_he) {
				  inner_ref = HeVAL(out_inner_he);
				  if (!SvROK(inner_ref) || SvTYPE(SvRV(inner_ref)) != SVt_PVHV)
						croak("Stats::LikeR::transpose: Internal error – output structure corrupted");
				  out_inner_hv = (HV *)SvRV(inner_ref);
				} else {
				  out_inner_hv = newHV();
				  inner_ref    = newRV_noinc((SV *)out_inner_hv);
				  if (!hv_store_ent(out_hv, col_key_sv, inner_ref, 0)) {
						SvREFCNT_dec(inner_ref);
						croak("Stats::LikeR::transpose: Failed to allocate inner hash");
				  }
				}
				SvREFCNT_inc(val);
				if (!hv_store_ent(out_inner_hv, row_key_sv, val, 0)) {
				  SvREFCNT_dec(val);
				  croak("Stats::LikeR::transpose: Failed to store transposed value");
				}
			}
		}
	} else if (ref_type == SVt_PVAV) { // Array-of-Arrays
		AV     *in_av  = (AV *)SvRV(input_ref);
		AV     *out_av = newAV();
		size_t nrows  = av_len(in_av) + 1, ncols  = 0;
		retval_sv = sv_2mortal(newRV_noinc((SV *)out_av));
		if (nrows > 0) {// Pass 1: validate all rows; fix ncols from row 0
			{
				 SV **elem = av_fetch(in_av, 0, 0);
				 if (!elem || !*elem)
					  croak("Stats::LikeR::transpose: Array mode – row 0 is missing");
				 SvGETMAGIC(*elem);
				 if (!SvROK(*elem) || SvTYPE(SvRV(*elem)) != SVt_PVAV)
					  croak("Stats::LikeR::transpose: Array mode – row 0 is not an array ref");
				 ncols = av_len((AV *)SvRV(*elem)) + 1;
			}
			for (SSize_t i = 1; i < nrows; i++) {
				 SV     **elem      = av_fetch(in_av, i, 0);
				 SSize_t  row_ncols;
				 if (!elem || !*elem)
					  croak("Stats::LikeR::transpose: Array mode – row %d is missing", (int)i);
				 SvGETMAGIC(*elem);
				 if (!SvROK(*elem) || SvTYPE(SvRV(*elem)) != SVt_PVAV)
					  croak("Stats::LikeR::transpose: Array mode – row %d is not an array ref", (int)i);
				 row_ncols = av_len((AV *)SvRV(*elem)) + 1;
				 if (row_ncols != ncols)
					  croak("Stats::LikeR::transpose: Array mode – ragged array: "
							"row 0 has %d cols, row %d has %d",
							(int)ncols, (int)i, (int)row_ncols);
			}
			if (ncols > 0) {// Pass 2: output[j][i] = input[i][j]
				av_extend(out_av, ncols - 1);
				for (size_t j = 0; j < ncols; j++) {
					AV *out_col_av = newAV();
					SV *col_ref    = newRV_noinc((SV *)out_col_av);
					if (!av_store(out_av, j, col_ref)) {
						SvREFCNT_dec(col_ref);
						croak("Stats::LikeR::transpose: Array mode – "
								"failed to allocate output column %d", (int)j);
					}
					av_extend(out_col_av, nrows - 1);
					for (size_t i = 0; i < nrows; i++) {
						SV **elem = av_fetch(in_av, i, 0);
						if (elem && *elem) {
							SvGETMAGIC(*elem); 
						}
						AV *in_row_av = (AV *)SvRV(*elem);
						SV **val_ptr   = av_fetch(in_row_av, j, 0);
						SV  *val       = (val_ptr && *val_ptr) ? *val_ptr : &PL_sv_undef;
						SvGETMAGIC(val);
						SvREFCNT_inc(val);
						if (!av_store(out_col_av, i, val)) {
							SvREFCNT_dec(val);
							croak("Stats::LikeR::transpose: Array mode – "
									 "failed to store [%d][%d]", (int)j, (int)i);
						}
					}
				}
			}
		}
	} else { // Unsupported
	  croak("Stats::LikeR::transpose: Input must be a hash ref or array ref");
	}
	RETVAL = SvREFCNT_inc(retval_sv);
OUTPUT:
	RETVAL

SV *hoa2aoh(hoa)
	SV *hoa
	PREINIT:
		HV *in;
		AV *out;
		HE *he;
		SV **kv;	// per-column key SVs (mortal)
		AV **cv;	// per-column array bodies (borrowed)
		SSize_t n, i;
		U32 ncols, ci;
	CODE:
	{
		if (!SvROK(hoa) || SvTYPE(SvRV(hoa)) != SVt_PVHV)
			croak("hoa2aoh: argument must be a hash-of-arrays (hashref)");
		in = (HV *)SvRV(hoa);
		ncols = (U32)HvUSEDKEYS(in);
		// SAVEFREEPV makes these scratch arrays croak-safe
		ENTER;
		SAVETMPS;
		Newx(kv, ncols ? ncols : 1, SV *);
		SAVEFREEPV(kv);
		Newx(cv, ncols ? ncols : 1, AV *);
		SAVEFREEPV(cv);
		// one pass to collect columns and find the longest
		n  = 0;
		ci = 0;
		hv_iterinit(in);
		while ((he = hv_iternext(in))) {
			SV *val = HeVAL(he);
			SSize_t len;
			if (!val || !SvROK(val) || SvTYPE(SvRV(val)) != SVt_PVAV)
				croak("hoa2aoh: column '%s' is not an arrayref",
					SvPV_nolen(hv_iterkeysv(he)));
			kv[ci] = hv_iterkeysv(he);	//mortal; valid until our LEAVE
			cv[ci] = (AV *)SvRV(val);
			len = av_len(cv[ci]) + 1;
			if (len > n)
				n = len;
			ci++;
		}
		ncols = ci;
		out = newAV();
		if (n > 0)
			av_extend(out, n - 1);
		for (i = 0; i < n; i++) {
			HV *row = newHV();
			for (ci = 0; ci < ncols; ci++) {
				SV **cp = av_fetch(cv[ci], i, 0);
				SV	*cell = (cp && *cp) ? newSVsv(*cp) : newSV(0);
				(void)hv_store_ent(row, kv[ci], cell, 0);
			}
			av_push(out, newRV_noinc((SV *)row));
		}
		FREETMPS;
		LEAVE;
		RETVAL = newRV_noinc((SV *)out);
	}
	OUTPUT:
		RETVAL

SV *hoa2hoh(hoa, key)
	SV *hoa
	SV *key
	PREINIT:
		HV *in, *out;
		AV *keycol;
		HE *he;
		SV **kv;	// per-column key SVs (mortal)
		AV **cv;	// per-column array bodies (borrowed)
		size_t n, i, ncols, ci;
	CODE:
	{
		if (!SvROK(hoa) || SvTYPE(SvRV(hoa)) != SVt_PVHV)
			croak("hoa2hoh: first argument must be a hash-of-arrays (hashref)");
		if (!SvOK(key))
			croak("hoa2hoh: key column name is undefined");
		in    = (HV *)SvRV(hoa);
		ncols = (size_t)HvUSEDKEYS(in);
		//the key column must exist and be an arrayref
		{
			HE *khe  = hv_fetch_ent(in, key, 0, 0);
			SV *kval = khe ? HeVAL(khe) : NULL;
			if (!khe || !kval || !SvROK(kval) || SvTYPE(SvRV(kval)) != SVt_PVAV)
				croak("hoa2hoh: key column '%s' is not present as an arrayref",
					SvPV_nolen(key));
			keycol = (AV *)SvRV(kval);
		}
		//SAVEFREEPV makes these scratch arrays croak-safe
		ENTER;
		SAVETMPS;
		Newx(kv, ncols ? ncols : 1, SV *);
		SAVEFREEPV(kv);
		Newx(cv, ncols ? ncols : 1, AV *);
		SAVEFREEPV(cv);
		//one pass to collect columns and find the longest
		n  = 0;
		ci = 0;
		hv_iterinit(in);
		while ((he = hv_iternext(in))) {
			SV *val = HeVAL(he);
			size_t len;
			if (!val || !SvROK(val) || SvTYPE(SvRV(val)) != SVt_PVAV)
				croak("hoa2hoh: column '%s' is not an arrayref",
					SvPV_nolen(hv_iterkeysv(he)));
			kv[ci] = hv_iterkeysv(he);	//mortal; valid until our LEAVE
			cv[ci] = (AV *)SvRV(val);
			len = (size_t)(av_len(cv[ci]) + 1);
			if (len > n)
				n = len;
			ci++;
		}
		ncols = ci;
		out = newHV();
		sv_2mortal((SV *)out);	//reclaimed on croak; +1'd below on success
		for (i = 0; i < n; i++) {
			HV *row;
			SV *rowname, **kp = av_fetch(keycol, i, 0);
			if (!kp || !*kp || !SvOK(*kp))
				croak("hoa2hoh: key column '%s' has an undefined value at row %" UVuf,
					SvPV_nolen(key), (UV)i);
			rowname = *kp;
			if (hv_exists_ent(out, rowname, 0))
				croak("hoa2hoh: duplicate row name '%s'", SvPV_nolen(rowname));
			row = newHV();
			for (ci = 0; ci < ncols; ci++) {
				SV **cp   = av_fetch(cv[ci], i, 0);
				SV	*cell = (cp && *cp) ? newSVsv(*cp) : newSV(0);
				(void)hv_store_ent(row, kv[ci], cell, 0);
			}
			(void)hv_store_ent(out, rowname, newRV_noinc((SV *)row), 0);
		}
		RETVAL = newRV_inc((SV *)out);
		FREETMPS;
		LEAVE;
	}
	OUTPUT:
		RETVAL

void vals(data, colname_sv)
	SV *data
	SV *colname_sv
PREINIT:
	bool is_aoh = 0, is_hoh = 0;
	const char *colname = NULL;
	STRLEN collen = 0;
	AV *src_av = NULL;
	HV *src_hv = NULL;
	SSize_t n = 0;
	AV *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);
		n      = av_len(src_av) + 1;
	} else if (SvTYPE(SvRV(data)) == SVt_PVHV) {
		src_hv = (HV *)SvRV(data);
		hv_iterinit(src_hv);
		HE *he = hv_iternext(src_hv);
		if (he) {
			SV *val = HeVAL(he);
			if (val && SvROK(val) && SvTYPE(SvRV(val)) == SVt_PVHV)
				is_hoh = 1;			//a hash whose values are hashes => HoH

			//else leave is_aoh/is_hoh = 0 => HoA path below
		}
		// empty hash: is_aoh = is_hoh = 0 => HoA path yields []
	} else {
		croak("vals: first argument must be an array-ref (AoH) or hash-ref (HoA, HoH)");
	}
	//out_av is mortalised up front so any later croak frees it cleanly
	out_av = newAV();
	sv_2mortal((SV *)out_av);
	if (is_aoh) { // AoH
		if (n > 0) av_extend(out_av, n - 1);
		for (SSize_t i = 0; i < n; i++) {
			SV **rp  = av_fetch(src_av, i, 0);
			SV *row = (rp && *rp) ? *rp : &PL_sv_undef;
// a row must be a hash-ref, else fail here with the index rather than returning undef and letting the caller die vaguely
			if (!SvOK(row))
				croak("vals: AoH row %" IVdf " is undef (expected a hash-ref)", (IV)i);
			if (!SvROK(row) || SvTYPE(SvRV(row)) != SVt_PVHV)
				croak("vals: AoH row %" IVdf " is not a hash-ref", (IV)i);
			HE *ent = hv_fetch_ent((HV *)SvRV(row), colname_sv, 0, 0);
			// a valid row that simply lacks the column still yields undef (R-like NA)
			SV *cell = (ent && HeVAL(ent)) ? HeVAL(ent) : &PL_sv_undef;
			/*copy, so the result is independent of the source and undef
			slots are writable (not the shared read-only PL_sv_undef)*/
			av_push(out_av, newSVsv(cell));
		}
	} else if (is_hoh) { // HoH
		n = hv_iterinit(src_hv);
		if (n > 0) {
			av_extend(out_av, n - 1);
			ENTER;
			SV **keys; SV **rows;
			Newx(keys, n, SV *);  SAVEFREEPV(keys);
			Newx(rows, n, SV *);  SAVEFREEPV(rows);
			SSize_t cnt = 0;
			HE *he;
			while ((he = hv_iternext(src_hv)) && cnt < n) {
				keys[cnt] = hv_iterkeysv(he);	//mortal copy of the key
				rows[cnt] = HeVAL(he);
				cnt++;
			}
	/*stable insertion sort by key (sv_cmp = Perl string order, UTF-8 aware),
	carrying the matching row value alongside each key*/
			for (SSize_t i = 1; i < cnt; i++) {
				SV *k = keys[i], *r = rows[i];
				SSize_t j = i - 1;
				while (j >= 0 && sv_cmp(keys[j], k) > 0) {
					keys[j + 1] = keys[j];
					rows[j + 1] = rows[j];
					j--;
				}
				keys[j + 1] = k;
				rows[j + 1] = r;
			}
			for (SSize_t i = 0; i < cnt; i++) {
				SV *row_sv = rows[i];
				// strict: name the offending key instead of silently emitting undef
				if (!row_sv || !SvROK(row_sv) || SvTYPE(SvRV(row_sv)) != SVt_PVHV)
					croak("vals: HoH value for key '%s' is not a hash-ref",
						SvPV_nolen(keys[i]));
				HE *ent = hv_fetch_ent((HV *)SvRV(row_sv), colname_sv, 0, 0);
				SV *cell = (ent && HeVAL(ent)) ? HeVAL(ent) : &PL_sv_undef;
				av_push(out_av, newSVsv(cell));
			}
			LEAVE;
		}
	} else { // HoA
		if (hv_iterinit(src_hv) > 0) {		//non-empty hash
			HE *colent = hv_fetch_ent(src_hv, colname_sv, 0, 0);
			SV *cv = colent ? HeVAL(colent) : NULL;
			if (!cv || !SvROK(cv) || SvTYPE(SvRV(cv)) != SVt_PVAV)
				croak("vals: column '%s' not found or is not an array-ref", colname);
			AV *col_av = (AV *)SvRV(cv);
			n = av_len(col_av) + 1;
			if (n > 0) {
	/*the length is known, so the result is sized once and filled
	straight through AvARRAY rather than pushed a cell at a time*/
				av_extend(out_av, n - 1);
				SV **d = AvARRAY(out_av);
				SV **src = AvARRAY(col_av);
				const SSize_t srcn = AvFILLp(col_av) + 1;
				for (SSize_t i = 0; i < n; i++)
					d[i] = newSVsv((i < srcn && src[i]) ? src[i] : &PL_sv_undef);
				AvFILLp(out_av) = n - 1;
			}
		}
	}
	/*out_av is mortal (freed on any croak); newRV_inc balances that so the
	returned RV holds the surviving reference -- newRV_noinc here would
	double-free with the mortal.*/
	XPUSHs(sv_2mortal(newRV_inc((SV *)out_av)));
	XSRETURN(1);
}

void
_qcut_core(data_ref, probs_ref, drop_dups, want_codes)
	SV *data_ref
	SV *probs_ref
	IV drop_dups
	IV want_codes
PREINIT:
	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, *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)
		croak("_qcut_core: need at least one data value");
	if (m < 2)
		croak("_qcut_core: need at least two probabilities (one bin)");

	Newx(srt, n, NV);
	for (i = 0; i < n; i++) {
		el = av_fetch(data_av, i, 0);
		srt[i] = (el && SvOK(*el)) ? SvNV(*el) : 0.0;
	}
	qsort(srt, (size_t) n, sizeof(NV), cmp_nv3);

	//quantile cutpoints via linear interpolation (numpy/pandas default)
	Newx(edges, m, NV);
	for (j = 0; j < m; j++) {
		el = av_fetch(probs_av, j, 0);
		p = el ? SvNV(*el) : 0.0;
		if (p < 0.0) p = 0.0;
		if (p > 1.0) p = 1.0;
		h    = (NV)(n - 1) * p;
		lo   = (IV) nv_floor((double) h);
		frac = h - (NV) lo;
		if (lo + 1 < n)
			edges[j] = srt[lo] + frac * (srt[lo + 1] - srt[lo]);
		else
			edges[j] = srt[lo];
	}
	//guard fp drift: enforce non-decreasing edges
	for (j = 1; j < m; j++)
		if (edges[j] < edges[j - 1])
			edges[j] = edges[j - 1];
	Safefree(srt);	//no longer needed once cutpoints exist
	//duplicate edges: raise (default) or drop
	w = 1;
	for (j = 1; j < m; j++) {
		if (edges[j] == edges[w - 1]) {
			if (!drop_dups) {
				Safefree(edges);
				croak("_qcut_core: bin edges are not unique; pass duplicates => 'drop' (or use fewer bins)");
			}
		} else {
			edges[w++] = edges[j];
		}
	}
	ne = w;
	if (ne < 2) {
		Safefree(edges);
		croak("_qcut_core: data has too few distinct values to form bins");
	}

	edge_av = newAV();
	av_extend(edge_av, ne - 1);
	for (j = 0; j < ne; j++)
		av_push(edge_av, newSVnv(edges[j]));

	/*assign each original value to a 0-based bin only if codes are wanted;
	lowest bin is inclusive on both ends*/
	if (want_codes) {
		code_av = newAV();
		av_extend(code_av, n - 1);
		for (i = 0; i < n; i++) {
			el = av_fetch(data_av, i, 0);
			v  = (el && SvOK(*el)) ? SvNV(*el) : 0.0;
			if (v <= edges[0]) {
				bin = 0;
			} else if (v >= edges[ne - 1]) {
				bin = ne - 2;
			} else {
				lo2 = 1;
				hi2 = ne - 1;
				k   = ne - 1;
				while (lo2 <= hi2) {
					mid = lo2 + ((hi2 - lo2) >> 1);
					if (edges[mid] >= v) {
						k   = mid;
						hi2 = mid - 1;
					} else {
						lo2 = mid + 1;
					}
				}
				bin = k - 1;
			}
			av_push(code_av, newSViv(bin));
		}
	}

	Safefree(edges);

	EXTEND(SP, 2);
	if (want_codes)
		PUSHs(sv_2mortal(newRV_noinc((SV *) code_av)));
	else
		PUSHs(&PL_sv_undef);
	PUSHs(sv_2mortal(newRV_noinc((SV *) edge_av)));


void get_union(...)
	PROTOTYPE: @
	PREINIT:
		HV*seen;
		AV*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*arg = ST(i);
			AV*av;
			size_t len;
			if (!(SvROK(arg) && SvTYPE(SvRV(arg)) == SVt_PVAV))
				croak("union: argument index %" UVuf " of %" UVuf " total (max index %" UVuf ") is not an array reference", (UV)i, (UV)nrefs, (UV)(nrefs - 1));
			av = (AV*)SvRV(arg);
			len = (size_t)(av_len(av) + 1);
			for (size_t j = 0; j < len; j++) {
				SV**tv = av_fetch(av, j, 0);
				STRLEN klen;
				const char*key;
				I32 hklen;
				if (!(tv && SvOK(*tv)))
					croak("union: undefined value at array ref index %" UVuf " (argument %" UVuf ")", (UV)j, (UV)i);
				key = SvPV(*tv, klen);
				hklen = SvUTF8(*tv) ? -(I32)klen : (I32)klen;
				if (hv_exists(seen, key, hklen))
					continue;
				(void)hv_store(seen, key, hklen, &PL_sv_undef, 0);
				n++;
				if (gimme != G_SCALAR)
					av_push(order, newSVsv(*tv));
			}
		}
		if (gimme == G_SCALAR) {
			XPUSHs(sv_2mortal(newSVuv(n)));
		} else {
			olen = (size_t)(av_len(order) + 1);
			for (oi = 0; oi < olen; oi++) {
				SV**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 *x_sv = ST(0);
	NV mean = 0.0, sd = 1.0; // defaults
	bool lower_tail = 1, give_log = 0;
	if ((items - 1) % 2 != 0)
		croak("pnorm: Expected an even number of key-value named arguments after 'x'");
	for (Stack_off_t i = 1; i < items; i += 2) {
		const char *key = SvPV_nolen(ST(i));
		SV *val = ST(i + 1);
		if      (strEQ(key, "mean"))                              mean       = SvNV(val);
		else if (strEQ(key, "sd"))                                sd         = SvNV(val);
		else if (strEQ(key, "lower") || strEQ(key, "lower.tail")) lower_tail = SvTRUE(val) ? 1 : 0;
		else if (strEQ(key, "log")   || strEQ(key, "log.p"))      give_log   = SvTRUE(val) ? 1 : 0;
		else croak("pnorm: unknown argument '%s'", key);
	}
	if (sd < 0.0)
		warn("pnorm: standard deviation must be non-negative");
	if (SvROK(x_sv) && SvTYPE(SvRV(x_sv)) == SVt_PVAV) {
		AV *x_av = (AV*)SvRV(x_sv);
		IV n = av_len(x_av) + 1;
		AV *result_av = newAV();
		if (n > 0) {
			av_extend(result_av, n - 1);
			for (IV i = 0; i < n; i++) {
				SV **elem = av_fetch(x_av, i, 0);
				NV x_val = (elem && *elem) ? SvNV(*elem) : NAN;
				NV res = (NV)c_pnorm((double)x_val, (double)mean, (double)sd,
				                     lower_tail, give_log);
				av_store(result_av, i, newSVnv(res));
			}
		}
		RETVAL = newRV_noinc((SV*)result_av);
	} else {
		NV x_val = SvNV(x_sv);
		NV res = (NV)c_pnorm((double)x_val, (double)mean, (double)sd,
		                     lower_tail, give_log);
		RETVAL = newSVnv(res);
	}
}
OUTPUT:
	RETVAL

# The rest of the R distribution family.  Every one is the same six lines over a
# different dist_spec; the numerics, the tail rules and the log.p caveat are all
# documented at the dist_spec block above.

SV* qnorm(...)
CODE:
{
	static const dist_spec spec =
		{ "qnorm", { "mean", "sd" }, { 0.0, 1.0 }, 2, 0, d_qnorm };
	SV *x; NV par[DIST_MAX_PAR]; bool lower, give_log;
	dist_parse(aTHX_ &spec, &ST(0), items, &x, par, &lower, &give_log);
	RETVAL = dist_apply(aTHX_ &spec, x, par, lower, give_log);
}
OUTPUT:
	RETVAL

SV* pt(...)
CODE:
{
	static const dist_spec spec =
		{ "pt", { "df", NULL }, { 0.0, 0.0 }, 1, 1, d_pt };
	SV *x; NV par[DIST_MAX_PAR]; bool lower, give_log;
	dist_parse(aTHX_ &spec, &ST(0), items, &x, par, &lower, &give_log);
	RETVAL = dist_apply(aTHX_ &spec, x, par, lower, give_log);
}
OUTPUT:
	RETVAL

SV* qt(...)
CODE:
{
	static const dist_spec spec =
		{ "qt", { "df", NULL }, { 0.0, 0.0 }, 1, 1, d_qt };
	SV *x; NV par[DIST_MAX_PAR]; bool lower, give_log;
	dist_parse(aTHX_ &spec, &ST(0), items, &x, par, &lower, &give_log);
	RETVAL = dist_apply(aTHX_ &spec, x, par, lower, give_log);
}
OUTPUT:
	RETVAL

SV* pchisq(...)
CODE:
{
	static const dist_spec spec =
		{ "pchisq", { "df", NULL }, { 0.0, 0.0 }, 1, 1, d_pchisq };
	SV *x; NV par[DIST_MAX_PAR]; bool lower, give_log;
	dist_parse(aTHX_ &spec, &ST(0), items, &x, par, &lower, &give_log);
	RETVAL = dist_apply(aTHX_ &spec, x, par, lower, give_log);
}
OUTPUT:
	RETVAL

SV* qchisq(...)
CODE:
{
	static const dist_spec spec =
		{ "qchisq", { "df", NULL }, { 0.0, 0.0 }, 1, 1, d_qchisq };
	SV *x; NV par[DIST_MAX_PAR]; bool lower, give_log;
	dist_parse(aTHX_ &spec, &ST(0), items, &x, par, &lower, &give_log);
	RETVAL = dist_apply(aTHX_ &spec, x, par, lower, give_log);
}
OUTPUT:
	RETVAL

SV* pf(...)
CODE:
{
	static const dist_spec spec =
		{ "pf", { "df1", "df2" }, { 0.0, 0.0 }, 2, 2, d_pf };
	SV *x; NV par[DIST_MAX_PAR]; bool lower, give_log;
	dist_parse(aTHX_ &spec, &ST(0), items, &x, par, &lower, &give_log);
	RETVAL = dist_apply(aTHX_ &spec, x, par, lower, give_log);
}
OUTPUT:
	RETVAL

SV* qf(...)
CODE:
{
	static const dist_spec spec =
		{ "qf", { "df1", "df2" }, { 0.0, 0.0 }, 2, 2, d_qf };
	SV *x; NV par[DIST_MAX_PAR]; bool lower, give_log;
	dist_parse(aTHX_ &spec, &ST(0), items, &x, par, &lower, &give_log);
	RETVAL = dist_apply(aTHX_ &spec, x, par, lower, give_log);
}
OUTPUT:
	RETVAL

SV* pbinom(...)
CODE:
{
	static const dist_spec spec =
		{ "pbinom", { "size", "prob" }, { 0.0, 0.0 }, 2, 2, d_pbinom };
	SV *x; NV par[DIST_MAX_PAR]; bool lower, give_log;
	dist_parse(aTHX_ &spec, &ST(0), items, &x, par, &lower, &give_log);
	RETVAL = dist_apply(aTHX_ &spec, x, par, lower, give_log);
}
OUTPUT:
	RETVAL

# Private numeric helpers.  These replace pure-Perl ports that used to live in
# LikeR.pm (_lgamma/_igamc/_pchisq_upper); igamc() here is the one authoritative
# implementation, so the Perl and C copies can no longer drift apart.  Not
# exported -- callers inside Stats::LikeR use them unqualified.

NV _igamc(a, x)
	NV a
	NV x
CODE:
	RETVAL = igamc(a, x);
OUTPUT:
	RETVAL

# Upper-tail chi-square p-value P(X > stat) on df degrees of freedom.  df is
# taken as an NV (not get_p_value's int) so a fractional df is not truncated,
# matching what the Perl version computed as _igamc($df/2, $stat/2).
NV _pchisq_upper(stat, df)
	NV stat
	NV df
CODE:
	RETVAL = (df <= 0.0 || stat <= 0.0) ? 1.0 : igamc(df / 2.0, stat / 2.0);
OUTPUT:
	RETVAL


# density() -- R's stats::density.default(), kernel density estimation.  See
# the block comment above the dens_* helpers for what each piece is a port of.

SV* density(...)
	CODE:
	{
		SV *x_sv = NULL, *w_sv = NULL, *bw_sv = NULL, *width_sv = NULL;
		NV adjust = 1.0, cut = 3.0, ext = 4.0, from = 0.0, to = 0.0;
		bool have_from = FALSE, have_to = FALSE;
		bool give_rkern = FALSE, subdensity = FALSE;
		bool na_rm = FALSE, old_coords = FALSE;
		//-1 = R's default, which is var(weights) > 0; 0/1 = the caller said so
		short int warnw = -1, kernel = -1, window = -1; //-1 = not given
		IV n_arg = 512;
		size_t nb = 1000;
		Stack_off_t ai = 0;

		if (ai < items && SvROK(ST(ai)) && SvTYPE(SvRV(ST(ai))) == SVt_PVAV) {
			x_sv = ST(ai);
			ai++;
		}
	/*A leading reference that is not an array reference, or a lone
	argument that was not consumed as 'x', was meant to be 'x': say so
	rather than complaining about the parity of a named-argument list the
	caller never wrote.*/
		if (items > 0 && SvROK(ST(0)) && SvTYPE(SvRV(ST(0))) != SVt_PVAV)
			croak("density: 'x' is required and must be an array reference");
		if ((items - ai) % 2 != 0) {
			if (ai == 0 && items == 1)
				croak("density: 'x' is required and must be an array reference");
			croak("density: named arguments must come in key => value pairs");
		}
		for (; ai < items; ai += 2) {
			const char *key = SvPV_nolen(ST(ai));
			SV *val = ST(ai + 1);
			if      (strEQ(key, "x"))       x_sv     = val;
			else if (strEQ(key, "weights")) w_sv     = SvOK(val) ? val : NULL;
			else if (strEQ(key, "bw"))      bw_sv    = SvOK(val) ? val : NULL;
			else if (strEQ(key, "width"))   width_sv = SvOK(val) ? val : NULL;
			else if (strEQ(key, "adjust"))  adjust   = SvNV(val);
			else if (strEQ(key, "n"))       n_arg    = SvIV(val);
			else if (strEQ(key, "cut"))     cut      = SvNV(val);
			else if (strEQ(key, "ext"))     ext      = SvNV(val);
			else if (strEQ(key, "from"))  { from = SvNV(val); have_from = TRUE; }
			else if (strEQ(key, "to"))    { to   = SvNV(val); have_to   = TRUE; }
			else if (strEQ(key, "nb")) {
				IV v = SvIV(val);
				if (v <= 0) croak("density: invalid 'nb'");
				nb = (size_t)v;
			}
			else if (strEQ(key, "kernel")) {
				kernel = dens_match_kernel(SvPV_nolen(val));
				if (kernel < 0)
					croak("density: 'kernel' should be one of \"gaussian\", "
					      "\"epanechnikov\", \"rectangular\", \"triangular\", "
					      "\"biweight\", \"cosine\", \"optcosine\"");
			}
			else if (strEQ(key, "window")) {
				window = dens_match_kernel(SvPV_nolen(val));
				if (window < 0)
					croak("density: 'window' should be one of \"gaussian\", "
					      "\"epanechnikov\", \"rectangular\", \"triangular\", "
					      "\"biweight\", \"cosine\", \"optcosine\"");
			}
			else if (strEQ(key, "give_rkern") || strEQ(key, "give.Rkern"))
				give_rkern = SvTRUE(val) ? TRUE : FALSE;
			else if (strEQ(key, "subdensity"))
				subdensity = SvTRUE(val) ? TRUE : FALSE;
			else if (strEQ(key, "warn_wbw") || strEQ(key, "warnWbw"))
				warnw = SvTRUE(val) ? 1 : 0;
			else if (strEQ(key, "old_coords") || strEQ(key, "old.coords"))
				old_coords = SvTRUE(val) ? TRUE : FALSE;
			else if (strEQ(key, "na_rm") || strEQ(key, "na.rm"))
				na_rm = SvTRUE(val) ? TRUE : FALSE;
			else croak("density: unknown argument '%s'", key);
		}
		//R: if(!missing(window) && missing(kernel)) kernel <- window
		if (window >= 0 && kernel < 0) kernel = window;
		if (kernel < 0) kernel = DENS_K_GAUSSIAN;

		if (give_rkern) {
			//give.Rkern = TRUE returns R(K) and no density at all, as in R
			RETVAL = newSVnv(dens_rkern(kernel));
		} else {
		NV *xall = NULL, *wall = NULL, *xv = NULL, *wv = NULL;
		NV *xf = NULL, *wf = NULL, *xs = NULL;
		NV *yre = NULL, *yim = NULL, *kre = NULL, *kim = NULL;
		NV *twr = NULL, *twi = NULL, *xords = NULL, *xout = NULL;
		bool *restrict isna = NULL;
		const char *err = NULL;
		char errbuf[256];
		size_t N0 = 0, N = 0, nx = 0, nna = 0, n = 0, n_user = 0, m = 0;
		NV bw = 0.0, totMass = 1.0, wsum = 0.0;
		bool has_wts = (w_sv != NULL);
		bool bw_is_rule = FALSE;
		short int bw_rule = DENS_BW_NRD0;
		HV *res = NULL;

		if (!x_sv || !SvROK(x_sv) || SvTYPE(SvRV(x_sv)) != SVt_PVAV)
			croak("density: 'x' is required and must be an array reference");
		if (n_arg < 1) croak("density: 'n' must be at least 1");
		if (n_arg > (IV)1 << 26) croak("density: 'n' is too large");

		{
			AV *xav = (AV *)SvRV(x_sv);
			N0 = (size_t)(av_len(xav) + 1);
			Newx(xall, N0 ? N0 : 1, NV);
			Newx(isna, N0 ? N0 : 1, bool);
			for (size_t i = 0; i < N0; i++) {
				SV **el = av_fetch(xav, i, 0);
				if (!el || !*el || !SvOK(*el)) {
					xall[i] = 0.0; isna[i] = TRUE; nna++;
					continue;
				}
				if (!(SvNIOK(*el) || looks_like_number(*el))) {
					err = "argument 'x' must be numeric";
					goto dens_cleanup;
				}
				xall[i] = SvNV(*el);
				isna[i] = nv_isnan(xall[i]) ? TRUE : FALSE;
				if (isna[i]) nna++;
			}
		}
		if (has_wts) {
			AV *wav;
			if (!SvROK(w_sv) || SvTYPE(SvRV(w_sv)) != SVt_PVAV) {
				err = "'weights' must be an array reference";
				goto dens_cleanup;
			}
			wav = (AV *)SvRV(w_sv);
			if ((size_t)(av_len(wav) + 1) != N0) {
				err = "'x' and 'weights' have unequal length";
				goto dens_cleanup;
			}
			Newx(wall, N0 ? N0 : 1, NV);
			for (size_t i = 0; i < N0; i++) {
				SV **el = av_fetch(wav, i, 0);
				wall[i] = (el && *el && SvOK(*el)) ? SvNV(*el) : NV_NAN;
			}
		}
		if (nna && !na_rm) {
			err = "'x' contains missing values";
			goto dens_cleanup;
		}
		//Drop the NAs, keeping weights summing to one still summing to one.
		N = N0 - nna;
		Newx(xv, N ? N : 1, NV);
		if (has_wts) Newx(wv, N ? N : 1, NV);
		{
			bool trueD = FALSE;
			if (nna && has_wts) {
				NV s = 0.0;
				for (size_t i = 0; i < N0; i++) s += wall[i];
				trueD = (nv_fabs(1.0 - s) <= DENS_ALL_EQ_TOL) ? TRUE : FALSE;
			}
			size_t k = 0;
			for (size_t i = 0; i < N0; i++) {
				if (isna[i]) continue;
				xv[k] = xall[i];
				if (has_wts) wv[k] = wall[i];
				k++;
			}
			if (nna && has_wts && trueD) {
				NV s = 0.0;
				for (size_t i = 0; i < N; i++) s += wv[i];
				for (size_t i = 0; i < N; i++) wv[i] /= s;
			}
		}
		//Infinite observations are point masses outside the grid: they leave
		//the estimate a sub-density on (-Inf, Inf) rather than being dropped.
		for (size_t i = 0; i < N; i++) if (nv_isfinite(xv[i])) nx++;
		Newx(xf, nx ? nx : 1, NV);
		Newx(wf, nx ? nx : 1, NV);
		{
			size_t k = 0;
			for (size_t i = 0; i < N; i++) if (nv_isfinite(xv[i])) xf[k++] = xv[i];
		}
		if (!has_wts) {
			for (size_t i = 0; i < nx; i++) wf[i] = 1.0 / (NV)nx;
			totMass = (NV)nx / (NV)N;
		} else {
			for (size_t i = 0; i < N; i++) {
				if (!nv_isfinite(wv[i])) { err = "'weights' must all be finite"; goto dens_cleanup; }
				if (wv[i] < 0.0)         { err = "'weights' must not be negative"; goto dens_cleanup; }
			}
			for (size_t i = 0; i < N; i++) wsum += wv[i];
			if (nx < N) {
				NV s = 0.0;
				size_t k = 0;
				for (size_t i = 0; i < N; i++) if (nv_isfinite(xv[i])) { wf[k++] = wv[i]; s += wv[i]; }
				totMass = s / wsum;
			} else {
				for (size_t i = 0; i < N; i++) wf[i] = wv[i];
				totMass = 1.0;
			}
	//No error: the caller may have wanted a sub-density.
			if (!subdensity && !(nv_fabs(1.0 - wsum) <= DENS_ALL_EQ_TOL))
				warn("density: sum(weights) != 1  -- will not get true density");
		}
		n_user = (size_t)n_arg;
		n = n_user < 512 ? 512 : n_user;
		if (n > 512) { size_t p = 512; while (p < n) p <<= 1; n = p; }
		//S's `width` is the length of the kernel's support; R's bw is a
		//multiple of the sd, so width only speaks when bw is silent.
		if (!bw_sv && width_sv) {
			if (looks_like_number(width_sv)) {
				bw = SvNV(width_sv) / dens_width_factor(kernel);
			} else {
				bw_rule = dens_match_bw(SvPV_nolen(width_sv));
				if (bw_rule < 0) { err = "unknown bandwidth rule"; goto dens_cleanup; }
				bw_is_rule = TRUE;
			}
		} else if (bw_sv && !looks_like_number(bw_sv)) {
			bw_rule = dens_match_bw(SvPV_nolen(bw_sv));
			if (bw_rule < 0) { err = "unknown bandwidth rule"; goto dens_cleanup; }
			bw_is_rule = TRUE;
		} else if (bw_sv) {
			bw = SvNV(bw_sv);
		} else {
			bw_is_rule = TRUE; //the default, bw = "nrd0"
			bw_rule = DENS_BW_NRD0;
		}

		if (bw_is_rule) {
			if (nx < 2) {
				err = "need at least 2 points to select a bandwidth automatically";
				goto dens_cleanup;
			}
			if (has_wts) {
				bool w_varies;
				if (warnw >= 0) w_varies = warnw ? TRUE : FALSE;
				else w_varies = (nx > 1 && dens_var(wf, nx) > 0.0) ? TRUE : FALSE;
				if (w_varies) warn("density: selecting bandwidth *not* using 'weights'");
			}
			Newx(xs, nx, NV);
			Copy(xf, xs, nx, NV);
			qsort(xs, nx, sizeof(NV), cmp_nv3);
			err = dens_bw_rule(aTHX_ bw_rule, xf, xs, nx, nb,
			                   FALSE, 0.0, FALSE, 0.0, FALSE, 0.0, &bw);
			if (err) goto dens_cleanup;
		}
		if (!nv_isfinite(bw)) { err = "non-finite 'bw'"; goto dens_cleanup; }
		bw *= adjust;
		if (!(bw > 0.0)) { err = "'bw' is not positive."; goto dens_cleanup; }

		if (!have_from || !have_to) {
			NV mn = NV_INF, mx = -NV_INF;
			for (size_t i = 0; i < nx; i++) {
				if (xf[i] < mn) mn = xf[i];
				if (xf[i] > mx) mx = xf[i];
			}
			if (!have_from) from = mn - cut * bw;
			if (!have_to)   to   = mx + cut * bw;
		}
		if (!nv_isfinite(from)) { err = "non-finite 'from'"; goto dens_cleanup; }
		if (!nv_isfinite(to))   { err = "non-finite 'to'";   goto dens_cleanup; }

		m = 2 * n;
		Newx(yre, m, NV);  Newxz(yim, m, NV);
		Newx(kre, m, NV);  Newxz(kim, m, NV);
		Newx(twr, m / 2, NV); Newx(twi, m / 2, NV);
		Newx(xords, n, NV);
		Newx(xout, n_user, NV);
		{
			NV lo = from - ext * bw, up = to + ext * bw;
			NV mult = old_coords ? 2.0 : (NV)(2 * n - 1) / (NV)(n - 1);
			const NV pi = DENS_PI;

			dens_bindist(xf, wf, nx, lo, up, n, yre);
			for (size_t i = 0; i < m; i++) yre[i] *= totMass;
			dens_kernel_grid(kernel, bw, mult * (up - lo), n, kre);

			for (size_t k = 0; k < m / 2; k++) {
				NV ang = -2.0 * pi * (NV)k / (NV)m;
				twr[k] = nv_cos(ang);
				twi[k] = nv_sin(ang);
			}
			dens_fft(yre, yim, twr, twi, m);
			dens_fft(kre, kim, twr, twi, m);
			//fft(y) * Conj(fft(kords))
			for (size_t i = 0; i < m; i++) {
				NV pr = yre[i] * kre[i] + yim[i] * kim[i];
				NV pj = yim[i] * kre[i] - yre[i] * kim[i];
				yre[i] = pr; yim[i] = pj;
			}
			for (size_t k = 0; k < m / 2; k++) twi[k] = -twi[k]; //inverse
			dens_fft(yre, yim, twr, twi, m);
			/*pmax.int(0, Re(.)[1:n] / length(y)): the kernel is non-negative,
			so anything below zero here is rounding error (PR#8876)*/
			for (size_t i = 0; i < n; i++) {
				NV v = yre[i] / (NV)m;
				kre[i] = (v > 0.0) ? v : 0.0;
			}
			dens_seq(lo, up, n, xords);
			dens_seq(from, to, n_user, xout);
		}

		{
			AV *xav_out = newAV(), *yav_out = newAV();
			av_extend(xav_out, (SSize_t)n_user - 1);
			av_extend(yav_out, (SSize_t)n_user - 1);
			for (size_t i = 0; i < n_user; i++) {
				av_push(xav_out, newSVnv(xout[i]));
				av_push(yav_out, newSVnv(dens_approx1(xout[i], xords, kre, n)));
			}
			res = newHV();
			hv_stores(res, "x",          newRV_noinc((SV *)xav_out));
			hv_stores(res, "y",          newRV_noinc((SV *)yav_out));
			hv_stores(res, "bw",         newSVnv(bw));
			hv_stores(res, "n",          newSVuv((UV)N));
			hv_stores(res, "kernel",     newSVpv(dens_kernel_name[kernel], 0));
			hv_stores(res, "old.coords", newSViv(old_coords ? 1 : 0));
			hv_stores(res, "has.na",     newSViv(0));
		}

		dens_cleanup:
		Safefree(xall); Safefree(wall); Safefree(isna);
		Safefree(xv);   Safefree(wv);
		Safefree(xf);   Safefree(wf);   Safefree(xs);
		Safefree(yre);  Safefree(yim);  Safefree(kre); Safefree(kim);
		Safefree(twr);  Safefree(twi);
		Safefree(xords); Safefree(xout);
		if (err) {
			my_snprintf(errbuf, sizeof(errbuf), "density: %s", err);
			croak("%s", errbuf);
		}
		RETVAL = newRV_noinc((SV *)res);
		}
	}
	OUTPUT:
		RETVAL

# bw_nrd0() -- R's bw.nrd0(), Silverman's rule of thumb and density()'s default.

NV bw_nrd0(...)
	CODE:
	{
		NV *x = NULL, *xs = NULL;
		size_t n = 0;
		Stack_off_t ai = 0;
		SV *x_sv = NULL;
		const char *err;
		if (ai < items && SvROK(ST(ai)) && SvTYPE(SvRV(ST(ai))) == SVt_PVAV) x_sv = ST(ai++);
		for (Stack_off_t i = ai; i + 1 < items; i += 2)
			if (strEQ(SvPV_nolen(ST(i)), "x")) x_sv = ST(i + 1);
		dens_read_x(aTHX_ x_sv, "bw_nrd0", &x, &xs, &n);
		err = dens_bw_nrd0(xs, n, x[0], &RETVAL);
		Safefree(x); Safefree(xs);
		if (err) croak("bw_nrd0: %s", err);
	}
	OUTPUT:
		RETVAL

# bw_nrd() -- R's bw.nrd(), Scott's variant of the same rule.

NV bw_nrd(...)
	CODE:
	{
		NV *x = NULL, *xs = NULL;
		size_t n = 0;
		Stack_off_t ai = 0;
		SV *x_sv = NULL;
		const char *err;
		if (ai < items && SvROK(ST(ai)) && SvTYPE(SvRV(ST(ai))) == SVt_PVAV) x_sv = ST(ai++);
		for (Stack_off_t i = ai; i + 1 < items; i += 2)
			if (strEQ(SvPV_nolen(ST(i)), "x")) x_sv = ST(i + 1);
		dens_read_x(aTHX_ x_sv, "bw_nrd", &x, &xs, &n);
		err = dens_bw_nrd(xs, n, &RETVAL);
		Safefree(x); Safefree(xs);
		if (err) croak("bw_nrd: %s", err);
	}
	OUTPUT:
		RETVAL

# bw_ucv() -- R's bw.ucv(), unbiased (least-squares) cross-validation.

NV bw_ucv(...)
	CODE:
	{
		NV *x = NULL, *xs = NULL;
		size_t n = 0;
		Stack_off_t ai = 0;
		SV *x_sv = NULL;
		dens_bw_opts o;
		const char *err;
		if (ai < items && SvROK(ST(ai)) && SvTYPE(SvRV(ST(ai))) == SVt_PVAV) x_sv = ST(ai++);
		for (Stack_off_t i = ai; i + 1 < items; i += 2)
			if (strEQ(SvPV_nolen(ST(i)), "x")) x_sv = ST(i + 1);
		dens_bw_parse(aTHX_ &ST(0), ai, items, "bw_ucv", FALSE, &o);
		dens_read_x(aTHX_ x_sv, "bw_ucv", &x, &xs, &n);
		err = dens_bw_cv(aTHX_ x, xs, n, o.nb, FALSE,
		                 o.have_lower, o.lower, o.have_upper, o.upper,
		                 o.have_tol, o.tol, &RETVAL);
		Safefree(x); Safefree(xs);
		if (err) croak("bw_ucv: %s", err);
	}
	OUTPUT:
		RETVAL

# bw_bcv() -- R's bw.bcv(), biased cross-validation.

NV bw_bcv(...)
	CODE:
	{
		NV *x = NULL, *xs = NULL;
		size_t n = 0;
		Stack_off_t ai = 0;
		SV *x_sv = NULL;
		dens_bw_opts o;
		const char *err;
		if (ai < items && SvROK(ST(ai)) && SvTYPE(SvRV(ST(ai))) == SVt_PVAV) x_sv = ST(ai++);
		for (Stack_off_t i = ai; i + 1 < items; i += 2)
			if (strEQ(SvPV_nolen(ST(i)), "x")) x_sv = ST(i + 1);
		dens_bw_parse(aTHX_ &ST(0), ai, items, "bw_bcv", FALSE, &o);
		dens_read_x(aTHX_ x_sv, "bw_bcv", &x, &xs, &n);
		err = dens_bw_cv(aTHX_ x, xs, n, o.nb, TRUE,
		                 o.have_lower, o.lower, o.have_upper, o.upper,
		                 o.have_tol, o.tol, &RETVAL);
		Safefree(x); Safefree(xs);
		if (err) croak("bw_bcv: %s", err);
	}
	OUTPUT:
		RETVAL

# bw_sj() -- R's bw.SJ(), the Sheather & Jones (1991) selector.  method => 'ste'
# (solve-the-equation, the default, and what bw => 'SJ' means) or 'dpi'
# (direct plug-in, i.e. bw => 'sj-dpi').

NV bw_sj(...)
	CODE:
	{
		NV *x = NULL, *xs = NULL;
		size_t n = 0;
		Stack_off_t ai = 0;
		SV *x_sv = NULL;
		dens_bw_opts o;
		const char *err;
		if (ai < items && SvROK(ST(ai)) && SvTYPE(SvRV(ST(ai))) == SVt_PVAV) x_sv = ST(ai++);
		for (Stack_off_t i = ai; i + 1 < items; i += 2)
			if (strEQ(SvPV_nolen(ST(i)), "x")) x_sv = ST(i + 1);
		dens_bw_parse(aTHX_ &ST(0), ai, items, "bw_sj", TRUE, &o);
		dens_read_x(aTHX_ x_sv, "bw_sj", &x, &xs, &n);
		err = dens_bw_sj(aTHX_ x, xs, n, o.nb, o.ste,
		                 o.have_lower, o.lower, o.have_upper, o.upper,
		                 o.have_tol, o.tol, &RETVAL);
		Safefree(x); Safefree(xs);
		if (err) croak("bw_sj: %s", err);
	}
	OUTPUT:
		RETVAL
