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 );
}
