double
dotwcalc(double *lambda, int m, double *ptw, double *pzn, double *pzvar, int minm)
{
double nv, mv, tzn, tm ;
double *evals ;
double y, top, bot, zn, tw, ystat ;
double tail, lsum ;
if (m<minm) {
*pzn = *pzvar = *ptw = -1 ;
return -1.0 ;
}
lsum = asum(lambda, m) ;
if (lsum<=0.0) {
*pzn = *pzvar = *ptw = -1 ;
return -1.0 ;
}
tzn = *pzn ;
tm = (double) m ;
y = (double) m / lsum ;
ystat = lambda[0] * y * tzn ;
if (tzn>0.0) {
tw = twnorm(ystat, tm, tzn) ;
*pzn = tzn ;
*ptw = tw ;
tail = twtail(tw) ;
return tail ;
}
ZALLOC(evals, m, double) ;
vst(evals, lambda, y, m) ;
top = (double) (m*(m+2)) ;
bot = asum2(evals, m) - (double) m ;
zn = top/bot ; // see appendix to eigenpaper NJP
y = evals[0]*zn ;
tw = twnorm(y, tm, zn) ;
*pzn = zn ;
*ptw = tw ;
tail = twtail(tw) ;
free(evals) ;
return tail ;
}
double twnorm(double lam, double p, double n)
// Ref Johnstone (2001)
{
double mu, phi , y1, y2 ;
if (n<0.0) return -10.0 ;
if (p<0.0) return -10.0 ;
if (n<p) return twnorm(lam, n, p) ;
// not very important refinement as twnorm symmetric in p, n-1 NJP
y1 = sqrt(n-1) + sqrt(p) ;
mu = y1*y1 ;
y2 = (1.0/sqrt(n-1)) + 1.0/sqrt(p) ;
phi = y1*pow(y2,1.0/3.0) ;
return (lam-mu)/phi ;
}
double doeig2(double *vals, int m, double *pzn, double *ptw)
{
static int ncall = 0 ;
double y, tw, tail ;
double zn, top, bot ;
double *evals ;
++ncall ;
ZALLOC(evals, m, double) ;
copyarr(vals, evals, m) ;
y = (double) m / asum(evals, m) ;
vst(evals, evals, y, m) ;
top = (double) (m*(m+2)) ;
bot = asum2(evals, m) - (double) m ;
zn = top/bot ;
y = evals[0]*zn ;
tw = twnorm(y, (double) m, zn) ;
tail = twtail(tw) ;
free(evals) ;
*pzn = zn ;
*ptw = tw ;
return tail ;
}