double corrx(double *a, double *b, int n)
// like corr but constant vec returns 0
{
double v12, v11, v22, y1, y2, y ;
double *aa, *bb ;
ZALLOC(aa, n, double) ;
ZALLOC(bb, n, double) ;
y1 = asum(a,n)/ (double) n ;
y2 = asum(b,n)/ (double) n ;
vsp(aa, a, -y1, n) ;
vsp(bb, b, -y2, n) ;
v12 = vdot(aa, bb, n) ;
v11 = asum2(aa, n) ;
v22 = asum2(bb, n) ;
free(aa) ;
free(bb) ;
y = v11*v22 ;
y += 1.0e-12 ;
return (v12/sqrt(y)) ;
}
NT2_TEST_CASE_TPL( var, NT2_REAL_TYPES )
{
typedef std::complex<T> cT;
nt2::table<cT> y( nt2::of_size(5,3) );
nt2::table<cT> cy, cy2;
nt2::table<T> sy;
nt2::table<T> sy2;
for(int j=1;j<=3;j++)
for(int i=1;i<=5;i++)
y(i,j) = T(i + 10*j);
cy = center(y, 2);
sy = asum2(cy, 2)/T(nt2::size(y, 2)-1);
sy2 = nt2::var(y, 0, 2);
NT2_TEST_EQUAL(sy, sy2);
NT2_TEST_EQUAL(sy, nt2::var(y, 0, 2));
cy = center(y, 1);
sy = asum2(cy, 1)/T(nt2::size(y, 1)-1);
sy2 = nt2::var(y, 0, 1);
NT2_TEST_EQUAL(sy, sy2);
NT2_TEST_EQUAL(sy, nt2::var(y, 0, 1));
sy2 = nt2::var(y, 0, 3);
NT2_TEST_EQUAL(zeros(size(sy2), nt2::meta::as_<T>()), sy2);
NT2_TEST_EQUAL(zeros(size(sy2), nt2::meta::as_<T>()), nt2::var(y, 0, 3));
}
double corr(double *a, double *b, int n)
{
double v12, v11, v22, y1, y2, y ;
double *aa, *bb ;
ZALLOC(aa, n, double) ;
ZALLOC(bb, n, double) ;
y1 = asum(a,n)/ (double) n ;
y2 = asum(b,n)/ (double) n ;
vsp(aa, a, -y1, n) ;
vsp(bb, b, -y2, n) ;
v12 = vdot(aa, bb, n) ;
v11 = asum2(aa, n) ;
v22 = asum2(bb, n) ;
y = v11*v22 ;
if (y==0.0) fatalx("(corr) constant vector\n") ;
free(aa) ;
free(bb) ;
return (v12/sqrt(y)) ;
}
BOOST_FORCEINLINE result_type operator()(A0 const& a0, const A1& a1, const A2& a2) const
{
BOOST_ASSERT_MSG(a1 == 0 || a1 == 1, "integer value a1 must be 0 or 1");
real_type n = nt2::size(a0, a2);
real_type n1 = n - (a1 ? 0 : 1);
real_type f = (n <= One<real_type>())? One<real_type>() : nt2::rec(n1);
return nt2::multiplies(f, asum2(center(a0, a2), a2));
}
void
writesnpeigs(char *snpeigname, SNP **xsnplist, double *ffvecs, int numeigs, int ncols)
{
// this is called at end and ffvecs overwritten
double *xpt, y, yscal, *snpsc ;
int i, j, k, kmax, kmin ;
SNP * cupt ;
FILE *fff ;
for (j=0; j<numeigs; ++j) {
xpt = ffvecs+j*ncols ;
y = asum2(xpt, ncols) ;
yscal = (double) ncols / y ;
yscal = sqrt(yscal) ;
vst(xpt, xpt, yscal, ncols) ;
}
ZALLOC(snpsc, ncols, double) ;
vclear(snpsc, -99999, ncols) ;
for (j=0; j<numeigs; ++j) {
for (i=0; i<ncols; ++i) {
cupt = xsnplist[i] ;
if (cupt -> ignore) continue ;
y = ffvecs[j*ncols+i] ;
snpsc[i] = fabs(y) ;
}
for (k=0; k<=10; ++k) {
vlmaxmin(snpsc, ncols, &kmax, &kmin) ;
cupt = xsnplist[kmax] ;
printf("eigbestsnp %4d %20s %2d %12d %9.3f\n", j+1, cupt -> ID, cupt -> chrom, nnint(cupt -> physpos), snpsc[kmax]) ;
snpsc[kmax] = -1.0 ;
}
}
free(snpsc) ;
if (snpeigname == NULL) return ;
openit (snpeigname, &fff, "w") ;
for (i=0; i<ncols; ++i) {
cupt = xsnplist[i] ;
if (cupt -> ignore) continue ;
fprintf(fff, "%20s", cupt -> ID) ;
fprintf(fff, " %2d", cupt -> chrom) ;
fprintf(fff, " %12d", nnint(cupt -> physpos)) ;
for (j=0; j<numeigs; ++j) {
fprintf(fff, " %9.3f", ffvecs[j*ncols+i]) ;
}
fprintf(fff, "\n") ;
}
fclose(fff) ;
}
double anova(double *vec, int len, int *xtypes, int numeg)
// anova 1 but f statistic
{
int i, k ;
double y1, top, bot, ftail ;
double *w0, *w1, *popsize, *wmean ;
static int ncall2 = 0 ;
if (numeg >= len) fatalx("bad anova\n") ;
ZALLOC(w0, len, double) ;
ZALLOC(w1, len, double) ;
ZALLOC(wmean, numeg, double) ;
ZALLOC(popsize, numeg, double) ;
y1 = asum(vec, len)/ (double) len ; // mean
vsp(w0, vec, -y1, len) ;
for (i=0; i<len; i++) {
k = xtypes[i] ;
++popsize[k] ;
wmean[k] += w0[i] ;
}
/* debug */
if (numeg == 2) {
++ncall2 ;
for (i=0; i<len; ++i) {
if (ncall2<0) break ;
k = xtypes[i] ;
// printf("yy %4d %4d %12.6f %12.6f\n", i, k, vec[i], w0[i]) ;
}
}
vsp(popsize, popsize, 1.0e-12, numeg) ;
vvd(wmean, wmean, popsize, numeg) ;
vvt(w1, wmean, wmean, numeg) ;
top = vdot(w1, popsize, numeg) ;
for (i=0; i<len ; i++) {
k = xtypes[i] ;
w1[i] = w0[i] - wmean[k] ;
}
bot = asum2(w1, len) / (double) (len-numeg) ;
bot *= (double) (numeg-1) ;
ftail = rtlf(numeg-1, len-numeg, top/bot) ;
free(w0) ;
free(w1) ;
free(popsize) ;
free(wmean) ;
return ftail ;
}
double
anova1 (double *vec, int len, int *xtypes, int numeg)
{
int i, k;
double y1, y2, ylike;
double *w0, *w1, *popsize, *wmean;
ZALLOC(w0, len, double);
ZALLOC(w1, len, double);
ZALLOC(wmean, numeg, double);
ZALLOC(popsize, numeg, double);
y1 = asum (vec, len) / (double) len; // mean
vsp (w0, vec, -y1, len);
for (i = 0; i < len; i++)
{
k = xtypes[i];
++popsize[k];
wmean[k] += w0[i];
}
vsp (popsize, popsize, 1.0e-12, numeg);
vvd (wmean, wmean, popsize, numeg);
for (i = 0; i < len; i++)
{
k = xtypes[i];
w1[i] = w0[i] - wmean[k];
}
y1 = asum2 (w0, len) / (double) len;
y2 = asum2 (w1, len) / (double) len;
ylike = 0.5 * ((double) len) * log (y1 / y2);
free (w0);
free (w1);
free (popsize);
free (wmean);
return ylike;
}
void bal(double *a, double *b, int n)
/**
normalize mean 0 s.d 1
*/
{
double t ;
t = asum(b,n)/ (double) n ;
vsp (a, b, -t, n) ;
t = asum2(a,n)/ (double) n ;
vst (a, a, 1.0/sqrt(t), n) ;
}
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 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 ;
}
int
ridoutlier (double *evecs, int n, int neigs, double thresh, int *badlist,
OUTLINFO **outinfo)
{
/* badlist contains list of outliers */
double *ww, *w2, y1, y2, yy, zz;
int *vbad;
int i, j;
int nbad = 0;
OUTLINFO *outpt;
if (outliermode > 1)
return 0;
if (n < 3)
return 0;
ZALLOC(ww, n, double);
ZALLOC(vbad, n, int);
for (j = 0; j < n; j++)
{
outpt = outinfo[j];
outpt->vecno = -1;
}
for (i = 0; i < neigs; ++i)
{
copyarr (evecs + i * n, ww, n);
if (outliermode == 0)
{
y1 = asum (ww, n) / (double) n;
vsp (ww, ww, -y1, n);
y2 = asum2 (ww, n) / (double) n;
y2 = sqrt (y2);
vst (ww, ww, 1.0 / y2, n);
for (j = 0; j < n; j++)
{
if (fabs (ww[j]) > thresh)
{
vbad[j] = 1;
outpt = outinfo[j];
if (outpt->vecno < 0)
{
outpt->vecno = i;
outpt->score = ww[j];
}
}
}
}
if (outliermode == 1)
{
ZALLOC(w2, n, double);
for (j = 0; j < n; j++)
{
yy = ww[j];
ww[j] = 0;
y1 = asum (ww, n) / (double) (n - 1);
vsp (w2, ww, -y1, n);
w2[j] = 0;
y2 = asum2 (w2, n) / (double) n;
y2 = sqrt (y2);
zz = yy - y1;
zz /= y2;
if (fabs (zz) > thresh)
{
vbad[j] = 1;
outpt = outinfo[j];
if (outpt->vecno < 0)
{
outpt->vecno = i;
outpt->score = zz;
}
}
ww[j] = yy;
}
free (w2);
}
}
for (j = 0; j < n; j++)
{
if (vbad[j] == 1)
{
badlist[nbad] = j;
++nbad;
}
}
free (ww);
free (vbad);
return nbad;
}
