Skip to content

Commit

Permalink
reset to pre-removal of SETLENGTH
Browse files Browse the repository at this point in the history
  • Loading branch information
@merliseclyde
merliseclyde committed Sep 17, 2024
1 parent 077071c commit de05879
Show file tree
Hide file tree
Showing 8 changed files with 102 additions and 316 deletions.
4 changes: 2 additions & 2 deletions DESCRIPTION
View file
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
Package: BAS
Version: 1.7.2
Date: 2024-9-16
Version: 1.7.3
Date: 2024-9-17
Title: Bayesian Variable Selection and Model Averaging using Bayesian Adaptive Sampling
Authors@R: c(person("Merlise", "Clyde", email="[email protected]",
role=c("aut","cre", "cph"),
Expand Down
64 changes: 15 additions & 49 deletions src/glm_mcmc.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -32,37 +32,7 @@ SEXP glm_mcmc(SEXP Y, SEXP X, SEXP Roffset, SEXP Rweights,

SEXP NumUnique = PROTECT(allocVector(INTSXP, 1)); ++nProtected;

PROTECT_INDEX counts_idx;
PROTECT_WITH_INDEX(counts, &counts_idx);
PROTECT_INDEX R2_idx;
PROTECT_WITH_INDEX(R2, &R2_idx);
PROTECT_INDEX shrinkage_idx;
PROTECT_WITH_INDEX(shrinkage, &shrinkage_idx);
PROTECT_INDEX modelspace_idx;
PROTECT_WITH_INDEX(modelspace, &modelspace_idx);
PROTECT_INDEX modeldim_idx;
PROTECT_WITH_INDEX(modeldim, &modeldim_idx);
// PROTECT_INDEX rank_idx;
// PROTECT_WITH_INDEX(rank, &rank_idx);
PROTECT_INDEX beta_idx;
PROTECT_WITH_INDEX(beta, &beta_idx);
PROTECT_INDEX se_idx;
PROTECT_WITH_INDEX(se, &se_idx);
PROTECT_INDEX deviance_idx;
PROTECT_WITH_INDEX(deviance, &deviance_idx);
PROTECT_INDEX modelprobs_idx;
PROTECT_WITH_INDEX(modelprobs, &modelprobs_idx);
PROTECT_INDEX priorprobs_idx;
PROTECT_WITH_INDEX(priorprobs, &priorprobs_idx);
PROTECT_INDEX logmarg_idx;
PROTECT_WITH_INDEX(logmarg, &logmarg_idx);
PROTECT_INDEX sampleprobs_idx;
PROTECT_WITH_INDEX(sampleprobs, &sampleprobs_idx);
PROTECT_INDEX Q_idx;
PROTECT_WITH_INDEX(R2, &Q_idx);
PROTECT_INDEX Rintercept_idx;
PROTECT_WITH_INDEX(Rintercept, &Rintercept_idx);



double *probs, MH=0.0, prior_m=1.0, shrinkage_m, logmargy, postold, postnew;
int i, m, n, pmodel_old, *bestmodel;
Expand Down Expand Up @@ -230,24 +200,20 @@ SEXP glm_mcmc(SEXP Y, SEXP X, SEXP Roffset, SEXP Rweights,
SET_STRING_ELT(ANS_names, 0, mkChar("probne0"));

if (nUnique < nModels) {
nModels = nUnique;
REPROTECT(logmarg= Rf_lengthgets(logmarg, nUnique), logmarg_idx);
REPROTECT(modelprobs= Rf_lengthgets(modelprobs, nUnique), modelprobs_idx);
REPROTECT(priorprobs= Rf_lengthgets(priorprobs, nUnique), priorprobs_idx);
REPROTECT(sampleprobs= Rf_lengthgets(sampleprobs, nUnique), sampleprobs_idx);
REPROTECT(deviance = Rf_lengthgets(deviance, nUnique), deviance_idx);
REPROTECT(shrinkage = Rf_lengthgets(shrinkage, nUnique), shrinkage_idx);
REPROTECT(modeldim= Rf_lengthgets(modeldim, nUnique), modeldim_idx);
REPROTECT(R2= Rf_lengthgets(R2, nUnique), R2_idx);
REPROTECT(se= Rf_lengthgets(se, nUnique), se_idx);
// REPROTECT(rank = Rf_lengthgets(rank, nUnique), rank_idx);
REPROTECT(modelspace = Rf_lengthgets(modelspace, nUnique), modelspace_idx);
REPROTECT(beta = Rf_lengthgets(beta, nUnique), beta_idx);
REPROTECT(se= Rf_lengthgets(se, nUnique), se_idx);
REPROTECT(Q= Rf_lengthgets(Q, nUnique), Q_idx);
REPROTECT(Rintercept= Rf_lengthgets(Rintercept, nUnique), Rintercept_idx);
REPROTECT(counts= Rf_lengthgets(counts, nUnique), counts_idx);

SETLENGTH(modelspace, nUnique);
SETLENGTH(logmarg, nUnique);
SETLENGTH(modelprobs, nUnique);
SETLENGTH(priorprobs, nUnique);
SETLENGTH(sampleprobs, nUnique);
SETLENGTH(counts, nUnique);
SETLENGTH(beta, nUnique);
SETLENGTH(se, nUnique);
SETLENGTH(deviance, nUnique);
SETLENGTH(Q, nUnique);
SETLENGTH(shrinkage, nUnique);
SETLENGTH(modeldim, nUnique);
SETLENGTH(R2, nUnique);
SETLENGTH(Rintercept, nUnique);
}

SET_VECTOR_ELT(ANS, 1, modelspace);
Expand Down
64 changes: 16 additions & 48 deletions src/glm_mcmcbas.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -33,37 +33,7 @@ SEXP glm_mcmcbas(SEXP Y, SEXP X, SEXP Roffset, SEXP Rweights,
SEXP NumUnique = PROTECT(allocVector(INTSXP, 1)); ++nProtected;


PROTECT_INDEX counts_idx;
PROTECT_WITH_INDEX(counts, &counts_idx);
PROTECT_INDEX R2_idx;
PROTECT_WITH_INDEX(R2, &R2_idx);
PROTECT_INDEX shrinkage_idx;
PROTECT_WITH_INDEX(shrinkage, &shrinkage_idx);
PROTECT_INDEX modelspace_idx;
PROTECT_WITH_INDEX(modelspace, &modelspace_idx);
PROTECT_INDEX modeldim_idx;
PROTECT_WITH_INDEX(modeldim, &modeldim_idx);
// PROTECT_INDEX rank_idx;
// PROTECT_WITH_INDEX(rank, &rank_idx);
PROTECT_INDEX beta_idx;
PROTECT_WITH_INDEX(beta, &beta_idx);
PROTECT_INDEX se_idx;
PROTECT_WITH_INDEX(se, &se_idx);
PROTECT_INDEX deviance_idx;
PROTECT_WITH_INDEX(deviance, &deviance_idx);
PROTECT_INDEX modelprobs_idx;
PROTECT_WITH_INDEX(modelprobs, &modelprobs_idx);
PROTECT_INDEX priorprobs_idx;
PROTECT_WITH_INDEX(priorprobs, &priorprobs_idx);
PROTECT_INDEX logmarg_idx;
PROTECT_WITH_INDEX(logmarg, &logmarg_idx);
PROTECT_INDEX sampleprobs_idx;
PROTECT_WITH_INDEX(sampleprobs, &sampleprobs_idx);
PROTECT_INDEX Q_idx;
PROTECT_WITH_INDEX(R2, &Q_idx);
PROTECT_INDEX Rintercept_idx;
PROTECT_WITH_INDEX(Rintercept, &Rintercept_idx);


double *probs, MH=0.0, prior_m=1.0,shrinkage_m, logmargy, postold, postnew;
int i, m, n, pmodel_old, *bestmodel;
int mcurrent, n_sure;
Expand Down Expand Up @@ -298,23 +268,21 @@ SEXP glm_mcmcbas(SEXP Y, SEXP X, SEXP Roffset, SEXP Rweights,
// # nocov start
if (mcurrent < k) { // truncate vectors; legacy code from MCMC should not get here
k = mcurrent;
REPROTECT(logmarg= Rf_lengthgets(logmarg, mcurrent), logmarg_idx);
REPROTECT(modelprobs= Rf_lengthgets(modelprobs, mcurrent), modelprobs_idx);
REPROTECT(priorprobs= Rf_lengthgets(priorprobs, mcurrent), priorprobs_idx);
REPROTECT(sampleprobs= Rf_lengthgets(sampleprobs, mcurrent), sampleprobs_idx);
REPROTECT(deviance = Rf_lengthgets(deviance, mcurrent), deviance_idx);
REPROTECT(shrinkage = Rf_lengthgets(shrinkage, mcurrent), shrinkage_idx);
REPROTECT(modeldim= Rf_lengthgets(modeldim, mcurrent), modeldim_idx);
REPROTECT(R2= Rf_lengthgets(R2, mcurrent), R2_idx);
REPROTECT(se= Rf_lengthgets(se, mcurrent), se_idx);
// REPROTECT(rank = Rf_lengthgets(rank, mcurrent), rank_idx);
REPROTECT(modelspace = Rf_lengthgets(modelspace, mcurrent), modelspace_idx);
REPROTECT(beta = Rf_lengthgets(beta, mcurrent), beta_idx);
REPROTECT(se= Rf_lengthgets(se, mcurrent), se_idx);
REPROTECT(Q= Rf_lengthgets(Q, mcurrent), Q_idx);
REPROTECT(Rintercept= Rf_lengthgets(Rintercept, mcurrent), Rintercept_idx);
REPROTECT(counts= Rf_lengthgets(counts, mcurrent), counts_idx);

SETLENGTH(modelspace, mcurrent);
SETLENGTH(logmarg, mcurrent);
SETLENGTH(modelprobs, mcurrent);
SETLENGTH(priorprobs, mcurrent);
SETLENGTH(sampleprobs, mcurrent);
SETLENGTH(counts, mcurrent);
SETLENGTH(MCMCprobs, mcurrent);
SETLENGTH(beta, mcurrent);
SETLENGTH(se, mcurrent);
SETLENGTH(deviance, mcurrent);
SETLENGTH(Q, mcurrent);
SETLENGTH(shrinkage, mcurrent);
SETLENGTH(modeldim, mcurrent);
SETLENGTH(R2, mcurrent);
SETLENGTH(Rintercept, mcurrent);
}
// # nocov end

Expand Down
57 changes: 13 additions & 44 deletions src/glm_sampleworep.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -31,34 +31,6 @@ SEXP glm_sampleworep(SEXP Y, SEXP X, SEXP Roffset, SEXP Rweights,
SEXP Q = PROTECT(allocVector(REALSXP, nModels)); ++nProtected;
SEXP Rintercept = PROTECT(allocVector(REALSXP, nModels)); ++nProtected;

PROTECT_INDEX R2_idx;
PROTECT_WITH_INDEX(R2, &R2_idx);
PROTECT_INDEX shrinkage_idx;
PROTECT_WITH_INDEX(shrinkage, &shrinkage_idx);
PROTECT_INDEX modelspace_idx;
PROTECT_WITH_INDEX(modelspace, &modelspace_idx);
PROTECT_INDEX modeldim_idx;
PROTECT_WITH_INDEX(modeldim, &modeldim_idx);
// PROTECT_INDEX rank_idx;
// PROTECT_WITH_INDEX(rank, &rank_idx);
PROTECT_INDEX beta_idx;
PROTECT_WITH_INDEX(beta, &beta_idx);
PROTECT_INDEX se_idx;
PROTECT_WITH_INDEX(se, &se_idx);
PROTECT_INDEX deviance_idx;
PROTECT_WITH_INDEX(deviance, &deviance_idx);
PROTECT_INDEX modelprobs_idx;
PROTECT_WITH_INDEX(modelprobs, &modelprobs_idx);
PROTECT_INDEX priorprobs_idx;
PROTECT_WITH_INDEX(priorprobs, &priorprobs_idx);
PROTECT_INDEX logmarg_idx;
PROTECT_WITH_INDEX(logmarg, &logmarg_idx);
PROTECT_INDEX sampleprobs_idx;
PROTECT_WITH_INDEX(sampleprobs, &sampleprobs_idx);
PROTECT_INDEX Q_idx;
PROTECT_WITH_INDEX(R2, &Q_idx);
PROTECT_INDEX Rintercept_idx;
PROTECT_WITH_INDEX(Rintercept, &Rintercept_idx);


double *probs,logmargy, shrinkage_m;
Expand Down Expand Up @@ -186,22 +158,19 @@ SEXP glm_sampleworep(SEXP Y, SEXP X, SEXP Roffset, SEXP Rweights,
// resize if constraints have reduced the number of models
k = m;

REPROTECT(logmarg= Rf_lengthgets(logmarg, m), logmarg_idx);
REPROTECT(modelprobs= Rf_lengthgets(modelprobs, m), modelprobs_idx);
REPROTECT(priorprobs= Rf_lengthgets(priorprobs, m), priorprobs_idx);
REPROTECT(sampleprobs= Rf_lengthgets(sampleprobs, m), sampleprobs_idx);
REPROTECT(deviance = Rf_lengthgets(deviance, m), deviance_idx);
REPROTECT(shrinkage = Rf_lengthgets(shrinkage, m), shrinkage_idx);
REPROTECT(modeldim= Rf_lengthgets(modeldim, m), modeldim_idx);
REPROTECT(R2= Rf_lengthgets(R2, m), R2_idx);
REPROTECT(se= Rf_lengthgets(se, m), se_idx);
// REPROTECT(rank = Rf_lengthgets(rank, m), rank_idx);
REPROTECT(modelspace = Rf_lengthgets(modelspace, m), modelspace_idx);
REPROTECT(beta = Rf_lengthgets(beta, m), beta_idx);
REPROTECT(se= Rf_lengthgets(se, m), se_idx);
REPROTECT(Q= Rf_lengthgets(Q, m), Q_idx);
REPROTECT(Rintercept= Rf_lengthgets(Rintercept, m), Rintercept_idx);

SETLENGTH(modelspace, m);
SETLENGTH(logmarg, m);
SETLENGTH(modelprobs, m);
SETLENGTH(priorprobs, m);
SETLENGTH(sampleprobs, m);
SETLENGTH(beta, m);
SETLENGTH(se, m);
SETLENGTH(deviance, m);
SETLENGTH(Q, m);
SETLENGTH(shrinkage, m);
SETLENGTH(modeldim, m);
SETLENGTH(R2, m);
SETLENGTH(Rintercept, m);
}

compute_modelprobs(modelprobs, logmarg, priorprobs,k);
Expand Down
58 changes: 15 additions & 43 deletions src/lm_amcmc.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -37,33 +37,7 @@ SEXP amcmc(SEXP Y, SEXP X, SEXP Rweights, SEXP Rprobinit, SEXP Rmodeldim,
SEXP NumUnique = PROTECT(allocVector(INTSXP, 1)); ++nProtected;


PROTECT_INDEX counts_idx;
PROTECT_WITH_INDEX(counts, &counts_idx);
PROTECT_INDEX R2_idx;
PROTECT_WITH_INDEX(R2, &R2_idx);
PROTECT_INDEX shrinkage_idx;
PROTECT_WITH_INDEX(shrinkage, &shrinkage_idx);
PROTECT_INDEX modelspace_idx;
PROTECT_WITH_INDEX(modelspace, &modelspace_idx);
PROTECT_INDEX modeldim_idx;
PROTECT_WITH_INDEX(modeldim, &modeldim_idx);
PROTECT_INDEX rank_idx;
PROTECT_WITH_INDEX(rank, &rank_idx);
PROTECT_INDEX beta_idx;
PROTECT_WITH_INDEX(beta, &beta_idx);
PROTECT_INDEX se_idx;
PROTECT_WITH_INDEX(se, &se_idx);
PROTECT_INDEX mse_idx;
PROTECT_WITH_INDEX(mse, &mse_idx);
PROTECT_INDEX modelprobs_idx;
PROTECT_WITH_INDEX(modelprobs, &modelprobs_idx);
PROTECT_INDEX priorprobs_idx;
PROTECT_WITH_INDEX(priorprobs, &priorprobs_idx);
PROTECT_INDEX logmarg_idx;
PROTECT_WITH_INDEX(logmarg, &logmarg_idx);
PROTECT_INDEX sampleprobs_idx;
PROTECT_WITH_INDEX(sampleprobs, &sampleprobs_idx);



Rprintf("Allocating Space for %d Models AMCMC\n", nModels) ;
double *Xwork, *Ywork,*wts, *probs, shrinkage_m,
Expand Down Expand Up @@ -440,23 +414,21 @@ SEXP amcmc(SEXP Y, SEXP X, SEXP Rweights, SEXP Rprobinit, SEXP Rmodeldim,
SET_VECTOR_ELT(ANS, 0, Rprobs);
SET_STRING_ELT(ANS_names, 0, mkChar("probne0"));

// Rprintf("truncate vectors/n");
if (nUnique < nModels) {
nModels = nUnique;
REPROTECT(logmarg= Rf_lengthgets(logmarg, nUnique), logmarg_idx);
REPROTECT(modelprobs= Rf_lengthgets(modelprobs, nUnique), modelprobs_idx);
REPROTECT(priorprobs= Rf_lengthgets(priorprobs, nUnique), priorprobs_idx);
REPROTECT(sampleprobs= Rf_lengthgets(sampleprobs, nUnique), sampleprobs_idx);
REPROTECT(shrinkage = Rf_lengthgets(shrinkage, nUnique), shrinkage_idx);
REPROTECT(modeldim= Rf_lengthgets(modeldim, nUnique), modeldim_idx);
REPROTECT(R2= Rf_lengthgets(R2, nUnique), R2_idx);
REPROTECT(se= Rf_lengthgets(se, nUnique), se_idx);
REPROTECT(mse= Rf_lengthgets(se, nUnique), mse_idx);
REPROTECT(rank = Rf_lengthgets(rank, nUnique), rank_idx);
REPROTECT(modelspace = Rf_lengthgets(modelspace, nUnique), modelspace_idx);
REPROTECT(beta = Rf_lengthgets(beta, nUnique), beta_idx);
REPROTECT(se= Rf_lengthgets(se, nUnique), se_idx);
REPROTECT(counts= Rf_lengthgets(counts, nUnique), counts_idx);

SETLENGTH(modelspace, nUnique);
SETLENGTH(logmarg, nUnique);
SETLENGTH(modelprobs, nUnique);
SETLENGTH(priorprobs, nUnique);
SETLENGTH(sampleprobs, nUnique);
SETLENGTH(counts, nUnique);
SETLENGTH(beta, nUnique);
SETLENGTH(se, nUnique);
SETLENGTH(mse, nUnique);
SETLENGTH(shrinkage, nUnique);
SETLENGTH(modeldim, nUnique);
SETLENGTH(R2, nUnique);
SETLENGTH(rank, nUnique);
}
SET_VECTOR_ELT(ANS, 1, modelspace);
SET_STRING_ELT(ANS_names, 1, mkChar("which"));
Expand Down
59 changes: 15 additions & 44 deletions src/lm_mcmc.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -35,33 +35,6 @@ SEXP mcmc_new(SEXP Y, SEXP X, SEXP Rweights, SEXP Rprobinit, SEXP Rmodeldim,
SEXP sampleprobs = PROTECT(allocVector(REALSXP, nModels)); ++nProtected;
SEXP NumUnique = PROTECT(allocVector(INTSXP, 1)); ++nProtected;

PROTECT_INDEX counts_idx;
PROTECT_WITH_INDEX(counts, &counts_idx);
PROTECT_INDEX R2_idx;
PROTECT_WITH_INDEX(R2, &R2_idx);
PROTECT_INDEX shrinkage_idx;
PROTECT_WITH_INDEX(shrinkage, &shrinkage_idx);
PROTECT_INDEX modelspace_idx;
PROTECT_WITH_INDEX(modelspace, &modelspace_idx);
PROTECT_INDEX modeldim_idx;
PROTECT_WITH_INDEX(modeldim, &modeldim_idx);
PROTECT_INDEX rank_idx;
PROTECT_WITH_INDEX(rank, &rank_idx);
PROTECT_INDEX beta_idx;
PROTECT_WITH_INDEX(beta, &beta_idx);
PROTECT_INDEX se_idx;
PROTECT_WITH_INDEX(se, &se_idx);
PROTECT_INDEX mse_idx;
PROTECT_WITH_INDEX(mse, &mse_idx);
PROTECT_INDEX modelprobs_idx;
PROTECT_WITH_INDEX(modelprobs, &modelprobs_idx);
PROTECT_INDEX priorprobs_idx;
PROTECT_WITH_INDEX(priorprobs, &priorprobs_idx);
PROTECT_INDEX logmarg_idx;
PROTECT_WITH_INDEX(logmarg, &logmarg_idx);
PROTECT_INDEX sampleprobs_idx;
PROTECT_WITH_INDEX(sampleprobs, &sampleprobs_idx);


double *Xwork, *Ywork,*wts, *probs, shrinkage_m,
mse_m, MH=0.0, prior_m=1.0,
Expand Down Expand Up @@ -275,23 +248,21 @@ SEXP mcmc_new(SEXP Y, SEXP X, SEXP Rweights, SEXP Rprobinit, SEXP Rmodeldim,
SET_STRING_ELT(ANS_names, 0, mkChar("probne0"));

if (nUnique < nModels) {
nModels = nUnique;
REPROTECT(counts= Rf_lengthgets(counts, nUnique), counts_idx);
REPROTECT(logmarg= Rf_lengthgets(logmarg, nUnique), logmarg_idx);
REPROTECT(modelprobs= Rf_lengthgets(modelprobs, nUnique), modelprobs_idx);
REPROTECT(priorprobs= Rf_lengthgets(priorprobs, nUnique), priorprobs_idx);
REPROTECT(sampleprobs= Rf_lengthgets(sampleprobs, nUnique), sampleprobs_idx);
REPROTECT(mse = Rf_lengthgets(mse, nUnique), mse_idx);
REPROTECT(shrinkage = Rf_lengthgets(shrinkage, nUnique), shrinkage_idx);
REPROTECT(modeldim= Rf_lengthgets(modeldim, nUnique), modeldim_idx);
REPROTECT(R2= Rf_lengthgets(R2, nUnique), R2_idx);
REPROTECT(se= Rf_lengthgets(se, nUnique), se_idx);
REPROTECT(rank = Rf_lengthgets(rank, nUnique), rank_idx);
REPROTECT(modelspace = Rf_lengthgets(modelspace, nUnique), modelspace_idx);
REPROTECT(beta = Rf_lengthgets(beta, nUnique), beta_idx);
REPROTECT(se= Rf_lengthgets(se, nUnique), se_idx);

}
SETLENGTH(modelspace, nUnique);
SETLENGTH(logmarg, nUnique);
SETLENGTH(modelprobs, nUnique);
SETLENGTH(priorprobs, nUnique);
SETLENGTH(sampleprobs, nUnique);
SETLENGTH(counts, nUnique);
SETLENGTH(beta, nUnique);
SETLENGTH(se, nUnique);
SETLENGTH(mse, nUnique);
SETLENGTH(shrinkage, nUnique);
SETLENGTH(modeldim, nUnique);
SETLENGTH(R2, nUnique);
SETLENGTH(rank, nUnique);
}

SET_VECTOR_ELT(ANS, 1, modelspace);
SET_STRING_ELT(ANS_names, 1, mkChar("which"));

Expand Down
Loading

0 comments on commit de05879

Please sign in to comment.