void solvit (double *prod, double *rhs, int n, double *ans) { //The coefficient matrix should be positive definite /*AT : changed this code to take in matrix in a linear array form*/ double *ttt; double *b; double *p; int i ; ZALLOC (ttt, n*n, double); ZALLOC (p, n, double); ZALLOC(b,n,double); copyarr(prod,ttt,n*n); copyarr(rhs,b,n); choldc (ttt, n, p); cholsl (ttt, n, p, b, ans); free (ttt) ; free(b); free (p) ; }
void cholesky(double *cf, double *a, int n) { int i, j, k ; double *tt ; double *p ; ZALLOC(tt, n*n, double) ; ZALLOC(p, n, double) ; copyarr(a,tt,n*n); choldc(tt, n, p ) ; vzero(cf, n*n) ; for (i = 0; i < n; i++) { tt[i*n+i] = p[i] ; for (j=0; j <= i ; j++) { k = (i)*n+(j) ; cf[k] = tt[i*n+j] ; } } free(tt) ; free(p) ; }
void transpose(double *aout, double *ain, int m, int n) /** aout and ain must be identical or not overlap does matrix transpose input m vectors of length n (m x n) output n vectors of length m */ { double *ttt ; int i, j, k1, k2 ; if (aout == ain) { ZALLOC(ttt, m*n, double) ; } else ttt = aout ; for (i=0; i<m; i++) for (j=0; j<n; j++) { k1 = i*n+j ; k2 = j*m+i ; ttt[k2] = ain[k1] ; } if (aout == ain) { copyarr(ttt, aout, m*n) ; free(ttt) ; } }
void ldreg (double *ldmat, double *ldmat2, double *vv, double *vv2, double *ldvv, double *ldvv2, int rsize, int n) /** ldmat2 is inner product matrix for last rsize columns on exit */ { int i, j, k1, k2; double *rr, *ans, *tt; double y; ZALLOC(rr, rsize, double); ZALLOC(ans, rsize, double); ZALLOC(tt, n, double); if (rsize > 1) copyarr (ldvv, ldvv2 + n, n * (rsize - 1)); for (i = 0; i < rsize - 1; i++) { for (j = 0; j < rsize - 1; j++) { k1 = i * rsize + j; k2 = (i + 1) * rsize + j + 1; ldmat2[k2] = ldmat[k1]; } } copyarr (vv, ldvv2, n); i = 0; for (j = 0; j < rsize; j++) { y = rr[j] = vdot (vv, ldvv + j * n, n); y = vdot (vv, ldvv2 + j * n, n); if (j == 0) y += 1.0e-6; ldmat2[i * rsize + j] = ldmat2[j * rsize + i] = y; } solvit (ldmat, rr, rsize, ans); /* solve normal equations */ copyarr (vv, vv2, n); for (i = 0; i < rsize; i++) { vst (tt, ldvv + i * n, -ans[i], n); vvp (vv2, vv2, tt, n); } free (rr); free (ans); free (tt); }
double oldtwestxx (double *lam, int m, double *pzn, double *pzvar) { double lsum, logsum; double *ww; double a, p, yn, var; double ylike, ybase, y, ylmax, ynmax, yld, yld2, ainc, ym; int k; ZALLOC(ww, m, double); copyarr (lam, ww, m); lsum = asum (ww, m); vlog (ww, ww, m); logsum = asum (ww, m); ylmax = -1.0e20; yn = (double) m; ybase = xxlikex (m, yn, logsum, lsum); for (k = 1; k <= 100; ++k) { a = yn / 2.0; ylike = xxlikex (m, a, logsum, lsum); yld = xxliked (m, a, logsum, lsum); ylike -= ybase; if (verbose) printf ("ynloop %12.3f %12.3f %12.3f\n", yn / (double) m, ylike, yld); if (ylike < ylmax) break; ylmax = ylike; ynmax = yn; yn *= 1.1; } a = ynmax / 2.0; for (k = 1; k <= 10; ++k) { // newton iteration ylike = xxlikex (m, a, logsum, lsum); yld = xxliked (m, a, logsum, lsum); yld2 = xxliked2 (m, a, logsum, lsum); ylike -= ybase; ainc = -yld / yld2; a += ainc; if (verbose) printf ("newton: %3d %15.9f %15.9f %15.9f\n", k, ylike, yld, ainc); } fflush (stdout); yn = 2.0 * a; ym = (double) m; var = lsum / (2.0 * a * ym); *pzn = yn; *pzvar = var; free (ww); return 0; }
void copyarr2D(double **a, double **b, int nrows, int ncols) { int x ; for (x=0; x < nrows; ++x) { copyarr(a[x], b[x], ncols) ; } }
double wynn(double *v, int n, double *acc, int *nacc) { double *x0, *x1, *xn ; double t, amax, amin ; int iter = 0, j, nn ; vmaxmin(v, n, &amax, &amin) ; if (amax<=amin) { vclear(acc, amax, n/2) ; *nacc = n/2 ; return amax ; } ZALLOC(x0, n, double) ; ZALLOC(x1, n, double) ; ZALLOC(xn, n, double) ; copyarr(v, x1, n) ; nn = n ; for (;;) { for (j=0; (j+1) < nn ; ++j) { t = x0[j+1] + 1.0/(x1[j+1]-x1[j]) ; xn[j] = t ; } --nn ; if (nn<2) break ; copyarr(x1, x0, n) ; copyarr(xn, x1, n) ; for (j=0; (j+1) < nn ; ++j) { t = x0[j+1] + 1.0/(x1[j+1]-x1[j]) ; xn[j] = t ; } --nn ; if (nn<2) break ; copyarr(x1, x0, n) ; copyarr(xn, x1, n) ; acc[iter] = t ; ++iter ; } free(x0) ; free(x1) ; free(xn) ; *nacc = iter ; return t ; }
int solvitfix (double *prod, double *rhs, int n, double *ans, int *vfix, double *vvals, int nfix) // force variables in vfix list to vvals) { //The coefficient matrix should be positive definite /*AT : changed this code to take in matrix in a linear array form */ double *ttt; double *b; double *p; int i, k, t ; int ret ; ZALLOC (ttt, n*n, double); ZALLOC (p, n, double); ZALLOC(b,n,double); copyarr(prod,ttt,n*n); copyarr(rhs,b,n); for (k=0; k<nfix; ++k) { vzclear(ttt, b, n, vfix[k], vvals[k]) ; } ret = choldc (ttt, n, p); if (ret<0) return -1 ; // not pos def cholsl (ttt, n, p, b, ans); for (k=0; k<nfix; ++k) { t = vfix[k] ; printf("zz solvitfix:%d %d %12.6f %12.6f\n", n, t, vvals[k], ans[t]) ; } free (ttt) ; free(b); free (p) ; return 1 ; }
double pdinv(double *cinv, double *coeff, int n) // cinv and coeff can be same // cinv can be NULL // return log det (coeff) { double *tt; double *p ; double t, sum, y ; int i,j, k ; /** pmat(coeff, n) ; */ ZALLOC (tt, n*n, double); ZALLOC (p, n, double ); copyarr(coeff,tt,n*n); choldc (tt, n, p) ; for (i=0; i<n; i++) { tt[i*n+i] = 1.0/p[i] ; for (j=i+1; j<n; j++) { sum=0.0 ; for (k=i; k<j; k++) { sum -= tt[j*n+k]*tt[k*n+i] ; } tt[j*n+i] = sum/p[j] ; } } for (i=0; i<n; i++) for (j=i; j<n; j++) { sum=0.0 ; if (cinv == NULL) break ; for (k=j; k<n; k++) { sum += tt[k*n+j]*tt[k*n+i] ; } cinv[i*n+j] = cinv[j*n+i] = sum ; } vlog(p, p, n) ; y = 2.0*asum(p, n) ; free(tt) ; free(p) ; return y ; }
void revarr(double *b,double *a,int n) { int i ; double *x ; ZALLOC(x, n, double) ; for (i=0; i<n; i++) { x[n-i-1] = a[i] ; } copyarr(x, b, n) ; free(x) ; }
void vcompl(double *a, double *b, int n) // a <- 1 - b { double *x ; ZALLOC(x, n, double) ; vvm(x, x, b, n) ; vsp(x, x, 1.0, n) ; copyarr(x, a, n) ; free(x) ; }
int linsolv(int n, double *pfMatr, double *pfVect, double *sol) // 1 on failure { int ret ; double *a, *rhs ; ZALLOC(a, n*n, double) ; ZALLOC(rhs, n, double) ; copyarr(pfMatr, a, n*n) ; copyarr(pfVect, rhs, n) ; ret = linsolvx(n, a, rhs, sol) ; free(a) ; free(rhs) ; return ret ; }
void fliparr(double *a, double *b, int n) { double *x ; int k ; ZALLOC(x, n, double) ; for (k=0; k<n; ++k) { x[n-1-k] = b[k] ; } copyarr(x, a, n) ; free(x) ; }
void pdinv(double *cinv, double *coeff, int n) { double *tt; double *p ; double t, sum ; int i,j, k ; /** pmat(coeff, n) ; */ ZALLOC (tt, n*n, double); ZALLOC (p, n, double ); copyarr(coeff,tt,n*n); choldc (tt, n, p) ; for (i=0; i<n; i++) { tt[i*n+i] = 1.0/p[i] ; for (j=i+1; j<n; j++) { sum=0.0 ; for (k=i; k<j; k++) { sum -= tt[j*n+k]*tt[k*n+i] ; } tt[j*n+i] = sum/p[j] ; } } for (i=0; i<n; i++) for (j=i; j<n; j++) { sum=0.0 ; for (k=j; k<n; k++) { sum += tt[k*n+j]*tt[k*n+i] ; } cinv[i*n+j] = cinv[j*n+i] = sum ; } free(tt) ; free(p) ; }
void mulmat(double *a, double *b, double *c, int a1, int a2, int a3) /* b is a1 x a2 , c a2 x a3 so a is a1 x a3 */ { double *t ; int i,j,k ; ZALLOC(t, a1*a3, double) ; for (i=0; i<a1; i++) for (j=0; j<a3; j++) for (k=0; k<a2; k++) t[i*a3+j] += b[i*a2+k]*c[k*a3+j] ; copyarr(t, a, a1*a3) ; free (t) ; }
int pmult(double *a, double *b, double *c, int nb, int nc) // polynomial multiplication { double *ww ; int i, j ; ZALLOC(ww, nb+nc+1, double) ; for (i=0; i<=nb; ++i) { for (j=0; j<=nc; ++j) { ww[i+j] += b[i]*c[j] ; } } copyarr(ww, a, nb+nc+1) ; free(ww) ; return nb+nc ; }
double chitest(double *a, double *p, int n) /* a is n boxes. Goodness of fit test to p */ { double *x, *b, *pp ; double y1=0.0, y2=0.0 ; int i ; ZALLOC(pp, n, double) ; if (p != NULL) copyarr(p,pp,n) ; else vclear(pp, 1.0, n) ; y1 = asum(pp,n) ; y2 = asum(a,n) ; if ( (y1==0.0) || (y2==0.0) ) { free(pp) ; return 0.0 ; } ZALLOC(x,n,double) ; ZALLOC(b,n,double) ; vst (x, pp, y2/y1, n) ; /* expected */ vsp (x, x, .0001, n) ; vvm (b, a, x, n) ; vvt (b, b, b, n) ; vvd (b, b, x, n) ; y1 = asum(b,n) ; free(x) ; free(b) ; return y1 ; }
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 ; }
void sortit(double *a, int *ind, int len) { int i,k ; int *inda ; if (len==0) fatalx("(sortit) len = 0\n") ; ZALLOC(ttt, len, double) ; ZALLOC(inda, len, int) ; for (i=0; i<len; i++) { inda[i] = i ; } copyarr(a,ttt,len) ; qsort((int *) inda, len, sizeof(int), (int (*) (const void *, const void *)) compit); for (i=0; i<len; i++) { k = inda[i] ; a[i] = ttt[k] ; } free (ttt) ; if (ind != NULL) copyiarr(inda, ind, len) ; free(inda) ; }
void ranmultinom(int *samp, int n, double *p, int len) // multinomial sample p is prob dist n samples returned // work is O(len^2) which is silly { int x ; double *pp ; if (len==0) return ; ivzero(samp, len) ; if (n<=0) return ; if (len==1) { samp[0] = n ; return ; } ZALLOC(pp, len, double) ; copyarr(p, pp, len) ; bal1(pp, len) ; samp[0] = x = ranbinom(n, pp[0]) ; ranmultinom(samp+1, n-x, p+1, len-1) ; free(pp) ; }
void dnTakeSnapshot( snapshot_t *snapshot ) { copyval( numwalls ); copyarr( wall ); copyval( numsectors ); copyarr( sector ); copyarr( sprite ); copyarr( spriteext ); copyarr( headspritesect ); copyarr( prevspritesect ); copyarr( nextspritesect ); copyarr( headspritestat ); copyarr( prevspritestat ); copyarr( nextspritestat ); copyval( numcyclers ); copyarr( cyclers ); copyarr( ps ); copyarr( po ); copyval( numanimwalls ); copyarr( animwall ); copyarr( msx ); copyarr( msy ); copyval( spriteqloc ); copyval( spriteqamount ); copyarr( spriteq ); copyval( mirrorcnt ); copyarr( mirrorwall ); copyarr( mirrorsector ); /* char show2dsector[(MAXSECTORS+7)>>3]; */ copyarr( actortype ); copyval( numclouds ); copyarr( clouds ); copyarr( cloudx ); copyarr( cloudy ); #if WITH_SCRIPTS for (int i = 0; i < MAXSCRIPTSIZE; i++ ) { if ( (long)script[i] >= (long)(&script[0]) && (long)script[i] < (long)(&script[MAXSCRIPTSIZE]) ) { snapshot->scriptptrs[i] = 1; snapshot->script[i] = (long)script[i] - (long)&script[0]; } else { snapshot->scriptptrs[i] = 0; snapshot->script[i] = 0xFFFFFFFF; } } for( int i = 0; i < MAXTILES-VIRTUALTILES; i++ ) { if ( actorscrptr[i] ) { snapshot->actorscrptr[i] = (long)actorscrptr[i]-(long)&script[0]; } else { snapshot->actorscrptr[i] = 0; } } #endif #if WITH_HITTYPE for( int i = 0; i < MAXSPRITES; i++ ) { weaponhit wh = { 0 }; snapshot->hittypeflags[i] = 0; memcpy( &wh, &hittype[i], sizeof( weaponhit ) ); if ( actorscrptr[ sprite[i].picnum ] != 0 ) { unsigned int begin = (unsigned int)&script[0]; unsigned int end = (unsigned int)&script[MAXSCRIPTSIZE]; if ( hittype[i].temp_data[1] >= begin && hittype[i].temp_data[1] < end ) { snapshot->hittypeflags[i] |= 1; wh.temp_data[1] = hittype[i].temp_data[1] - begin; } if ( hittype[i].temp_data[4] >= begin && hittype[i].temp_data[4] < end ) { snapshot->hittypeflags[i] |= 2; wh.temp_data[4] = hittype[i].temp_data[4] - begin; } if ( hittype[i].temp_data[5] >= begin && hittype[i].temp_data[5] < end ) { snapshot->hittypeflags[i] |= 4; wh.temp_data[5] = hittype[i].temp_data[5] - begin; } } memcpy( &snapshot->hittype[i], &wh, sizeof( weaponhit ) ); } #endif copyval( lockclock ); copyval( pskybits ); copyarr( pskyoff ); copyval( animatecnt ); copyarr( animatesect ); copyoffs( animateptr, §or[0] ); copyarr( animategoal ); copyarr( animatevel ); copyval( earthquaketime ); copyudval( from_bonus ); copyudval( secretlevel ); copyudval_m( respawn_monsters ); copyudval_m( respawn_items ); copyudval_m( respawn_inventory ); copyudval_m( monsters_off ); copyudval_m( coop ); copyudval_m( marker ); copyudval_m( ffire ); copyval( numplayersprites ); copyarr( frags ); copyval( randomseed ); copyval( global_random ); copyval( parallaxyscale ); memset( &snapshot->padding[0], 0, sizeof( snapshot->padding ) ); }
double dottest(char *sss, double *vec, char **eglist, int numeg, int *xtypes, int len) // vec will always have mean 0 // perhaps should rewrite to put xa1 etc in arrays { double *w1 ; int *xt ; int i, k1, k2, k, n, x1, x2 ; double ylike ; double ychi ; double *wmean ; int imax, imin, *isort ; static int ncall = 0 ; char ss1[MAXSTR] ; char ss2[MAXSTR] ; double ans, ftail, ftailx, ansx ; ZALLOC(wmean, numeg, double) ; ZALLOC(w1, len + numeg, double) ; ZALLOC(isort, numeg, int) ; ZALLOC(xt, len, int) ; strcpy(ss1, "") ; calcmean(wmean, vec, len, xtypes, numeg) ; if (pubmean) { copyarr(wmean, w1, numeg) ; sortit(w1, isort, numeg) ; printf("%s:means\n", sss) ; for (i=0; i<numeg; i++) { k = isort[i] ; printf("%20s ", eglist[k]) ; printf(" %9.3f\n", wmean[k]) ; } } vlmaxmin(wmean, numeg, &imax, &imin) ; if (chisqmode) { ylike = anova1(vec, len, xtypes, numeg) ; ans = 2.0*ylike ; } else { ans = ftail = anova(vec, len, xtypes, numeg) ; } ++ncall ; if (numeg>2) { sprintf(ss2, "%s %s ", sss, "overall") ; publishit(ss2, numeg-1, ans) ; printf(" %20s minv: %9.3f %20s maxv: %9.3f\n", eglist[imin], wmean[imin], eglist[imax], wmean[imax]) ; } for (k1 = 0; k1<numeg; ++k1) { for (k2 = k1+1; k2<numeg; ++k2) { n = 0 ; x1 = x2 = 0 ; for (i=0; i<len ; i++) { k = xtypes[i] ; if (k == k1) { w1[n] = vec[i] ; xt[n] = 0 ; ++n ; ++x1 ; } if (k == k2) { w1[n] = vec[i] ; xt[n] = 1 ; ++n ; ++x2 ; } } if (x1 <= 1) continue ; if (x2 <= 1) continue ; ylike = anova1(w1, n, xt, 2) ; ychi = 2.0*ylike ; chitot[k1*numeg + k2] += ychi ; if (chisqmode) { ansx = ychi ; } else { ansx = ftailx = anova(w1, n, xt, 2) ; } sprintf(ss2,"%s %s %s ", sss, eglist[k1], eglist[k2]) ; publishit(ss2, 1, ansx) ; } } free(w1) ; free(xt) ; free(wmean) ; free(isort) ; return ans ; }
int main(int argc, char **argv) { char **eglist ; int numeg ; int i, j, k, pos; int *vv ; SNP *cupt, *cupt2 ; Indiv *indx ; double y1, y2, y ; int n0, n1, nkill ; int nindiv = 0 ; int nignore, numrisks = 1 ; SNP **xsnplist ; Indiv **xindlist ; int *xindex ; int nrows, ncols, m ; double *XTX, *cc, *evecs, *ww ; double *lambda ; double *tvecs ; int weightmode = NO ; int t ; double *xmean, *xfancy ; double *ldmat = NULL, *ldmat2 = NULL; double *ldvv = NULL, *ldvv2 = NULL, *vv2 = NULL ; int chrom, numclear ; double gdis ; int outliter, numoutiter, *badlist, nbad ; int a, b, n ; FILE *outlfile ; int xblock, blocksize=10000 ; double *tblock ; OUTLINFO *outpt ; int *idperm, *vecind ; // for sort readcommands(argc, argv) ; printf("## smartrel version: %s\n", WVERSION) ; packmode = YES ; setomode(&outputmode, omode) ; if (parname == NULL) return 0 ; if (xchrom == (numchrom+1)) noxdata = NO ; if (fstonly) { printf("fstonly\n") ; numeigs = 0 ; numoutliter = 0 ; numoutiter = 0 ; outputname = NULL ; snpeigname = NULL ; } if (fancynorm) printf("norm used\n\n") ; else printf("no norm used\n\n") ; nostatslim = MAX(nostatslim, 3) ; outlfile = ofile = stdout; if (outputname != NULL) openit(outputname, &ofile, "w") ; if (outliername != NULL) openit(outliername, &outlfile, "w") ; if (fstdetailsname != NULL) openit(fstdetailsname, &fstdetails, "w") ; numsnps = getsnps(snpname, &snpmarkers, 0.0, badsnpname, &nignore, numrisks) ; numindivs = getindivs(indivname, &indivmarkers) ; k = getgenos(genotypename, snpmarkers, indivmarkers, numsnps, numindivs, nignore) ; if (poplistname != NULL) { ZALLOC(eglist, numindivs, char *) ; numeg = loadlist(eglist, poplistname) ; seteglist(indivmarkers, numindivs, poplistname); } else { setstatus(indivmarkers, numindivs, NULL) ; ZALLOC(eglist, MAXPOPS, char *) ; numeg = makeeglist(eglist, MAXPOPS, indivmarkers, numindivs) ; } for (i=0; i<numeg; i++) { /* printf("%3d %s\n",i, eglist[i]) ; */ } nindiv=0 ; for (i=0; i<numindivs; i++) { indx = indivmarkers[i] ; if(indx -> affstatus == YES) ++nindiv ; } for (i=0; i<numsnps; i++) { cupt = snpmarkers[i] ; chrom = cupt -> chrom ; if ((noxdata) && (chrom == (numchrom+1))) cupt-> ignore = YES ; if (chrom == 0) cupt -> ignore = YES ; if (chrom > (numchrom+1)) cupt -> ignore = YES ; } for (i=0; i<numsnps; i++) { cupt = snpmarkers[i] ; pos = nnint(cupt -> physpos) ; if ((xchrom>0) && (cupt -> chrom != xchrom)) cupt -> ignore = YES ; if ((xchrom > 0) && (pos < lopos)) cupt -> ignore = YES ; if ((xchrom > 0) && (pos > hipos)) cupt -> ignore = YES ; if (cupt -> ignore) continue ; if (numvalidgtx(indivmarkers, cupt, YES) <= 1) { printf("nodata: %20s\n", cupt -> ID) ; cupt -> ignore = YES ; } } if (killr2) { nkill = killhir2(snpmarkers, numsnps, numindivs, r2physlim, r2genlim, r2thresh) ; if (nkill>0) printf("killhir2. number of snps killed: %d\n", nkill) ; } ZALLOC(vv, numindivs, int) ; numvalidgtallind(vv, snpmarkers, numsnps, numindivs) ; for (i=0; i<numindivs; ++i) { if (vv[i] == 0) { indx = indivmarkers[i] ; indx -> ignore = YES ; } } free(vv) ; numsnps = rmsnps(snpmarkers, numsnps, NULL) ; // rid ignorable snps if (missingmode) { setmiss(snpmarkers, numsnps) ; fancynorm = NO ; } if (weightname != NULL) { weightmode = YES ; getweights(weightname, snpmarkers, numsnps) ; } if (ldregress>0) { ZALLOC(ldvv, ldregress*numindivs, double) ; ZALLOC(ldvv2, ldregress*numindivs, double) ; ZALLOC(vv2, numindivs, double) ; ZALLOC(ldmat, ldregress*ldregress, double) ; ZALLOC(ldmat2, ldregress*ldregress, double) ; setidmat(ldmat, ldregress) ; vst(ldmat, ldmat, 1.0e-6, ldregress*ldregress) ; } ZALLOC(xindex, numindivs, int) ; ZALLOC(xindlist, numindivs, Indiv *) ; ZALLOC(xsnplist, numsnps, SNP *) ; if (popsizelimit > 0) { setplimit(indivmarkers, numindivs, eglist, numeg, popsizelimit) ; } nrows = loadindx(xindlist, xindex, indivmarkers, numindivs) ; ncols = loadsnpx(xsnplist, snpmarkers, numsnps, indivmarkers) ; printf("number of samples used: %d number of snps used: %d\n", nrows, ncols) ; /** cupt = xsnplist[0] ; for (j=0; j<nrows; ++j) { k = xindex[j] ; g = getgtypes(cupt, k) ; indx = indivmarkers[k] ; t = indxindex(eglist, numeg, indx -> egroup) ; printf("yy1 %20s %20s %20s %d %d %d\n", cupt ->ID, indx -> ID, indx -> egroup, j, k, g) ; } printf("yya: ") ; printimat(xindex, 1, nrows) ; printf("zzindxa: %s\n", indivmarkers[230] -> egroup) ; */ /* printf("## nrows: %d ncols %d\n", nrows, ncols) ; */ ZALLOC(xmean, ncols, double) ; ZALLOC(xfancy, ncols, double) ; ZALLOC(XTX, nrows*nrows, double) ; ZALLOC(evecs, nrows*nrows, double) ; ZALLOC(tvecs, nrows*nrows, double) ; ZALLOC(lambda, nrows, double) ; ZALLOC(cc, nrows, double) ; ZALLOC(ww, nrows, double) ; ZALLOC(badlist, nrows, int) ; blocksize = MIN(blocksize, ncols) ; ZALLOC(tblock, nrows*blocksize, double) ; // xfancy is multiplier for column xmean is mean to take off // badlist is list of rows to delete (outlier removal) numoutiter = 1 ; if (numoutliter>=1) { numoutiter = numoutliter+1 ; ZALLOC(outinfo, nrows, OUTLINFO *) ; for (k=0; k<nrows; k++) { ZALLOC(outinfo[k], 1, OUTLINFO) ; } /* fprintf(outlfile, "##%18s %4s %6s %9s\n", "ID", "iter","eigvec", "score") ; */ } for (outliter = 1; outliter <= numoutiter ; ++outliter) { if (fstonly) { setidmat(XTX, nrows) ; vclear(lambda, 1.0, nrows) ; break ; } if (outliter>1) { ncols = loadsnpx(xsnplist, snpmarkers, numsnps, indivmarkers) ; } vzero(XTX, nrows*nrows) ; vzero(tblock, nrows*blocksize) ; xblock = 0 ; vzero(xmean, ncols) ; vclear(xfancy, 1.0, ncols) ; for (i=0; i<ncols; i++) { cupt = xsnplist[i] ; chrom = cupt -> chrom ; getcolxz(cc, cupt, xindex, nrows, i, xmean, xfancy, &n0, &n1) ; t = MIN(n0, n1) ; if (t <= minallelecnt) { cupt -> ignore = YES ; vzero(cc, nrows) ; } if (weightmode) { vst(cc, cc, xsnplist[i] -> weight, nrows) ; } if (ldregress>0) { numclear = 0 ; for (k=1; k<= ldregress; ++k) { j = i-k ; if (j<0) { numclear = ldregress-k+1 ; break ; } cupt2 = xsnplist[j] ; if (cupt2 -> chrom != chrom) gdis = ldlimit + 1.0 ; else gdis = cupt -> genpos - cupt2 -> genpos ; if (gdis>=ldlimit) { numclear = ldregress-k+1 ; break ; } } if (numclear>0) clearld(ldmat, ldvv, ldregress, nrows, numclear) ; ldreg(ldmat, ldmat2, cc, vv2, ldvv, ldvv2, ldregress, nrows) ; copyarr(ldmat2, ldmat, ldregress*ldregress) ; copyarr(vv2, cc, nrows) ; copyarr(ldvv2, ldvv, ldregress*nrows) ; } copyarr(cc, tblock+xblock*nrows, nrows) ; ++xblock ; /** this is the key code to parallelize */ if (xblock==blocksize) { domult(tvecs, tblock, xblock, nrows) ; vvp(XTX, XTX, tvecs, nrows*nrows) ; xblock = 0 ; vzero(tblock, nrows*blocksize) ; } } if (xblock>0) { domult(tvecs, tblock, xblock, nrows) ; vvp(XTX, XTX, tvecs, nrows*nrows) ; } symit(XTX, nrows) ; /** a = 0; b=0 ; printf("zz1 %12.6f ", XTX[a*nrows+b]) ; a = nrows-1; b=nrows-1 ; printf(" %12.6f %15.9g\n", XTX[a*nrows+b], asum(XTX, nrows*nrows)) ; */ if (verbose) { printdiag(XTX, nrows) ; } y = trace(XTX, nrows) / (double) (nrows-1) ; if (isnan(y)) fatalx("bad XTX matrix\n") ; /* printf("trace: %9.3f\n", y) ; */ if (y<=0.0) fatalx("XTX has zero trace (perhaps no data)\n") ; vst(XTX, XTX, 1.0/y, nrows * nrows) ; /// mean eigenvalue is 1 eigvecs(XTX, lambda, evecs, nrows) ; // eigenvalues are in decreasing order if (outliter > numoutliter) break ; // last pass skips outliers numoutleigs = MIN(numoutleigs, nrows-1) ; nbad = ridoutlier(evecs, nrows, numoutleigs, outlthresh, badlist, outinfo) ; if (nbad == 0) break ; for (i=0; i<nbad; i++) { j = badlist[i] ; indx = xindlist[j] ; outpt = outinfo[j] ; fprintf(outlfile, "REMOVED outlier %s iter %d evec %d sigmage %.3f\n", indx -> ID, outliter, outpt -> vecno, outpt -> score) ; indx -> ignore = YES ; } nrows = loadindx(xindlist, xindex, indivmarkers, numindivs) ; printf("number of samples after outlier removal: %d\n", nrows) ; } if (outliername != NULL) fclose(outlfile) ; m = numgtz(lambda, nrows) ; /* printf("matrix rank: %d\n", m) ; */ if (m==0) fatalx("no data\n") ; /** smartrel code */ for (i=0; i<numeigs; i++) { y = sqrt(lambda[i]) ; vst(ww, evecs+i*nrows, y, nrows) ; subouter(XTX, ww, nrows) ; } free(tvecs) ; n = 0 ; ZALLOC(vecind, nrows*nrows/2, int) ; for (i=0; i<nrows; i++) { for (j=i+1; j<nrows; j++) { k = i*nrows + j ; y1 = XTX[i*nrows+i] ; y2 = XTX[j*nrows+j] ; y = XTX[k]/sqrt(y1*y2) ; y += 1/(double)(nrows-1); if (y<relthresh) continue ; vecind[n] = k ; evecs[n] = -y ; ++n ; } } free(XTX) ; if (n==0) { printf("## nothing above relthresh!\n") ; printf("##end of smartrel run\n") ; return 0 ; } ZALLOC(idperm, n, int) ; sortit(evecs, idperm, n) ; for (i=0; i<n; i++) { j = idperm[i] ; k = vecind[j] ; a = k/nrows ; b = k%nrows ; printf("rel: %20s ", xindlist[a] ->ID) ; printf("%20s ", xindlist[b] ->ID) ; printf(" %9.3f", -evecs[i]) ; printnl() ; } printf("##end of smartrel run\n") ; return 0 ; }
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; }
void dnRestoreSnapshot( const snapshot_t *snapshot ) { copyval( numwalls ); copyarr( wall ); copyval( numsectors ); copyarr( sector ); copyarr( sprite ); copyarr( spriteext ); copyarr( headspritesect ); copyarr( prevspritesect ); copyarr( nextspritesect ); copyarr( headspritestat ); copyarr( prevspritestat ); copyarr( nextspritestat ); copyval( numcyclers ); copyarr( cyclers ); char *palette[MAXPLAYERS]; char gm[MAXPLAYERS]; for ( int i = 0; i < MAXPLAYERS; i++ ) { palette[i] = ps[i].palette; gm[i] = ps[i].gm; } copyarr( ps ); for ( int i = 0; i < MAXPLAYERS; i++ ) { ps[i].palette = palette[i]; ps[i].gm = gm[i]; } copyarr( po ); copyval( numanimwalls ); copyarr( animwall ); copyarr( msx ); copyarr( msy ); copyval( spriteqloc ); copyval( spriteqamount ); copyarr( spriteq ); copyval( mirrorcnt ); /* char show2dsector[(MAXSECTORS+7)>>3]; */ copyarr( mirrorwall ); copyarr( mirrorsector ); copyarr( actortype ); copyval( numclouds ); copyarr( clouds ); copyarr( cloudx ); copyarr( cloudy ); #if WITH_SCRIPTS for ( int i = 0; i < MAXSCRIPTSIZE; i++ ) { if ( snapshot->scriptptrs[i] ) { script[i] = (long)&script[0] + snapshot->script[i]; } } for( int i = 0; i < MAXTILES-VIRTUALTILES; i++ ) { if ( snapshot->actorscrptr[i] ) { actorscrptr[i] = (long*)( (long)(&script[0]) + snapshot->actorscrptr[i] ); } else { actorscrptr[i] = 0; } } #endif #if WITH_HITTYPE copyarr( hittype ); for ( int i = 0; i < MAXSPRITES; i++ ) { unsigned char flags = snapshot->hittypeflags[i]; long j = (long)&script[0]; if ( flags & 1 ) { T2 += j; } if ( flags & 2 ) { T5 += j; } if ( flags & 4 ) { T6 += j; } } #endif copyval( lockclock ); copyval( pskybits ); copyarr( pskyoff ); copyval( animatecnt ); copyarr( animatesect ); copyoffs( animateptr, §or[0] ); /* !!! */ copyarr( animategoal ); copyarr( animatevel ); copyval( earthquaketime ); copyudval( from_bonus ); copyudval( secretlevel ); copyudval_m( respawn_monsters ); copyudval_m( respawn_items ); copyudval_m( respawn_inventory ); copyudval_m( monsters_off ); copyudval_m( coop ); copyudval_m( marker ); copyudval_m( ffire ); copyval( numplayersprites ); copyarr( frags ); copyval( randomseed ); copyval( global_random ); copyval( parallaxyscale ); }