diff --git a/R/bas_lm.R b/R/bas_lm.R index d5434a9c..b272812c 100644 --- a/R/bas_lm.R +++ b/R/bas_lm.R @@ -628,7 +628,7 @@ bas.lm <- function(formula, } if (is.null(n.models)) { - n.models <- min(2^p, 2^19) + n.models <- min(2^p, 2^16) } if (is.null(MCMC.iterations)) { MCMC.iterations <- as.integer(n.models * 10) diff --git a/src/bas.h b/src/bas.h index 7e44d45f..d57f33f4 100644 --- a/src/bas.h +++ b/src/bas.h @@ -53,7 +53,6 @@ struct Node { }; - /* Subroutines. */ double CalculateRSquareFull(double *XtY, double *XtX, double *XtXwork, double *XtYwork, @@ -349,7 +348,6 @@ SEXP glm_bas(SEXP RX, SEXP RY, glmstptr * family, SEXP Roffset, SEXP Rweights, S SEXP gglm_lpy(SEXP RX, SEXP RY,SEXP Rcoef, SEXP Rmu, SEXP Rdeviance, SEXP Rweights, glmstptr * glmfamily, betapriorptr * betapriorfamily, SEXP Rlaplace); - // issue 38 static inline int lessThanOne(double a) diff --git a/src/glm_sampleworep.c b/src/glm_sampleworep.c index 5ab91cc6..869d0352 100644 --- a/src/glm_sampleworep.c +++ b/src/glm_sampleworep.c @@ -31,6 +31,36 @@ 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; int i; @@ -155,19 +185,23 @@ SEXP glm_sampleworep(SEXP Y, SEXP X, SEXP Roffset, SEXP Rweights, if (m < k) { // resize if constraints have reduced the number of models k = m; - 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(Rintercept, m); - SETLENGTH(shrinkage, m); - SETLENGTH(modeldim, m); - SETLENGTH(R2, 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); + } compute_modelprobs(modelprobs, logmarg, priorprobs,k); diff --git a/src/lm_sampleworep.c b/src/lm_sampleworep.c index 2dc21ce3..b408b224 100644 --- a/src/lm_sampleworep.c +++ b/src/lm_sampleworep.c @@ -23,7 +23,8 @@ deterministic sampling. ML 6/97. */ extern SEXP sampleworep_new(SEXP Y, SEXP X, SEXP Rweights, SEXP Rprobinit, SEXP Rmodeldim, SEXP incint, SEXP Ralpha, SEXP method, SEXP modelprior, SEXP Rupdate, - SEXP Rbestmodel, SEXP plocal, SEXP Rparents, SEXP Rpivot, SEXP Rtol) { + SEXP Rbestmodel, SEXP plocal, SEXP Rparents, + SEXP Rpivot, SEXP Rtol) { int nProtected = 0; SEXP RXwork = PROTECT(duplicate(X)); nProtected++; SEXP RYwork = PROTECT(duplicate(Y)); nProtected++; @@ -48,6 +49,31 @@ extern SEXP sampleworep_new(SEXP Y, SEXP X, SEXP Rweights, SEXP Rprobinit, SEXP logmarg = PROTECT(allocVector(REALSXP, nModels)); ++nProtected; SEXP sampleprobs = 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 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, R2_m, RSquareFull, Rbestmarg, logmargy; int i, *model_m, *bestmodel, rank_m; @@ -219,19 +245,21 @@ extern SEXP sampleworep_new(SEXP Y, SEXP X, SEXP Rweights, SEXP Rprobinit, if (m < k) { // resize k = m; - SETLENGTH(modelspace, m); - SETLENGTH(logmarg, m); - SETLENGTH(modelprobs, m); - SETLENGTH(priorprobs, m); - SETLENGTH(sampleprobs, m); - SETLENGTH(beta, m); - SETLENGTH(se, m); - SETLENGTH(mse, m); - SETLENGTH(shrinkage, m); - SETLENGTH(modeldim, m); - SETLENGTH(R2, m); - SETLENGTH(rank, m); -// Rprintf("m %d k %d", m, LENGTH(modelprobs)); + + 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(mse = Rf_lengthgets(mse, m), mse_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); + } diff --git a/src/mem.c b/src/mem.c index 54ab8b25..d9cbde76 100644 --- a/src/mem.c +++ b/src/mem.c @@ -51,5 +51,3 @@ return x; } return elmt; } - -