int GlmTest::resampSmryCase(glm *model, gsl_matrix *bT, GrpMat *GrpXs, gsl_matrix *bO, unsigned int i ) { gsl_set_error_handler_off(); int status, isValid=TRUE; unsigned int j, k, id; gsl_vector_view yj, oj, xj; gsl_matrix *tXX = NULL; unsigned int nRows=tm->nRows, nParam=tm->nParam; if (bootID == NULL) { tXX = gsl_matrix_alloc(nParam, nParam); while (isValid==TRUE) { // if all isSingular==TRUE if (tm->reprand!=TRUE) GetRNGstate(); for (j=0; j<nRows; j++) { // resample Y, X, offsets accordingly if (tm->reprand==TRUE) id = (unsigned int) gsl_rng_uniform_int(rnd, nRows); else id = (unsigned int) nRows * Rf_runif(0, 1); xj = gsl_matrix_row(model->Xref, id); gsl_matrix_set_row(GrpXs[0].matrix, j, &xj.vector); yj = gsl_matrix_row(model->Yref, id); gsl_matrix_set_row(bT, j, &yj.vector); oj = gsl_matrix_row(model->Eta, id); gsl_matrix_set_row(bO, j, &oj.vector); } if (tm->reprand!=TRUE) PutRNGstate(); gsl_matrix_set_identity(tXX); gsl_blas_dsyrk(CblasLower,CblasTrans,1.0,GrpXs[0].matrix,0.0,tXX); status=gsl_linalg_cholesky_decomp(tXX); if (status!=GSL_EDOM) break; // if (calcDet(tXX)>eps) break; } for (k=2; k<nParam+2; k++) subX2(GrpXs[0].matrix, k-2, GrpXs[k].matrix); } else { for (j=0; j<nRows; j++) { id = (unsigned int) gsl_matrix_get(bootID, i, j); // resample Y and X and offset yj=gsl_matrix_row(model->Yref, id); gsl_matrix_set_row (bT, j, &yj.vector); oj = gsl_matrix_row(model->Eta, id); gsl_matrix_set_row(bO, j, &oj.vector); xj = gsl_matrix_row(model->Xref, id); gsl_matrix_set_row(GrpXs[0].matrix, j, &xj.vector); } for (k=2; k<nParam+2; k++) subX2(GrpXs[0].matrix, k-2, GrpXs[k].matrix); } gsl_matrix_free(tXX); return SUCCESS; }
//int GlmTest::resampAnovaCase(glm *model, gsl_matrix *Onull, gsl_matrix *bT, gsl_matrix *bX, gsl_matrix *bO, gsl_matrix *bOnull, unsigned int i) int GlmTest::resampAnovaCase(glm *model, gsl_matrix *bT, gsl_matrix *bX, gsl_matrix *bO, unsigned int i) { gsl_set_error_handler_off(); int status, isValid=TRUE; unsigned int j, id, nP; gsl_vector_view yj, xj, oj; nP = model->Xref->size2; gsl_matrix *tXX = gsl_matrix_alloc(nP, nP); unsigned int nRows=tm->nRows; if (bootID == NULL) { while (isValid==TRUE) { if (tm->reprand!=TRUE) GetRNGstate(); for (j=0; j<nRows; j++) { if (tm->reprand==TRUE) id=(unsigned int)gsl_rng_uniform_int(rnd, nRows); else id=(unsigned int) nRows*Rf_runif(0, 1); // resample Y and X and offset yj=gsl_matrix_row(model->Yref, id); xj = gsl_matrix_row(model->Xref, id); oj = gsl_matrix_row(model->Eta, id); gsl_matrix_set_row (bT, j, &yj.vector); gsl_matrix_set_row(bX, j, &xj.vector); gsl_matrix_set_row(bO, j, &oj.vector); } if (tm->reprand!=TRUE) PutRNGstate(); gsl_matrix_set_identity(tXX); gsl_blas_dsyrk(CblasLower,CblasTrans,1.0,bX,0.0,tXX); status=gsl_linalg_cholesky_decomp(tXX); if (status!=GSL_EDOM) break; } } else { for (j=0; j<nRows; j++) { id = (unsigned int) gsl_matrix_get(bootID, i, j); // resample Y and X and offset yj=gsl_matrix_row(model->Yref, id); xj = gsl_matrix_row(model->Xref, id); oj = gsl_matrix_row(model->Oref, id); gsl_matrix_set_row (bT, j, &yj.vector); gsl_matrix_set_row(bX, j, &xj.vector); gsl_matrix_set_row(bO, j, &oj.vector); } } gsl_matrix_free(tXX); return SUCCESS; }
int GlmTest::resampNonCase(glm *model, gsl_matrix *bT, unsigned int i) { unsigned int j, k, id; double bt, score, yij, mij; gsl_vector_view yj; unsigned int nRows=tm->nRows, nVars=tm->nVars; // note that residuals have got means subtracted switch (tm->resamp) { case RESIBOOT: if (tm->reprand!=TRUE) GetRNGstate(); for (j=0; j<nRows; j++) { if (bootID!=NULL) id = (unsigned int) gsl_matrix_get(bootID, i, j); else if (tm->reprand==TRUE) id = (unsigned int) gsl_rng_uniform_int(rnd, nRows); else id = (unsigned int) nRows * Rf_runif(0, 1); // bY = mu+(bootr*sqrt(variance)) for (k=0; k<nVars; k++) { bt=gsl_matrix_get(model->Mu,j,k)+sqrt(gsl_matrix_get(model->Var,j,k))*gsl_matrix_get(model->Res, id, k); bt = MAX(bt, 0.0); bt = MIN(bt, model->maxtol); gsl_matrix_set(bT, j, k, bt); } } if (tm->reprand!=TRUE) PutRNGstate(); break; case SCOREBOOT: for (j=0; j<nRows; j++) { if (bootID!=NULL) score = (double) gsl_matrix_get(bootID, i, j); else if (tm->reprand==TRUE) score = gsl_ran_ugaussian (rnd); else score = Rf_rnorm(0.0, 1.0); // bY = mu + score*sqrt(variance) for (k=0; k<nVars; k++){ bt=gsl_matrix_get(model->Mu, j, k)+sqrt(gsl_matrix_get(model->Var, j, k))*gsl_matrix_get(model->Res, j, k)*score; bt = MAX(bt, 0.0); bt = MIN(bt, model->maxtol); gsl_matrix_set(bT, j, k, bt); } } break; case PERMUTE: if (bootID==NULL) gsl_ran_shuffle(rnd,permid,nRows,sizeof(unsigned int)); for (j=0; j<nRows; j++) { if (bootID==NULL) id = permid[j]; else id = (unsigned int) gsl_matrix_get(bootID, i, j); // bY = mu + bootr * sqrt(var) for (k=0; k<nVars; k++) { bt=gsl_matrix_get(model->Mu,j,k)+sqrt(gsl_matrix_get(model->Var,j,k))*gsl_matrix_get(model->Res, id, k); bt = MAX(bt, 0.0); bt = MIN(bt, model->maxtol); gsl_matrix_set(bT, j, k, bt); } } break; case FREEPERM: if (bootID==NULL) gsl_ran_shuffle(rnd,permid,nRows,sizeof(unsigned int)); for (j=0; j<nRows; j++) { if (bootID==NULL) id = permid[j]; else id = (unsigned int) gsl_matrix_get(bootID, i, j); yj=gsl_matrix_row(model->Yref, id); gsl_matrix_set_row (bT, j, &yj.vector); } break; case MONTECARLO: McSample(model, rnd, XBeta, Sigma, bT); break; case PITSBOOT: if (tm->reprand!=TRUE) GetRNGstate(); for (j=0; j<nRows; j++) { if (bootID!=NULL) id = (unsigned int) gsl_matrix_get(bootID, i, j); else if (tm->reprand==TRUE) id = (unsigned int) gsl_rng_uniform_int(rnd, nRows); else id = (unsigned int) Rf_runif(0, nRows); for (k=0; k<nVars; k++) { bt = gsl_matrix_get(model->PitRes, id, k); mij = gsl_matrix_get(model->Mu, j, k); yij = model->cdfinv(bt, mij, model->theta[k]); gsl_matrix_set(bT, j, k, yij); } } if (tm->reprand!=TRUE) PutRNGstate(); break; default: GSL_ERROR("The resampling method is not supported", GSL_ERANGE); break; } return SUCCESS; }
Type runif(Type a, Type b) { return Rf_runif(asDouble(a), asDouble(b)); }
int MCMCPkPg::sampleTheta( PkPgModel& model, PkPgResult& Result ){ //int i, v, j; double fx0, fx1, ratio, u; mat proplogTheta( model.N, model.V ); // Proposal for Theta. In matrix with vision of parallelizing in the future mat propTheta( model.N, model.V ); // Loop subjects --------------------------------------------------- for( size_t i = 0; i < model.N; i++ ){ // current posterior log likelihood colvec CurrentlogTheta = Result.logTheta.row( i ).t(); fx0 = f_theta( CurrentlogTheta, Result.mTheta.row( i ).t(), Result.Otheta, 1.0, //Result.Tau( i ), model.Y.slice( i ), Result.Fit.slice( i ), Result.Sigma.row( i ) , log(Result.EHRTime(i,0))); // propoal ----------- start ----------- colvec theta_bar_i = Result.logTheta_bar.row( i ).t(); mat sigma_theta_i = Result.Sigma_theta.slice( i ); //colvec ProplogThetaCenter = CurrentlogTheta + 2 * ( Result.logTheta_MLE.row(i).t() - CurrentlogTheta ); //colvec logtemp = MVNORM( 0, ProplogThetaCenter , sigma_theta_i ) ; // proposal colvec logtemp = MVNORM( 0, CurrentlogTheta , sigma_theta_i ) ; // proposal proplogTheta.row( i ) = logtemp.t(); //logtemp.print("logtemp"); propTheta.row( i ) = exp( proplogTheta.row( i ) ); rowvec tempPThetaRow(15); for( int j = 0; j< 10; j++)tempPThetaRow(j) = propTheta( i, j ); double proplogEHRTime = Rf_rnorm(log(Result.EHRTime(i,0)),0.1); double propEHRTime = exp( proplogEHRTime ); tempPThetaRow(10) = propEHRTime; //Result.EHRTime(i,0); for( int j = 10; j< 14; j++) tempPThetaRow(j+1) = propTheta( i, j ); rowvec param = tempPThetaRow; mat TempFit = fev( model.PkModel, model.env, model.K, model.T, param, i ); // update the likelihood if( TempFit.n_cols==model.K){ uvec idx = find( TempFit < 0.00001 ); TempFit.elem( idx ) = ones<vec>( idx.n_elem ) * 0.00001; // propoal ----------- end ----------- // proposed posterior log likelihood fx1 = f_theta( proplogTheta.row( i ).t(), Result.mTheta.row( i ).t(), Result.Otheta, 1.0, //Result.Tau(i), model.Y.slice( i ), TempFit, Result.Sigma.row( i ), proplogEHRTime ); // Accept or Reject ratio = fx1 - fx0; // M-H ratio u = Rf_runif( 0, 1 ); if( log( u ) < ratio ){ // for( v = 0; v < model.V; v++ ) { // Result.Theta( i, v ) = propTheta( i, v ); // Update theta_v // } acceptTheta(i,cIter)=1; Result.logTheta_old.row( i ) = Result.logTheta.row( i ); Result.logTheta.row( i ) = proplogTheta.row( i ); Result.Theta.row( i ) = propTheta.row( i ); Result.Fit.slice( i ) = TempFit; Result.EHRTime(i,0) = propEHRTime; } else { Result.logTheta_old.row( i ) = Result.logTheta.row( i ); Result.logTheta.row( i ) = Result.logTheta.row( i ); Result.Theta.row( i ) = Result.Theta.row( i ); Result.Fit.slice( i ) = Result.Fit.slice( i ); } } else{ acceptTheta(i,cIter)=-1; Result.logTheta_old.row( i ) = Result.logTheta.row( i ); Result.logTheta.row( i ) = Result.logTheta.row( i ); Result.Theta.row( i ) = Result.Theta.row( i ); Result.Fit.slice( i ) = Result.Fit.slice( i ); } } // end loop i return 0; }
MCMCStepSeq pass(MCMCStepSeq &step, HelperVariables &helpers, Params ¶ms) { int i, j, cp; int bsize1, bsize2, bsize3; double tmp; DoubleVec bmean1(params.kk, 0); DoubleVec bmean2(params.kk, 0); DoubleVec bmean3(params.kk, 0); double bZ1, bZ2, bZ3; IntVec bvals(2); DoubleVec Wvals(2); DoubleVec Bvals(2); DoubleVec bmeanlast(params.kk); double bZlast = 0; // this is used to reference the current block in the MCMCStep we came in with int prevblock = 0; // this is used to reference the current MCMCStep we build from scratch MCMCStepSeq stepnew(step); int currblock = 0; // some other variables to denote stuff in current block and previous block // Note that "last" refers to the immediately left-adjacent block // whereas "prev" refers to the same block in the variable step double thisblockZ = step.bZ[0]; int thisbend = step.bend[0]; double lastblockZ = 0; int lastbend = -1; // this is simply a notational convenience // start the loop for (i = 0; i < params.nn - 1; i++) { if (i == step.bend[prevblock]) { // we're at an old change point, so we need to refresh "this" to be the // immediately following block lastblockZ = thisblockZ; prevblock++; thisbend = step.bend[prevblock]; thisblockZ = step.bZ[prevblock]; } /**** * consider merging blocks if currently a change point */ bvals[0] = stepnew.b; if (step.rho[i] == 0) { // not a change point at the moment Bvals[0] = stepnew.B; Wvals[0] = stepnew.W; } else { // it is a change point, so let's try removing the change point bvals[0]--; tmp = thisblockZ + lastblockZ; bZ3 = 0; if (lastbend > -1) { bsize3 = helpers.cumksize[thisbend] - helpers.cumksize[lastbend]; for (j = 0; j < params.kk; j++) { bmean3[j] = (helpers.cumymat[j][thisbend] - helpers.cumymat[j][lastbend]) / bsize3; bZ3 += pow(bmean3[j], 2) * bsize3; } } else { bsize3 = helpers.cumksize[thisbend]; for (j = 0; j < params.kk; j++) { bmean3[j] = helpers.cumymat[j][thisbend] / bsize3; bZ3 += pow(bmean3[j], 2) * bsize3; } } if (params.kk == 1 && bvals[0] == 1) Bvals[0] = 0; // force this to avoid rounding errs else Bvals[0] = stepnew.B - tmp + bZ3; Wvals[0] = stepnew.W + tmp - bZ3; } /**** * consider breaking blocks if not a change point */ bvals[1] = stepnew.b; if (step.rho[i] == 1) { Bvals[1] = stepnew.B; Wvals[1] = stepnew.W; } else { bZ1 = 0; bZ2 = 0; bvals[1]++; bsize2 = helpers.cumksize[thisbend] - helpers.cumksize[i]; if (lastbend > -1) bsize1 = helpers.cumksize[i] - helpers.cumksize[lastbend]; else bsize1 = helpers.cumksize[i]; tmp = thisblockZ; for (j = 0; j < params.kk; j++) { bmean2[j] = (helpers.cumymat[j][thisbend] - helpers.cumymat[j][i]) / bsize2; if (lastbend > -1) { bmean1[j] = (helpers.cumymat[j][i] - helpers.cumymat[j][lastbend]) / bsize1; } else { bmean1[j] = helpers.cumymat[j][i] / bsize1; } bZ1 += pow(bmean1[j], 2) * bsize1; bZ2 += pow(bmean2[j], 2) * bsize2; } Bvals[1] = stepnew.B - tmp + bZ1 + bZ2; Wvals[1] = stepnew.W + tmp - bZ1 - bZ2; } // if (i == 4122) return(stepnew); double p = getprob(Bvals[0], Bvals[1], Wvals[0], Wvals[1], bvals[0], params); // do the sampling and then updates double myrand = Rf_runif(0.0, 1.0); if (myrand < p) { cp = 1; } else { cp = 0; } // Rprintf("i:%d p=%0.4f, myrand=%0.2f, cp=%d\n", i, p, myrand, cp); stepnew.B = Bvals[cp]; stepnew.W = Wvals[cp]; stepnew.b = bvals[cp]; if (cp != step.rho[i]) { // we modified the change point status if (cp == 0) { // removed a change point // update last block's stuff since the last block is now further back thisblockZ = bZ3; if (currblock > 0) { lastbend = stepnew.bend[currblock - 1]; lastblockZ = stepnew.bZ[currblock - 1]; } else { lastblockZ = 0; lastbend = -1; // this is simply a notational convenience } } else { // added a change point thisblockZ = bZ2; lastblockZ = bZ1; } } stepnew.rho.push_back(cp); if (stepnew.rho[i] == 1) { if (step.rho[i] == 1) { // never calculated these quantities yet; do it now lastblockZ = 0; if (lastbend > -1) bsize1 = helpers.cumksize[i] - helpers.cumksize[lastbend]; else bsize1 = helpers.cumksize[i]; for (j = 0; j < params.kk; j++) { if (lastbend > -1) { bmean1[j] = (helpers.cumymat[j][i] - helpers.cumymat[j][lastbend]) / bsize1; } else { bmean1[j] = helpers.cumymat[j][i] / bsize1; } lastblockZ += pow(bmean1[j], 2) * bsize1; } } // we've added a change point, so we want to record some stuff stepnew.bsize.push_back(bsize1); stepnew.bend.push_back(i); stepnew.bmean.push_back(bmean1); stepnew.bZ.push_back(lastblockZ); currblock++; lastbend = i; } } // done with a full pass, now let's add info on the final block if (lastbend > -1) stepnew.bsize.push_back(params.nn2 - helpers.cumksize[lastbend]); else stepnew.bsize.push_back(params.nn2); for (j = 0; j < params.kk; j++) { if (lastbend > -1) { bmeanlast[j] = (helpers.cumymat[j][params.nn - 1] - helpers.cumymat[j][lastbend]) / stepnew.bsize[currblock]; } else { bmeanlast[j] = helpers.cumymat[j][params.nn - 1] / params.nn2; } bZlast += pow(bmeanlast[j], 2) * stepnew.bsize[currblock]; } stepnew.bmean.push_back(bmeanlast); stepnew.bZ.push_back(bZlast); stepnew.bend.push_back(params.nn - 1); stepnew.rho.push_back(1); return stepnew; }