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