From bac6ce3648590e8f2c93d6d78c937e21be9f28d4 Mon Sep 17 00:00:00 2001 From: Andrew Johnson Date: Thu, 9 Feb 2023 10:37:15 +0200 Subject: [PATCH 1/3] Delegate to rstantools --- R/RcppExports.R | 36 +-- R/stanmodels.R | 27 -- configure | 1 + configure.win | 1 + src/Makevars | 20 -- src/Makevars.win | 19 -- src/RcppExports.cpp | 359 --------------------- src/stanExports_binomial_logit_model.cc | 32 -- src/stanExports_binomial_logit_model.h | 336 ------------------- src/stanExports_gaussian_identity_model.cc | 32 -- src/stanExports_gaussian_identity_model.h | 339 ------------------- src/stanExports_poisson_log_model.cc | 32 -- src/stanExports_poisson_log_model.h | 335 ------------------- 13 files changed, 16 insertions(+), 1553 deletions(-) delete mode 100644 R/stanmodels.R mode change 100644 => 100755 configure mode change 100644 => 100755 configure.win delete mode 100644 src/Makevars delete mode 100644 src/Makevars.win delete mode 100644 src/RcppExports.cpp delete mode 100644 src/stanExports_binomial_logit_model.cc delete mode 100644 src/stanExports_binomial_logit_model.h delete mode 100644 src/stanExports_gaussian_identity_model.cc delete mode 100644 src/stanExports_gaussian_identity_model.h delete mode 100644 src/stanExports_poisson_log_model.cc delete mode 100644 src/stanExports_poisson_log_model.h diff --git a/R/RcppExports.R b/R/RcppExports.R index a3d987d..d63ac9a 100644 --- a/R/RcppExports.R +++ b/R/RcppExports.R @@ -2,66 +2,58 @@ # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 grp_CD_XZ_FA_step <- function(y, X, Z, group, pBigMat, J_f, dims, beta, offset, step_size, sig_g, family, link, init, phi, X_group, K, penalty, params, trace) { - .Call('_glmmPen_grp_CD_XZ_FA_step', PACKAGE = 'glmmPen', y, X, Z, group, pBigMat, J_f, dims, beta, offset, step_size, sig_g, family, link, init, phi, X_group, K, penalty, params, trace) + .Call(`_glmmPen_grp_CD_XZ_FA_step`, y, X, Z, group, pBigMat, J_f, dims, beta, offset, step_size, sig_g, family, link, init, phi, X_group, K, penalty, params, trace) } grp_CD_XZ_step <- function(y, X, Z, group, pBigMat, J_q, dims, beta, offset, step_size, sig_g, family, link, init, phi, XZ_group, K, penalty, params, trace) { - .Call('_glmmPen_grp_CD_XZ_step', PACKAGE = 'glmmPen', y, X, Z, group, pBigMat, J_q, dims, beta, offset, step_size, sig_g, family, link, init, phi, XZ_group, K, penalty, params, trace) + .Call(`_glmmPen_grp_CD_XZ_step`, y, X, Z, group, pBigMat, J_q, dims, beta, offset, step_size, sig_g, family, link, init, phi, XZ_group, K, penalty, params, trace) } soft_thresh <- function(zeta, lambda) { - .Call('_glmmPen_soft_thresh', PACKAGE = 'glmmPen', zeta, lambda) + .Call(`_glmmPen_soft_thresh`, zeta, lambda) } MCP_soln <- function(zeta, nu, lambda, gamma, alpha) { - .Call('_glmmPen_MCP_soln', PACKAGE = 'glmmPen', zeta, nu, lambda, gamma, alpha) + .Call(`_glmmPen_MCP_soln`, zeta, nu, lambda, gamma, alpha) } SCAD_soln <- function(zeta, nu, lambda, gamma, alpha) { - .Call('_glmmPen_SCAD_soln', PACKAGE = 'glmmPen', zeta, nu, lambda, gamma, alpha) + .Call(`_glmmPen_SCAD_soln`, zeta, nu, lambda, gamma, alpha) } pglm_fit <- function(y, X, dims, beta, offset, family, link, penalty, params, penalty_factor, trace) { - .Call('_glmmPen_pglm_fit', PACKAGE = 'glmmPen', y, X, dims, beta, offset, family, link, penalty, params, penalty_factor, trace) + .Call(`_glmmPen_pglm_fit`, y, X, dims, beta, offset, family, link, penalty, params, penalty_factor, trace) } sample_mc_inner_gibbs <- function(f, z, y, t, NMC, u0, family, link, phi, sig_g) { - .Call('_glmmPen_sample_mc_inner_gibbs', PACKAGE = 'glmmPen', f, z, y, t, NMC, u0, family, link, phi, sig_g) + .Call(`_glmmPen_sample_mc_inner_gibbs`, f, z, y, t, NMC, u0, family, link, phi, sig_g) } sample_mc_gibbs_adapt_rw <- function(f, z, y, NMC, u0, proposal_SD, batch, batch_length, offset, nMC_burnin, family, link, phi, sig_g) { - .Call('_glmmPen_sample_mc_gibbs_adapt_rw', PACKAGE = 'glmmPen', f, z, y, NMC, u0, proposal_SD, batch, batch_length, offset, nMC_burnin, family, link, phi, sig_g) -} - -Qfun_FA <- function(y, X, Z, pBigMat, group, J_f, beta, offset, dims, family, link, sig_g, phi) { - .Call('_glmmPen_Qfun_FA', PACKAGE = 'glmmPen', y, X, Z, pBigMat, group, J_f, beta, offset, dims, family, link, sig_g, phi) -} - -sig_gaus_FA <- function(y, X, Z, pBigMat, group, J_q, beta, offset, dims, link) { - .Call('_glmmPen_sig_gaus_FA', PACKAGE = 'glmmPen', y, X, Z, pBigMat, group, J_q, beta, offset, dims, link) + .Call(`_glmmPen_sample_mc_gibbs_adapt_rw`, f, z, y, NMC, u0, proposal_SD, batch, batch_length, offset, nMC_burnin, family, link, phi, sig_g) } invlink <- function(link, eta) { - .Call('_glmmPen_invlink', PACKAGE = 'glmmPen', link, eta) + .Call(`_glmmPen_invlink`, link, eta) } Qfun <- function(y, X, Z, pBigMat, group, J_q, beta, offset, dims, family, link, sig_g, phi) { - .Call('_glmmPen_Qfun', PACKAGE = 'glmmPen', y, X, Z, pBigMat, group, J_q, beta, offset, dims, family, link, sig_g, phi) + .Call(`_glmmPen_Qfun`, y, X, Z, pBigMat, group, J_q, beta, offset, dims, family, link, sig_g, phi) } sig_gaus <- function(y, X, Z, pBigMat, group, J_q, beta, offset, dims, link) { - .Call('_glmmPen_sig_gaus', PACKAGE = 'glmmPen', y, X, Z, pBigMat, group, J_q, beta, offset, dims, link) + .Call(`_glmmPen_sig_gaus`, y, X, Z, pBigMat, group, J_q, beta, offset, dims, link) } phi_ml <- function(y, eta, link, limit, eps, phi) { - .Call('_glmmPen_phi_ml', PACKAGE = 'glmmPen', y, eta, link, limit, eps, phi) + .Call(`_glmmPen_phi_ml`, y, eta, link, limit, eps, phi) } phi_ml_init <- function(y, eta, link, limit, eps) { - .Call('_glmmPen_phi_ml_init', PACKAGE = 'glmmPen', y, eta, link, limit, eps) + .Call(`_glmmPen_phi_ml_init`, y, eta, link, limit, eps) } Qfun_quad_beta <- function(Q0, step_size, diff0, eta, eta0, beta, beta0) { - .Call('_glmmPen_Qfun_quad_beta', PACKAGE = 'glmmPen', Q0, step_size, diff0, eta, eta0, beta, beta0) + .Call(`_glmmPen_Qfun_quad_beta`, Q0, step_size, diff0, eta, eta0, beta, beta0) } diff --git a/R/stanmodels.R b/R/stanmodels.R deleted file mode 100644 index ce0714f..0000000 --- a/R/stanmodels.R +++ /dev/null @@ -1,27 +0,0 @@ -# Generated by rstantools. Do not edit by hand. - -# names of stan models -stanmodels <- c("binomial_logit_model", "gaussian_identity_model", "poisson_log_model") - -# load each stan module -Rcpp::loadModule("stan_fit4binomial_logit_model_mod", what = TRUE) -Rcpp::loadModule("stan_fit4gaussian_identity_model_mod", what = TRUE) -Rcpp::loadModule("stan_fit4poisson_log_model_mod", what = TRUE) - -# instantiate each stanmodel object -stanmodels <- sapply(stanmodels, function(model_name) { - # create C++ code for stan model - stan_file <- if(dir.exists("stan")) "stan" else file.path("inst", "stan") - stan_file <- file.path(stan_file, paste0(model_name, ".stan")) - stanfit <- rstan::stanc_builder(stan_file, - allow_undefined = TRUE, - obfuscate_model_name = FALSE) - stanfit$model_cpp <- list(model_cppname = stanfit$model_name, - model_cppcode = stanfit$cppcode) - # create stanmodel object - methods::new(Class = "stanmodel", - model_name = stanfit$model_name, - model_code = stanfit$model_code, - model_cpp = stanfit$model_cpp, - mk_cppmodule = function(x) get(paste0("model_", model_name))) -}) diff --git a/configure b/configure old mode 100644 new mode 100755 index 1c04798..c0759ce --- a/configure +++ b/configure @@ -2,3 +2,4 @@ #! /bin/sh "${R_HOME}/bin/Rscript" -e "rstantools::rstan_config()" +echo "PKG_LIBS += \$(LAPACK_LIBS) \$(BLAS_LIBS) \$(FLIBS)" >> src/Makevars diff --git a/configure.win b/configure.win old mode 100644 new mode 100755 index 94d77bd..b0e7c85 --- a/configure.win +++ b/configure.win @@ -2,3 +2,4 @@ #! /bin/sh "${R_HOME}/bin${R_ARCH_BIN}/Rscript.exe" -e "rstantools::rstan_config()" +echo "PKG_LIBS += \$(LAPACK_LIBS) \$(BLAS_LIBS) \$(FLIBS)" >> src/Makevars.win diff --git a/src/Makevars b/src/Makevars deleted file mode 100644 index 5c332f1..0000000 --- a/src/Makevars +++ /dev/null @@ -1,20 +0,0 @@ - -## With R 3.1.0 or later, you can uncomment the following line to tell R to -## enable compilation with C++11 (where available) -## -## Also, OpenMP support in Armadillo prefers C++11 support. However, for wider -## availability of the package we do not yet enforce this here. It is however -## recommended for client packages to set it. -## -## And with R 3.4.0, and RcppArmadillo 0.7.960.*, we turn C++11 on as OpenMP -## support within Armadillo prefers / requires it -STANHEADERS_SRC = `"$(R_HOME)/bin$(R_ARCH_BIN)/Rscript" -e "message()" -e "cat(system.file('include', 'src', package = 'StanHeaders', mustWork = TRUE))" -e "message()" | grep "StanHeaders"` - -PKG_CPPFLAGS = -I"../inst/include" -I"$(STANHEADERS_SRC)" -DBOOST_DISABLE_ASSERTS -DEIGEN_NO_DEBUG -DBOOST_MATH_OVERFLOW_ERROR_POLICY=errno_on_error - -CXX_STD = CXX14 - -PKG_LIBS = $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) - -all: $(SHLIB) - @if test -e "/usr/bin/install_name_tool" && test -e "/usr/local/clang4/lib/libc++.1.dylib" && test -e "/usr/lib/libc++.1.dylib"; then /usr/bin/install_name_tool -change /usr/local/clang4/lib/libc++.1.dylib /usr/lib/libc++.1.dylib $(SHLIB); fi diff --git a/src/Makevars.win b/src/Makevars.win deleted file mode 100644 index 7db8640..0000000 --- a/src/Makevars.win +++ /dev/null @@ -1,19 +0,0 @@ - -## With R 3.1.0 or later, you can uncomment the following line to tell R to -## enable compilation with C++11 (where available) -## -## Also, OpenMP support in Armadillo prefers C++11 support. However, for wider -## availability of the package we do not yet enforce this here. It is however -## recommended for client packages to set it. -## -## And with R 3.4.0, and RcppArmadillo 0.7.960.*, we turn C++11 on as OpenMP -## support within Armadillo prefers / requires it -STANHEADERS_SRC = $(shell "$(R_HOME)/bin$(R_ARCH_BIN)/Rscript" -e "message()" -e "cat(system.file('include', 'src', package = 'StanHeaders', mustWork = TRUE))" -e "message()" | grep "StanHeaders") - -PKG_CPPFLAGS = -I"../inst/include" -I"$(STANHEADERS_SRC)" -DBOOST_DISABLE_ASSERTS -DEIGEN_NO_DEBUG - -CXX_STD = CXX14 - -PKG_LIBS = $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) - -all: $(SHLIB) \ No newline at end of file diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp deleted file mode 100644 index 46243d5..0000000 --- a/src/RcppExports.cpp +++ /dev/null @@ -1,359 +0,0 @@ -// Generated by using Rcpp::compileAttributes() -> do not edit by hand -// Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 - -#include -#include -#include - -using namespace Rcpp; - -#ifdef RCPP_USE_GLOBAL_ROSTREAM -Rcpp::Rostream& Rcpp::Rcout = Rcpp::Rcpp_cout_get(); -Rcpp::Rostream& Rcpp::Rcerr = Rcpp::Rcpp_cerr_get(); -#endif - -// grp_CD_XZ_FA_step -arma::vec grp_CD_XZ_FA_step(const arma::vec& y, const arma::mat& X, const arma::mat& Z, const arma::vec& group, SEXP pBigMat, const arma::sp_mat& J_f, arma::vec dims, arma::vec beta, const arma::vec& offset, double step_size, double sig_g, const char* family, int link, int init, double phi, const arma::uvec& X_group, arma::uvec K, const char* penalty, arma::vec params, int trace); -RcppExport SEXP _glmmPen_grp_CD_XZ_FA_step(SEXP ySEXP, SEXP XSEXP, SEXP ZSEXP, SEXP groupSEXP, SEXP pBigMatSEXP, SEXP J_fSEXP, SEXP dimsSEXP, SEXP betaSEXP, SEXP offsetSEXP, SEXP step_sizeSEXP, SEXP sig_gSEXP, SEXP familySEXP, SEXP linkSEXP, SEXP initSEXP, SEXP phiSEXP, SEXP X_groupSEXP, SEXP KSEXP, SEXP penaltySEXP, SEXP paramsSEXP, SEXP traceSEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< const arma::vec& >::type y(ySEXP); - Rcpp::traits::input_parameter< const arma::mat& >::type X(XSEXP); - Rcpp::traits::input_parameter< const arma::mat& >::type Z(ZSEXP); - Rcpp::traits::input_parameter< const arma::vec& >::type group(groupSEXP); - Rcpp::traits::input_parameter< SEXP >::type pBigMat(pBigMatSEXP); - Rcpp::traits::input_parameter< const arma::sp_mat& >::type J_f(J_fSEXP); - Rcpp::traits::input_parameter< arma::vec >::type dims(dimsSEXP); - Rcpp::traits::input_parameter< arma::vec >::type beta(betaSEXP); - Rcpp::traits::input_parameter< const arma::vec& >::type offset(offsetSEXP); - Rcpp::traits::input_parameter< double >::type step_size(step_sizeSEXP); - Rcpp::traits::input_parameter< double >::type sig_g(sig_gSEXP); - Rcpp::traits::input_parameter< const char* >::type family(familySEXP); - Rcpp::traits::input_parameter< int >::type link(linkSEXP); - Rcpp::traits::input_parameter< int >::type init(initSEXP); - Rcpp::traits::input_parameter< double >::type phi(phiSEXP); - Rcpp::traits::input_parameter< const arma::uvec& >::type X_group(X_groupSEXP); - Rcpp::traits::input_parameter< arma::uvec >::type K(KSEXP); - Rcpp::traits::input_parameter< const char* >::type penalty(penaltySEXP); - Rcpp::traits::input_parameter< arma::vec >::type params(paramsSEXP); - Rcpp::traits::input_parameter< int >::type trace(traceSEXP); - rcpp_result_gen = Rcpp::wrap(grp_CD_XZ_FA_step(y, X, Z, group, pBigMat, J_f, dims, beta, offset, step_size, sig_g, family, link, init, phi, X_group, K, penalty, params, trace)); - return rcpp_result_gen; -END_RCPP -} -// grp_CD_XZ_step -arma::vec grp_CD_XZ_step(const arma::vec& y, const arma::mat& X, const arma::mat& Z, const arma::vec& group, SEXP pBigMat, const arma::sp_mat& J_q, arma::vec dims, arma::vec beta, const arma::vec& offset, double step_size, double sig_g, const char* family, int link, int init, double phi, const arma::uvec& XZ_group, arma::uvec K, const char* penalty, arma::vec params, int trace); -RcppExport SEXP _glmmPen_grp_CD_XZ_step(SEXP ySEXP, SEXP XSEXP, SEXP ZSEXP, SEXP groupSEXP, SEXP pBigMatSEXP, SEXP J_qSEXP, SEXP dimsSEXP, SEXP betaSEXP, SEXP offsetSEXP, SEXP step_sizeSEXP, SEXP sig_gSEXP, SEXP familySEXP, SEXP linkSEXP, SEXP initSEXP, SEXP phiSEXP, SEXP XZ_groupSEXP, SEXP KSEXP, SEXP penaltySEXP, SEXP paramsSEXP, SEXP traceSEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< const arma::vec& >::type y(ySEXP); - Rcpp::traits::input_parameter< const arma::mat& >::type X(XSEXP); - Rcpp::traits::input_parameter< const arma::mat& >::type Z(ZSEXP); - Rcpp::traits::input_parameter< const arma::vec& >::type group(groupSEXP); - Rcpp::traits::input_parameter< SEXP >::type pBigMat(pBigMatSEXP); - Rcpp::traits::input_parameter< const arma::sp_mat& >::type J_q(J_qSEXP); - Rcpp::traits::input_parameter< arma::vec >::type dims(dimsSEXP); - Rcpp::traits::input_parameter< arma::vec >::type beta(betaSEXP); - Rcpp::traits::input_parameter< const arma::vec& >::type offset(offsetSEXP); - Rcpp::traits::input_parameter< double >::type step_size(step_sizeSEXP); - Rcpp::traits::input_parameter< double >::type sig_g(sig_gSEXP); - Rcpp::traits::input_parameter< const char* >::type family(familySEXP); - Rcpp::traits::input_parameter< int >::type link(linkSEXP); - Rcpp::traits::input_parameter< int >::type init(initSEXP); - Rcpp::traits::input_parameter< double >::type phi(phiSEXP); - Rcpp::traits::input_parameter< const arma::uvec& >::type XZ_group(XZ_groupSEXP); - Rcpp::traits::input_parameter< arma::uvec >::type K(KSEXP); - Rcpp::traits::input_parameter< const char* >::type penalty(penaltySEXP); - Rcpp::traits::input_parameter< arma::vec >::type params(paramsSEXP); - Rcpp::traits::input_parameter< int >::type trace(traceSEXP); - rcpp_result_gen = Rcpp::wrap(grp_CD_XZ_step(y, X, Z, group, pBigMat, J_q, dims, beta, offset, step_size, sig_g, family, link, init, phi, XZ_group, K, penalty, params, trace)); - return rcpp_result_gen; -END_RCPP -} -// soft_thresh -double soft_thresh(double zeta, double lambda); -RcppExport SEXP _glmmPen_soft_thresh(SEXP zetaSEXP, SEXP lambdaSEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< double >::type zeta(zetaSEXP); - Rcpp::traits::input_parameter< double >::type lambda(lambdaSEXP); - rcpp_result_gen = Rcpp::wrap(soft_thresh(zeta, lambda)); - return rcpp_result_gen; -END_RCPP -} -// MCP_soln -double MCP_soln(double zeta, double nu, double lambda, double gamma, double alpha); -RcppExport SEXP _glmmPen_MCP_soln(SEXP zetaSEXP, SEXP nuSEXP, SEXP lambdaSEXP, SEXP gammaSEXP, SEXP alphaSEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< double >::type zeta(zetaSEXP); - Rcpp::traits::input_parameter< double >::type nu(nuSEXP); - Rcpp::traits::input_parameter< double >::type lambda(lambdaSEXP); - Rcpp::traits::input_parameter< double >::type gamma(gammaSEXP); - Rcpp::traits::input_parameter< double >::type alpha(alphaSEXP); - rcpp_result_gen = Rcpp::wrap(MCP_soln(zeta, nu, lambda, gamma, alpha)); - return rcpp_result_gen; -END_RCPP -} -// SCAD_soln -double SCAD_soln(double zeta, double nu, double lambda, double gamma, double alpha); -RcppExport SEXP _glmmPen_SCAD_soln(SEXP zetaSEXP, SEXP nuSEXP, SEXP lambdaSEXP, SEXP gammaSEXP, SEXP alphaSEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< double >::type zeta(zetaSEXP); - Rcpp::traits::input_parameter< double >::type nu(nuSEXP); - Rcpp::traits::input_parameter< double >::type lambda(lambdaSEXP); - Rcpp::traits::input_parameter< double >::type gamma(gammaSEXP); - Rcpp::traits::input_parameter< double >::type alpha(alphaSEXP); - rcpp_result_gen = Rcpp::wrap(SCAD_soln(zeta, nu, lambda, gamma, alpha)); - return rcpp_result_gen; -END_RCPP -} -// pglm_fit -arma::vec pglm_fit(arma::vec y, arma::mat X, arma::vec dims, arma::vec beta, arma::vec offset, const char* family, int link, const char* penalty, arma::vec params, arma::vec penalty_factor, int trace); -RcppExport SEXP _glmmPen_pglm_fit(SEXP ySEXP, SEXP XSEXP, SEXP dimsSEXP, SEXP betaSEXP, SEXP offsetSEXP, SEXP familySEXP, SEXP linkSEXP, SEXP penaltySEXP, SEXP paramsSEXP, SEXP penalty_factorSEXP, SEXP traceSEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< arma::vec >::type y(ySEXP); - Rcpp::traits::input_parameter< arma::mat >::type X(XSEXP); - Rcpp::traits::input_parameter< arma::vec >::type dims(dimsSEXP); - Rcpp::traits::input_parameter< arma::vec >::type beta(betaSEXP); - Rcpp::traits::input_parameter< arma::vec >::type offset(offsetSEXP); - Rcpp::traits::input_parameter< const char* >::type family(familySEXP); - Rcpp::traits::input_parameter< int >::type link(linkSEXP); - Rcpp::traits::input_parameter< const char* >::type penalty(penaltySEXP); - Rcpp::traits::input_parameter< arma::vec >::type params(paramsSEXP); - Rcpp::traits::input_parameter< arma::vec >::type penalty_factor(penalty_factorSEXP); - Rcpp::traits::input_parameter< int >::type trace(traceSEXP); - rcpp_result_gen = Rcpp::wrap(pglm_fit(y, X, dims, beta, offset, family, link, penalty, params, penalty_factor, trace)); - return rcpp_result_gen; -END_RCPP -} -// sample_mc_inner_gibbs -List sample_mc_inner_gibbs(arma::mat f, arma::mat z, arma::vec y, arma::vec t, int NMC, arma::vec u0, const char* family, int link, double phi, double sig_g); -RcppExport SEXP _glmmPen_sample_mc_inner_gibbs(SEXP fSEXP, SEXP zSEXP, SEXP ySEXP, SEXP tSEXP, SEXP NMCSEXP, SEXP u0SEXP, SEXP familySEXP, SEXP linkSEXP, SEXP phiSEXP, SEXP sig_gSEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< arma::mat >::type f(fSEXP); - Rcpp::traits::input_parameter< arma::mat >::type z(zSEXP); - Rcpp::traits::input_parameter< arma::vec >::type y(ySEXP); - Rcpp::traits::input_parameter< arma::vec >::type t(tSEXP); - Rcpp::traits::input_parameter< int >::type NMC(NMCSEXP); - Rcpp::traits::input_parameter< arma::vec >::type u0(u0SEXP); - Rcpp::traits::input_parameter< const char* >::type family(familySEXP); - Rcpp::traits::input_parameter< int >::type link(linkSEXP); - Rcpp::traits::input_parameter< double >::type phi(phiSEXP); - Rcpp::traits::input_parameter< double >::type sig_g(sig_gSEXP); - rcpp_result_gen = Rcpp::wrap(sample_mc_inner_gibbs(f, z, y, t, NMC, u0, family, link, phi, sig_g)); - return rcpp_result_gen; -END_RCPP -} -// sample_mc_gibbs_adapt_rw -arma::mat sample_mc_gibbs_adapt_rw(arma::mat f, arma::mat z, arma::vec y, int NMC, arma::vec u0, arma::rowvec proposal_SD, int batch, int batch_length, int offset, int nMC_burnin, const char* family, int link, double phi, double sig_g); -RcppExport SEXP _glmmPen_sample_mc_gibbs_adapt_rw(SEXP fSEXP, SEXP zSEXP, SEXP ySEXP, SEXP NMCSEXP, SEXP u0SEXP, SEXP proposal_SDSEXP, SEXP batchSEXP, SEXP batch_lengthSEXP, SEXP offsetSEXP, SEXP nMC_burninSEXP, SEXP familySEXP, SEXP linkSEXP, SEXP phiSEXP, SEXP sig_gSEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< arma::mat >::type f(fSEXP); - Rcpp::traits::input_parameter< arma::mat >::type z(zSEXP); - Rcpp::traits::input_parameter< arma::vec >::type y(ySEXP); - Rcpp::traits::input_parameter< int >::type NMC(NMCSEXP); - Rcpp::traits::input_parameter< arma::vec >::type u0(u0SEXP); - Rcpp::traits::input_parameter< arma::rowvec >::type proposal_SD(proposal_SDSEXP); - Rcpp::traits::input_parameter< int >::type batch(batchSEXP); - Rcpp::traits::input_parameter< int >::type batch_length(batch_lengthSEXP); - Rcpp::traits::input_parameter< int >::type offset(offsetSEXP); - Rcpp::traits::input_parameter< int >::type nMC_burnin(nMC_burninSEXP); - Rcpp::traits::input_parameter< const char* >::type family(familySEXP); - Rcpp::traits::input_parameter< int >::type link(linkSEXP); - Rcpp::traits::input_parameter< double >::type phi(phiSEXP); - Rcpp::traits::input_parameter< double >::type sig_g(sig_gSEXP); - rcpp_result_gen = Rcpp::wrap(sample_mc_gibbs_adapt_rw(f, z, y, NMC, u0, proposal_SD, batch, batch_length, offset, nMC_burnin, family, link, phi, sig_g)); - return rcpp_result_gen; -END_RCPP -} -// Qfun_FA -double Qfun_FA(const arma::vec& y, const arma::mat& X, const arma::mat& Z, SEXP pBigMat, const arma::vec& group, const arma::sp_mat& J_f, const arma::vec& beta, const arma::vec offset, arma::vec dims, const char* family, int link, double sig_g, double phi); -RcppExport SEXP _glmmPen_Qfun_FA(SEXP ySEXP, SEXP XSEXP, SEXP ZSEXP, SEXP pBigMatSEXP, SEXP groupSEXP, SEXP J_fSEXP, SEXP betaSEXP, SEXP offsetSEXP, SEXP dimsSEXP, SEXP familySEXP, SEXP linkSEXP, SEXP sig_gSEXP, SEXP phiSEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< const arma::vec& >::type y(ySEXP); - Rcpp::traits::input_parameter< const arma::mat& >::type X(XSEXP); - Rcpp::traits::input_parameter< const arma::mat& >::type Z(ZSEXP); - Rcpp::traits::input_parameter< SEXP >::type pBigMat(pBigMatSEXP); - Rcpp::traits::input_parameter< const arma::vec& >::type group(groupSEXP); - Rcpp::traits::input_parameter< const arma::sp_mat& >::type J_f(J_fSEXP); - Rcpp::traits::input_parameter< const arma::vec& >::type beta(betaSEXP); - Rcpp::traits::input_parameter< const arma::vec >::type offset(offsetSEXP); - Rcpp::traits::input_parameter< arma::vec >::type dims(dimsSEXP); - Rcpp::traits::input_parameter< const char* >::type family(familySEXP); - Rcpp::traits::input_parameter< int >::type link(linkSEXP); - Rcpp::traits::input_parameter< double >::type sig_g(sig_gSEXP); - Rcpp::traits::input_parameter< double >::type phi(phiSEXP); - rcpp_result_gen = Rcpp::wrap(Qfun_FA(y, X, Z, pBigMat, group, J_f, beta, offset, dims, family, link, sig_g, phi)); - return rcpp_result_gen; -END_RCPP -} -// sig_gaus_FA -double sig_gaus_FA(const arma::vec& y, const arma::mat& X, const arma::mat& Z, SEXP pBigMat, const arma::vec& group, const arma::sp_mat& J_q, const arma::vec& beta, const arma::vec offset, arma::vec dims, int link); -RcppExport SEXP _glmmPen_sig_gaus_FA(SEXP ySEXP, SEXP XSEXP, SEXP ZSEXP, SEXP pBigMatSEXP, SEXP groupSEXP, SEXP J_qSEXP, SEXP betaSEXP, SEXP offsetSEXP, SEXP dimsSEXP, SEXP linkSEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< const arma::vec& >::type y(ySEXP); - Rcpp::traits::input_parameter< const arma::mat& >::type X(XSEXP); - Rcpp::traits::input_parameter< const arma::mat& >::type Z(ZSEXP); - Rcpp::traits::input_parameter< SEXP >::type pBigMat(pBigMatSEXP); - Rcpp::traits::input_parameter< const arma::vec& >::type group(groupSEXP); - Rcpp::traits::input_parameter< const arma::sp_mat& >::type J_q(J_qSEXP); - Rcpp::traits::input_parameter< const arma::vec& >::type beta(betaSEXP); - Rcpp::traits::input_parameter< const arma::vec >::type offset(offsetSEXP); - Rcpp::traits::input_parameter< arma::vec >::type dims(dimsSEXP); - Rcpp::traits::input_parameter< int >::type link(linkSEXP); - rcpp_result_gen = Rcpp::wrap(sig_gaus_FA(y, X, Z, pBigMat, group, J_q, beta, offset, dims, link)); - return rcpp_result_gen; -END_RCPP -} -// invlink -arma::vec invlink(int link, arma::vec eta); -RcppExport SEXP _glmmPen_invlink(SEXP linkSEXP, SEXP etaSEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< int >::type link(linkSEXP); - Rcpp::traits::input_parameter< arma::vec >::type eta(etaSEXP); - rcpp_result_gen = Rcpp::wrap(invlink(link, eta)); - return rcpp_result_gen; -END_RCPP -} -// Qfun -double Qfun(const arma::vec& y, const arma::mat& X, const arma::mat& Z, SEXP pBigMat, const arma::vec& group, const arma::sp_mat& J_q, const arma::vec& beta, const arma::vec offset, arma::vec dims, const char* family, int link, double sig_g, double phi); -RcppExport SEXP _glmmPen_Qfun(SEXP ySEXP, SEXP XSEXP, SEXP ZSEXP, SEXP pBigMatSEXP, SEXP groupSEXP, SEXP J_qSEXP, SEXP betaSEXP, SEXP offsetSEXP, SEXP dimsSEXP, SEXP familySEXP, SEXP linkSEXP, SEXP sig_gSEXP, SEXP phiSEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< const arma::vec& >::type y(ySEXP); - Rcpp::traits::input_parameter< const arma::mat& >::type X(XSEXP); - Rcpp::traits::input_parameter< const arma::mat& >::type Z(ZSEXP); - Rcpp::traits::input_parameter< SEXP >::type pBigMat(pBigMatSEXP); - Rcpp::traits::input_parameter< const arma::vec& >::type group(groupSEXP); - Rcpp::traits::input_parameter< const arma::sp_mat& >::type J_q(J_qSEXP); - Rcpp::traits::input_parameter< const arma::vec& >::type beta(betaSEXP); - Rcpp::traits::input_parameter< const arma::vec >::type offset(offsetSEXP); - Rcpp::traits::input_parameter< arma::vec >::type dims(dimsSEXP); - Rcpp::traits::input_parameter< const char* >::type family(familySEXP); - Rcpp::traits::input_parameter< int >::type link(linkSEXP); - Rcpp::traits::input_parameter< double >::type sig_g(sig_gSEXP); - Rcpp::traits::input_parameter< double >::type phi(phiSEXP); - rcpp_result_gen = Rcpp::wrap(Qfun(y, X, Z, pBigMat, group, J_q, beta, offset, dims, family, link, sig_g, phi)); - return rcpp_result_gen; -END_RCPP -} -// sig_gaus -double sig_gaus(const arma::vec& y, const arma::mat& X, const arma::mat& Z, SEXP pBigMat, const arma::vec& group, const arma::sp_mat& J_q, const arma::vec& beta, const arma::vec offset, arma::vec dims, int link); -RcppExport SEXP _glmmPen_sig_gaus(SEXP ySEXP, SEXP XSEXP, SEXP ZSEXP, SEXP pBigMatSEXP, SEXP groupSEXP, SEXP J_qSEXP, SEXP betaSEXP, SEXP offsetSEXP, SEXP dimsSEXP, SEXP linkSEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< const arma::vec& >::type y(ySEXP); - Rcpp::traits::input_parameter< const arma::mat& >::type X(XSEXP); - Rcpp::traits::input_parameter< const arma::mat& >::type Z(ZSEXP); - Rcpp::traits::input_parameter< SEXP >::type pBigMat(pBigMatSEXP); - Rcpp::traits::input_parameter< const arma::vec& >::type group(groupSEXP); - Rcpp::traits::input_parameter< const arma::sp_mat& >::type J_q(J_qSEXP); - Rcpp::traits::input_parameter< const arma::vec& >::type beta(betaSEXP); - Rcpp::traits::input_parameter< const arma::vec >::type offset(offsetSEXP); - Rcpp::traits::input_parameter< arma::vec >::type dims(dimsSEXP); - Rcpp::traits::input_parameter< int >::type link(linkSEXP); - rcpp_result_gen = Rcpp::wrap(sig_gaus(y, X, Z, pBigMat, group, J_q, beta, offset, dims, link)); - return rcpp_result_gen; -END_RCPP -} -// phi_ml -double phi_ml(arma::vec y, arma::mat eta, int link, int limit, double eps, double phi); -RcppExport SEXP _glmmPen_phi_ml(SEXP ySEXP, SEXP etaSEXP, SEXP linkSEXP, SEXP limitSEXP, SEXP epsSEXP, SEXP phiSEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< arma::vec >::type y(ySEXP); - Rcpp::traits::input_parameter< arma::mat >::type eta(etaSEXP); - Rcpp::traits::input_parameter< int >::type link(linkSEXP); - Rcpp::traits::input_parameter< int >::type limit(limitSEXP); - Rcpp::traits::input_parameter< double >::type eps(epsSEXP); - Rcpp::traits::input_parameter< double >::type phi(phiSEXP); - rcpp_result_gen = Rcpp::wrap(phi_ml(y, eta, link, limit, eps, phi)); - return rcpp_result_gen; -END_RCPP -} -// phi_ml_init -double phi_ml_init(arma::vec y, arma::vec eta, int link, int limit, double eps); -RcppExport SEXP _glmmPen_phi_ml_init(SEXP ySEXP, SEXP etaSEXP, SEXP linkSEXP, SEXP limitSEXP, SEXP epsSEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< arma::vec >::type y(ySEXP); - Rcpp::traits::input_parameter< arma::vec >::type eta(etaSEXP); - Rcpp::traits::input_parameter< int >::type link(linkSEXP); - Rcpp::traits::input_parameter< int >::type limit(limitSEXP); - Rcpp::traits::input_parameter< double >::type eps(epsSEXP); - rcpp_result_gen = Rcpp::wrap(phi_ml_init(y, eta, link, limit, eps)); - return rcpp_result_gen; -END_RCPP -} -// Qfun_quad_beta -double Qfun_quad_beta(double Q0, double step_size, const arma::mat& diff0, const arma::mat& eta, const arma::mat& eta0, const arma::vec& beta, const arma::vec& beta0); -RcppExport SEXP _glmmPen_Qfun_quad_beta(SEXP Q0SEXP, SEXP step_sizeSEXP, SEXP diff0SEXP, SEXP etaSEXP, SEXP eta0SEXP, SEXP betaSEXP, SEXP beta0SEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< double >::type Q0(Q0SEXP); - Rcpp::traits::input_parameter< double >::type step_size(step_sizeSEXP); - Rcpp::traits::input_parameter< const arma::mat& >::type diff0(diff0SEXP); - Rcpp::traits::input_parameter< const arma::mat& >::type eta(etaSEXP); - Rcpp::traits::input_parameter< const arma::mat& >::type eta0(eta0SEXP); - Rcpp::traits::input_parameter< const arma::vec& >::type beta(betaSEXP); - Rcpp::traits::input_parameter< const arma::vec& >::type beta0(beta0SEXP); - rcpp_result_gen = Rcpp::wrap(Qfun_quad_beta(Q0, step_size, diff0, eta, eta0, beta, beta0)); - return rcpp_result_gen; -END_RCPP -} - -RcppExport SEXP _rcpp_module_boot_stan_fit4binomial_logit_model_mod(); -RcppExport SEXP _rcpp_module_boot_stan_fit4gaussian_identity_model_mod(); -RcppExport SEXP _rcpp_module_boot_stan_fit4poisson_log_model_mod(); - -static const R_CallMethodDef CallEntries[] = { - {"_glmmPen_grp_CD_XZ_FA_step", (DL_FUNC) &_glmmPen_grp_CD_XZ_FA_step, 20}, - {"_glmmPen_grp_CD_XZ_step", (DL_FUNC) &_glmmPen_grp_CD_XZ_step, 20}, - {"_glmmPen_soft_thresh", (DL_FUNC) &_glmmPen_soft_thresh, 2}, - {"_glmmPen_MCP_soln", (DL_FUNC) &_glmmPen_MCP_soln, 5}, - {"_glmmPen_SCAD_soln", (DL_FUNC) &_glmmPen_SCAD_soln, 5}, - {"_glmmPen_pglm_fit", (DL_FUNC) &_glmmPen_pglm_fit, 11}, - {"_glmmPen_sample_mc_inner_gibbs", (DL_FUNC) &_glmmPen_sample_mc_inner_gibbs, 10}, - {"_glmmPen_sample_mc_gibbs_adapt_rw", (DL_FUNC) &_glmmPen_sample_mc_gibbs_adapt_rw, 14}, - {"_glmmPen_Qfun_FA", (DL_FUNC) &_glmmPen_Qfun_FA, 13}, - {"_glmmPen_sig_gaus_FA", (DL_FUNC) &_glmmPen_sig_gaus_FA, 10}, - {"_glmmPen_invlink", (DL_FUNC) &_glmmPen_invlink, 2}, - {"_glmmPen_Qfun", (DL_FUNC) &_glmmPen_Qfun, 13}, - {"_glmmPen_sig_gaus", (DL_FUNC) &_glmmPen_sig_gaus, 10}, - {"_glmmPen_phi_ml", (DL_FUNC) &_glmmPen_phi_ml, 6}, - {"_glmmPen_phi_ml_init", (DL_FUNC) &_glmmPen_phi_ml_init, 5}, - {"_glmmPen_Qfun_quad_beta", (DL_FUNC) &_glmmPen_Qfun_quad_beta, 7}, - {"_rcpp_module_boot_stan_fit4binomial_logit_model_mod", (DL_FUNC) &_rcpp_module_boot_stan_fit4binomial_logit_model_mod, 0}, - {"_rcpp_module_boot_stan_fit4gaussian_identity_model_mod", (DL_FUNC) &_rcpp_module_boot_stan_fit4gaussian_identity_model_mod, 0}, - {"_rcpp_module_boot_stan_fit4poisson_log_model_mod", (DL_FUNC) &_rcpp_module_boot_stan_fit4poisson_log_model_mod, 0}, - {NULL, NULL, 0} -}; - -RcppExport void R_init_glmmPen(DllInfo *dll) { - R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); - R_useDynamicSymbols(dll, FALSE); -} diff --git a/src/stanExports_binomial_logit_model.cc b/src/stanExports_binomial_logit_model.cc deleted file mode 100644 index 353f9e0..0000000 --- a/src/stanExports_binomial_logit_model.cc +++ /dev/null @@ -1,32 +0,0 @@ -// Generated by rstantools. Do not edit by hand. - -#include -using namespace Rcpp ; -#include "stanExports_binomial_logit_model.h" - -RCPP_MODULE(stan_fit4binomial_logit_model_mod) { - - - class_ >("model_binomial_logit_model") - - .constructor() - - - .method("call_sampler", &rstan::stan_fit ::call_sampler) - .method("param_names", &rstan::stan_fit ::param_names) - .method("param_names_oi", &rstan::stan_fit ::param_names_oi) - .method("param_fnames_oi", &rstan::stan_fit ::param_fnames_oi) - .method("param_dims", &rstan::stan_fit ::param_dims) - .method("param_dims_oi", &rstan::stan_fit ::param_dims_oi) - .method("update_param_oi", &rstan::stan_fit ::update_param_oi) - .method("param_oi_tidx", &rstan::stan_fit ::param_oi_tidx) - .method("grad_log_prob", &rstan::stan_fit ::grad_log_prob) - .method("log_prob", &rstan::stan_fit ::log_prob) - .method("unconstrain_pars", &rstan::stan_fit ::unconstrain_pars) - .method("constrain_pars", &rstan::stan_fit ::constrain_pars) - .method("num_pars_unconstrained", &rstan::stan_fit ::num_pars_unconstrained) - .method("unconstrained_param_names", &rstan::stan_fit ::unconstrained_param_names) - .method("constrained_param_names", &rstan::stan_fit ::constrained_param_names) - .method("standalone_gqs", &rstan::stan_fit ::standalone_gqs) - ; -} diff --git a/src/stanExports_binomial_logit_model.h b/src/stanExports_binomial_logit_model.h deleted file mode 100644 index 087e874..0000000 --- a/src/stanExports_binomial_logit_model.h +++ /dev/null @@ -1,336 +0,0 @@ -// Generated by rstantools. Do not edit by hand. - -/* - glmmPen is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - glmmPen is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with glmmPen. If not, see . -*/ -#ifndef MODELS_HPP -#define MODELS_HPP -#define STAN__SERVICES__COMMAND_HPP -#include -// Code generated by Stan version 2.21.0 -#include -namespace model_binomial_logit_model_namespace { -using std::istream; -using std::string; -using std::stringstream; -using std::vector; -using stan::io::dump; -using stan::math::lgamma; -using stan::model::prob_grad; -using namespace stan::math; -static int current_statement_begin__; -stan::io::program_reader prog_reader__() { - stan::io::program_reader reader; - reader.add_event(0, 0, "start", "model_binomial_logit_model"); - reader.add_event(18, 16, "end", "model_binomial_logit_model"); - return reader; -} -#include -class model_binomial_logit_model - : public stan::model::model_base_crtp { -private: - int N; - int q; - vector_d eta_fef; - std::vector y; - matrix_d Z; -public: - model_binomial_logit_model(stan::io::var_context& context__, - std::ostream* pstream__ = 0) - : model_base_crtp(0) { - ctor_body(context__, 0, pstream__); - } - model_binomial_logit_model(stan::io::var_context& context__, - unsigned int random_seed__, - std::ostream* pstream__ = 0) - : model_base_crtp(0) { - ctor_body(context__, random_seed__, pstream__); - } - void ctor_body(stan::io::var_context& context__, - unsigned int random_seed__, - std::ostream* pstream__) { - typedef double local_scalar_t__; - boost::ecuyer1988 base_rng__ = - stan::services::util::create_rng(random_seed__, 0); - (void) base_rng__; // suppress unused var warning - current_statement_begin__ = -1; - static const char* function__ = "model_binomial_logit_model_namespace::model_binomial_logit_model"; - (void) function__; // dummy to suppress unused var warning - size_t pos__; - (void) pos__; // dummy to suppress unused var warning - std::vector vals_i__; - std::vector vals_r__; - local_scalar_t__ DUMMY_VAR__(std::numeric_limits::quiet_NaN()); - (void) DUMMY_VAR__; // suppress unused var warning - try { - // initialize data block variables from context__ - current_statement_begin__ = 2; - context__.validate_dims("data initialization", "N", "int", context__.to_vec()); - N = int(0); - vals_i__ = context__.vals_i("N"); - pos__ = 0; - N = vals_i__[pos__++]; - check_greater_or_equal(function__, "N", N, 0); - current_statement_begin__ = 3; - context__.validate_dims("data initialization", "q", "int", context__.to_vec()); - q = int(0); - vals_i__ = context__.vals_i("q"); - pos__ = 0; - q = vals_i__[pos__++]; - check_greater_or_equal(function__, "q", q, 0); - current_statement_begin__ = 4; - validate_non_negative_index("eta_fef", "N", N); - context__.validate_dims("data initialization", "eta_fef", "vector_d", context__.to_vec(N)); - eta_fef = Eigen::Matrix(N); - vals_r__ = context__.vals_r("eta_fef"); - pos__ = 0; - size_t eta_fef_j_1_max__ = N; - for (size_t j_1__ = 0; j_1__ < eta_fef_j_1_max__; ++j_1__) { - eta_fef(j_1__) = vals_r__[pos__++]; - } - current_statement_begin__ = 5; - validate_non_negative_index("y", "N", N); - context__.validate_dims("data initialization", "y", "int", context__.to_vec(N)); - y = std::vector(N, int(0)); - vals_i__ = context__.vals_i("y"); - pos__ = 0; - size_t y_k_0_max__ = N; - for (size_t k_0__ = 0; k_0__ < y_k_0_max__; ++k_0__) { - y[k_0__] = vals_i__[pos__++]; - } - size_t y_i_0_max__ = N; - for (size_t i_0__ = 0; i_0__ < y_i_0_max__; ++i_0__) { - check_greater_or_equal(function__, "y[i_0__]", y[i_0__], 0); - check_less_or_equal(function__, "y[i_0__]", y[i_0__], 1); - } - current_statement_begin__ = 6; - validate_non_negative_index("Z", "N", N); - validate_non_negative_index("Z", "q", q); - context__.validate_dims("data initialization", "Z", "matrix_d", context__.to_vec(N,q)); - Z = Eigen::Matrix(N, q); - vals_r__ = context__.vals_r("Z"); - pos__ = 0; - size_t Z_j_2_max__ = q; - size_t Z_j_1_max__ = N; - for (size_t j_2__ = 0; j_2__ < Z_j_2_max__; ++j_2__) { - for (size_t j_1__ = 0; j_1__ < Z_j_1_max__; ++j_1__) { - Z(j_1__, j_2__) = vals_r__[pos__++]; - } - } - // initialize transformed data variables - // execute transformed data statements - // validate transformed data - // validate, set parameter ranges - num_params_r__ = 0U; - param_ranges_i__.clear(); - current_statement_begin__ = 10; - validate_non_negative_index("alpha", "q", q); - num_params_r__ += q; - } catch (const std::exception& e) { - stan::lang::rethrow_located(e, current_statement_begin__, prog_reader__()); - // Next line prevents compiler griping about no return - throw std::runtime_error("*** IF YOU SEE THIS, PLEASE REPORT A BUG ***"); - } - } - ~model_binomial_logit_model() { } - void transform_inits(const stan::io::var_context& context__, - std::vector& params_i__, - std::vector& params_r__, - std::ostream* pstream__) const { - typedef double local_scalar_t__; - stan::io::writer writer__(params_r__, params_i__); - size_t pos__; - (void) pos__; // dummy call to supress warning - std::vector vals_r__; - std::vector vals_i__; - current_statement_begin__ = 10; - if (!(context__.contains_r("alpha"))) - stan::lang::rethrow_located(std::runtime_error(std::string("Variable alpha missing")), current_statement_begin__, prog_reader__()); - vals_r__ = context__.vals_r("alpha"); - pos__ = 0U; - validate_non_negative_index("alpha", "q", q); - context__.validate_dims("parameter initialization", "alpha", "vector_d", context__.to_vec(q)); - Eigen::Matrix alpha(q); - size_t alpha_j_1_max__ = q; - for (size_t j_1__ = 0; j_1__ < alpha_j_1_max__; ++j_1__) { - alpha(j_1__) = vals_r__[pos__++]; - } - try { - writer__.vector_unconstrain(alpha); - } catch (const std::exception& e) { - stan::lang::rethrow_located(std::runtime_error(std::string("Error transforming variable alpha: ") + e.what()), current_statement_begin__, prog_reader__()); - } - params_r__ = writer__.data_r(); - params_i__ = writer__.data_i(); - } - void transform_inits(const stan::io::var_context& context, - Eigen::Matrix& params_r, - std::ostream* pstream__) const { - std::vector params_r_vec; - std::vector params_i_vec; - transform_inits(context, params_i_vec, params_r_vec, pstream__); - params_r.resize(params_r_vec.size()); - for (int i = 0; i < params_r.size(); ++i) - params_r(i) = params_r_vec[i]; - } - template - T__ log_prob(std::vector& params_r__, - std::vector& params_i__, - std::ostream* pstream__ = 0) const { - typedef T__ local_scalar_t__; - local_scalar_t__ DUMMY_VAR__(std::numeric_limits::quiet_NaN()); - (void) DUMMY_VAR__; // dummy to suppress unused var warning - T__ lp__(0.0); - stan::math::accumulator lp_accum__; - try { - stan::io::reader in__(params_r__, params_i__); - // model parameters - current_statement_begin__ = 10; - Eigen::Matrix alpha; - (void) alpha; // dummy to suppress unused var warning - if (jacobian__) - alpha = in__.vector_constrain(q, lp__); - else - alpha = in__.vector_constrain(q); - // model body - current_statement_begin__ = 14; - lp_accum__.add(normal_log(alpha, 0, 1)); - current_statement_begin__ = 15; - lp_accum__.add(bernoulli_logit_log(y, add(eta_fef, multiply(Z, alpha)))); - } catch (const std::exception& e) { - stan::lang::rethrow_located(e, current_statement_begin__, prog_reader__()); - // Next line prevents compiler griping about no return - throw std::runtime_error("*** IF YOU SEE THIS, PLEASE REPORT A BUG ***"); - } - lp_accum__.add(lp__); - return lp_accum__.sum(); - } // log_prob() - template - T_ log_prob(Eigen::Matrix& params_r, - std::ostream* pstream = 0) const { - std::vector vec_params_r; - vec_params_r.reserve(params_r.size()); - for (int i = 0; i < params_r.size(); ++i) - vec_params_r.push_back(params_r(i)); - std::vector vec_params_i; - return log_prob(vec_params_r, vec_params_i, pstream); - } - void get_param_names(std::vector& names__) const { - names__.resize(0); - names__.push_back("alpha"); - } - void get_dims(std::vector >& dimss__) const { - dimss__.resize(0); - std::vector dims__; - dims__.resize(0); - dims__.push_back(q); - dimss__.push_back(dims__); - } - template - void write_array(RNG& base_rng__, - std::vector& params_r__, - std::vector& params_i__, - std::vector& vars__, - bool include_tparams__ = true, - bool include_gqs__ = true, - std::ostream* pstream__ = 0) const { - typedef double local_scalar_t__; - vars__.resize(0); - stan::io::reader in__(params_r__, params_i__); - static const char* function__ = "model_binomial_logit_model_namespace::write_array"; - (void) function__; // dummy to suppress unused var warning - // read-transform, write parameters - Eigen::Matrix alpha = in__.vector_constrain(q); - size_t alpha_j_1_max__ = q; - for (size_t j_1__ = 0; j_1__ < alpha_j_1_max__; ++j_1__) { - vars__.push_back(alpha(j_1__)); - } - double lp__ = 0.0; - (void) lp__; // dummy to suppress unused var warning - stan::math::accumulator lp_accum__; - local_scalar_t__ DUMMY_VAR__(std::numeric_limits::quiet_NaN()); - (void) DUMMY_VAR__; // suppress unused var warning - if (!include_tparams__ && !include_gqs__) return; - try { - if (!include_gqs__ && !include_tparams__) return; - if (!include_gqs__) return; - } catch (const std::exception& e) { - stan::lang::rethrow_located(e, current_statement_begin__, prog_reader__()); - // Next line prevents compiler griping about no return - throw std::runtime_error("*** IF YOU SEE THIS, PLEASE REPORT A BUG ***"); - } - } - template - void write_array(RNG& base_rng, - Eigen::Matrix& params_r, - Eigen::Matrix& vars, - bool include_tparams = true, - bool include_gqs = true, - std::ostream* pstream = 0) const { - std::vector params_r_vec(params_r.size()); - for (int i = 0; i < params_r.size(); ++i) - params_r_vec[i] = params_r(i); - std::vector vars_vec; - std::vector params_i_vec; - write_array(base_rng, params_r_vec, params_i_vec, vars_vec, include_tparams, include_gqs, pstream); - vars.resize(vars_vec.size()); - for (int i = 0; i < vars.size(); ++i) - vars(i) = vars_vec[i]; - } - std::string model_name() const { - return "model_binomial_logit_model"; - } - void constrained_param_names(std::vector& param_names__, - bool include_tparams__ = true, - bool include_gqs__ = true) const { - std::stringstream param_name_stream__; - size_t alpha_j_1_max__ = q; - for (size_t j_1__ = 0; j_1__ < alpha_j_1_max__; ++j_1__) { - param_name_stream__.str(std::string()); - param_name_stream__ << "alpha" << '.' << j_1__ + 1; - param_names__.push_back(param_name_stream__.str()); - } - if (!include_gqs__ && !include_tparams__) return; - if (include_tparams__) { - } - if (!include_gqs__) return; - } - void unconstrained_param_names(std::vector& param_names__, - bool include_tparams__ = true, - bool include_gqs__ = true) const { - std::stringstream param_name_stream__; - size_t alpha_j_1_max__ = q; - for (size_t j_1__ = 0; j_1__ < alpha_j_1_max__; ++j_1__) { - param_name_stream__.str(std::string()); - param_name_stream__ << "alpha" << '.' << j_1__ + 1; - param_names__.push_back(param_name_stream__.str()); - } - if (!include_gqs__ && !include_tparams__) return; - if (include_tparams__) { - } - if (!include_gqs__) return; - } -}; // model -} // namespace -typedef model_binomial_logit_model_namespace::model_binomial_logit_model stan_model; -#ifndef USING_R -stan::model::model_base& new_model( - stan::io::var_context& data_context, - unsigned int seed, - std::ostream* msg_stream) { - stan_model* m = new stan_model(data_context, seed, msg_stream); - return *m; -} -#endif -#endif diff --git a/src/stanExports_gaussian_identity_model.cc b/src/stanExports_gaussian_identity_model.cc deleted file mode 100644 index 9ec14d7..0000000 --- a/src/stanExports_gaussian_identity_model.cc +++ /dev/null @@ -1,32 +0,0 @@ -// Generated by rstantools. Do not edit by hand. - -#include -using namespace Rcpp ; -#include "stanExports_gaussian_identity_model.h" - -RCPP_MODULE(stan_fit4gaussian_identity_model_mod) { - - - class_ >("model_gaussian_identity_model") - - .constructor() - - - .method("call_sampler", &rstan::stan_fit ::call_sampler) - .method("param_names", &rstan::stan_fit ::param_names) - .method("param_names_oi", &rstan::stan_fit ::param_names_oi) - .method("param_fnames_oi", &rstan::stan_fit ::param_fnames_oi) - .method("param_dims", &rstan::stan_fit ::param_dims) - .method("param_dims_oi", &rstan::stan_fit ::param_dims_oi) - .method("update_param_oi", &rstan::stan_fit ::update_param_oi) - .method("param_oi_tidx", &rstan::stan_fit ::param_oi_tidx) - .method("grad_log_prob", &rstan::stan_fit ::grad_log_prob) - .method("log_prob", &rstan::stan_fit ::log_prob) - .method("unconstrain_pars", &rstan::stan_fit ::unconstrain_pars) - .method("constrain_pars", &rstan::stan_fit ::constrain_pars) - .method("num_pars_unconstrained", &rstan::stan_fit ::num_pars_unconstrained) - .method("unconstrained_param_names", &rstan::stan_fit ::unconstrained_param_names) - .method("constrained_param_names", &rstan::stan_fit ::constrained_param_names) - .method("standalone_gqs", &rstan::stan_fit ::standalone_gqs) - ; -} diff --git a/src/stanExports_gaussian_identity_model.h b/src/stanExports_gaussian_identity_model.h deleted file mode 100644 index f34dc9c..0000000 --- a/src/stanExports_gaussian_identity_model.h +++ /dev/null @@ -1,339 +0,0 @@ -// Generated by rstantools. Do not edit by hand. - -/* - glmmPen is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - glmmPen is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with glmmPen. If not, see . -*/ -#ifndef MODELS_HPP -#define MODELS_HPP -#define STAN__SERVICES__COMMAND_HPP -#include -// Code generated by Stan version 2.21.0 -#include -namespace model_gaussian_identity_model_namespace { -using std::istream; -using std::string; -using std::stringstream; -using std::vector; -using stan::io::dump; -using stan::math::lgamma; -using stan::model::prob_grad; -using namespace stan::math; -static int current_statement_begin__; -stan::io::program_reader prog_reader__() { - stan::io::program_reader reader; - reader.add_event(0, 0, "start", "model_gaussian_identity_model"); - reader.add_event(20, 18, "end", "model_gaussian_identity_model"); - return reader; -} -#include -class model_gaussian_identity_model - : public stan::model::model_base_crtp { -private: - int N; - int q; - vector_d eta_fef; - std::vector y; - matrix_d Z; - double sigma; -public: - model_gaussian_identity_model(stan::io::var_context& context__, - std::ostream* pstream__ = 0) - : model_base_crtp(0) { - ctor_body(context__, 0, pstream__); - } - model_gaussian_identity_model(stan::io::var_context& context__, - unsigned int random_seed__, - std::ostream* pstream__ = 0) - : model_base_crtp(0) { - ctor_body(context__, random_seed__, pstream__); - } - void ctor_body(stan::io::var_context& context__, - unsigned int random_seed__, - std::ostream* pstream__) { - typedef double local_scalar_t__; - boost::ecuyer1988 base_rng__ = - stan::services::util::create_rng(random_seed__, 0); - (void) base_rng__; // suppress unused var warning - current_statement_begin__ = -1; - static const char* function__ = "model_gaussian_identity_model_namespace::model_gaussian_identity_model"; - (void) function__; // dummy to suppress unused var warning - size_t pos__; - (void) pos__; // dummy to suppress unused var warning - std::vector vals_i__; - std::vector vals_r__; - local_scalar_t__ DUMMY_VAR__(std::numeric_limits::quiet_NaN()); - (void) DUMMY_VAR__; // suppress unused var warning - try { - // initialize data block variables from context__ - current_statement_begin__ = 2; - context__.validate_dims("data initialization", "N", "int", context__.to_vec()); - N = int(0); - vals_i__ = context__.vals_i("N"); - pos__ = 0; - N = vals_i__[pos__++]; - check_greater_or_equal(function__, "N", N, 0); - current_statement_begin__ = 3; - context__.validate_dims("data initialization", "q", "int", context__.to_vec()); - q = int(0); - vals_i__ = context__.vals_i("q"); - pos__ = 0; - q = vals_i__[pos__++]; - check_greater_or_equal(function__, "q", q, 0); - current_statement_begin__ = 4; - validate_non_negative_index("eta_fef", "N", N); - context__.validate_dims("data initialization", "eta_fef", "vector_d", context__.to_vec(N)); - eta_fef = Eigen::Matrix(N); - vals_r__ = context__.vals_r("eta_fef"); - pos__ = 0; - size_t eta_fef_j_1_max__ = N; - for (size_t j_1__ = 0; j_1__ < eta_fef_j_1_max__; ++j_1__) { - eta_fef(j_1__) = vals_r__[pos__++]; - } - current_statement_begin__ = 5; - validate_non_negative_index("y", "N", N); - context__.validate_dims("data initialization", "y", "double", context__.to_vec(N)); - y = std::vector(N, double(0)); - vals_r__ = context__.vals_r("y"); - pos__ = 0; - size_t y_k_0_max__ = N; - for (size_t k_0__ = 0; k_0__ < y_k_0_max__; ++k_0__) { - y[k_0__] = vals_r__[pos__++]; - } - current_statement_begin__ = 6; - validate_non_negative_index("Z", "N", N); - validate_non_negative_index("Z", "q", q); - context__.validate_dims("data initialization", "Z", "matrix_d", context__.to_vec(N,q)); - Z = Eigen::Matrix(N, q); - vals_r__ = context__.vals_r("Z"); - pos__ = 0; - size_t Z_j_2_max__ = q; - size_t Z_j_1_max__ = N; - for (size_t j_2__ = 0; j_2__ < Z_j_2_max__; ++j_2__) { - for (size_t j_1__ = 0; j_1__ < Z_j_1_max__; ++j_1__) { - Z(j_1__, j_2__) = vals_r__[pos__++]; - } - } - current_statement_begin__ = 7; - context__.validate_dims("data initialization", "sigma", "double", context__.to_vec()); - sigma = double(0); - vals_r__ = context__.vals_r("sigma"); - pos__ = 0; - sigma = vals_r__[pos__++]; - check_greater_or_equal(function__, "sigma", sigma, 0); - // initialize transformed data variables - // execute transformed data statements - // validate transformed data - // validate, set parameter ranges - num_params_r__ = 0U; - param_ranges_i__.clear(); - current_statement_begin__ = 11; - validate_non_negative_index("alpha", "q", q); - num_params_r__ += q; - } catch (const std::exception& e) { - stan::lang::rethrow_located(e, current_statement_begin__, prog_reader__()); - // Next line prevents compiler griping about no return - throw std::runtime_error("*** IF YOU SEE THIS, PLEASE REPORT A BUG ***"); - } - } - ~model_gaussian_identity_model() { } - void transform_inits(const stan::io::var_context& context__, - std::vector& params_i__, - std::vector& params_r__, - std::ostream* pstream__) const { - typedef double local_scalar_t__; - stan::io::writer writer__(params_r__, params_i__); - size_t pos__; - (void) pos__; // dummy call to supress warning - std::vector vals_r__; - std::vector vals_i__; - current_statement_begin__ = 11; - if (!(context__.contains_r("alpha"))) - stan::lang::rethrow_located(std::runtime_error(std::string("Variable alpha missing")), current_statement_begin__, prog_reader__()); - vals_r__ = context__.vals_r("alpha"); - pos__ = 0U; - validate_non_negative_index("alpha", "q", q); - context__.validate_dims("parameter initialization", "alpha", "vector_d", context__.to_vec(q)); - Eigen::Matrix alpha(q); - size_t alpha_j_1_max__ = q; - for (size_t j_1__ = 0; j_1__ < alpha_j_1_max__; ++j_1__) { - alpha(j_1__) = vals_r__[pos__++]; - } - try { - writer__.vector_unconstrain(alpha); - } catch (const std::exception& e) { - stan::lang::rethrow_located(std::runtime_error(std::string("Error transforming variable alpha: ") + e.what()), current_statement_begin__, prog_reader__()); - } - params_r__ = writer__.data_r(); - params_i__ = writer__.data_i(); - } - void transform_inits(const stan::io::var_context& context, - Eigen::Matrix& params_r, - std::ostream* pstream__) const { - std::vector params_r_vec; - std::vector params_i_vec; - transform_inits(context, params_i_vec, params_r_vec, pstream__); - params_r.resize(params_r_vec.size()); - for (int i = 0; i < params_r.size(); ++i) - params_r(i) = params_r_vec[i]; - } - template - T__ log_prob(std::vector& params_r__, - std::vector& params_i__, - std::ostream* pstream__ = 0) const { - typedef T__ local_scalar_t__; - local_scalar_t__ DUMMY_VAR__(std::numeric_limits::quiet_NaN()); - (void) DUMMY_VAR__; // dummy to suppress unused var warning - T__ lp__(0.0); - stan::math::accumulator lp_accum__; - try { - stan::io::reader in__(params_r__, params_i__); - // model parameters - current_statement_begin__ = 11; - Eigen::Matrix alpha; - (void) alpha; // dummy to suppress unused var warning - if (jacobian__) - alpha = in__.vector_constrain(q, lp__); - else - alpha = in__.vector_constrain(q); - // model body - current_statement_begin__ = 15; - lp_accum__.add(normal_log(alpha, 0, 1)); - current_statement_begin__ = 17; - lp_accum__.add(normal_log(y, add(eta_fef, multiply(Z, alpha)), sigma)); - } catch (const std::exception& e) { - stan::lang::rethrow_located(e, current_statement_begin__, prog_reader__()); - // Next line prevents compiler griping about no return - throw std::runtime_error("*** IF YOU SEE THIS, PLEASE REPORT A BUG ***"); - } - lp_accum__.add(lp__); - return lp_accum__.sum(); - } // log_prob() - template - T_ log_prob(Eigen::Matrix& params_r, - std::ostream* pstream = 0) const { - std::vector vec_params_r; - vec_params_r.reserve(params_r.size()); - for (int i = 0; i < params_r.size(); ++i) - vec_params_r.push_back(params_r(i)); - std::vector vec_params_i; - return log_prob(vec_params_r, vec_params_i, pstream); - } - void get_param_names(std::vector& names__) const { - names__.resize(0); - names__.push_back("alpha"); - } - void get_dims(std::vector >& dimss__) const { - dimss__.resize(0); - std::vector dims__; - dims__.resize(0); - dims__.push_back(q); - dimss__.push_back(dims__); - } - template - void write_array(RNG& base_rng__, - std::vector& params_r__, - std::vector& params_i__, - std::vector& vars__, - bool include_tparams__ = true, - bool include_gqs__ = true, - std::ostream* pstream__ = 0) const { - typedef double local_scalar_t__; - vars__.resize(0); - stan::io::reader in__(params_r__, params_i__); - static const char* function__ = "model_gaussian_identity_model_namespace::write_array"; - (void) function__; // dummy to suppress unused var warning - // read-transform, write parameters - Eigen::Matrix alpha = in__.vector_constrain(q); - size_t alpha_j_1_max__ = q; - for (size_t j_1__ = 0; j_1__ < alpha_j_1_max__; ++j_1__) { - vars__.push_back(alpha(j_1__)); - } - double lp__ = 0.0; - (void) lp__; // dummy to suppress unused var warning - stan::math::accumulator lp_accum__; - local_scalar_t__ DUMMY_VAR__(std::numeric_limits::quiet_NaN()); - (void) DUMMY_VAR__; // suppress unused var warning - if (!include_tparams__ && !include_gqs__) return; - try { - if (!include_gqs__ && !include_tparams__) return; - if (!include_gqs__) return; - } catch (const std::exception& e) { - stan::lang::rethrow_located(e, current_statement_begin__, prog_reader__()); - // Next line prevents compiler griping about no return - throw std::runtime_error("*** IF YOU SEE THIS, PLEASE REPORT A BUG ***"); - } - } - template - void write_array(RNG& base_rng, - Eigen::Matrix& params_r, - Eigen::Matrix& vars, - bool include_tparams = true, - bool include_gqs = true, - std::ostream* pstream = 0) const { - std::vector params_r_vec(params_r.size()); - for (int i = 0; i < params_r.size(); ++i) - params_r_vec[i] = params_r(i); - std::vector vars_vec; - std::vector params_i_vec; - write_array(base_rng, params_r_vec, params_i_vec, vars_vec, include_tparams, include_gqs, pstream); - vars.resize(vars_vec.size()); - for (int i = 0; i < vars.size(); ++i) - vars(i) = vars_vec[i]; - } - std::string model_name() const { - return "model_gaussian_identity_model"; - } - void constrained_param_names(std::vector& param_names__, - bool include_tparams__ = true, - bool include_gqs__ = true) const { - std::stringstream param_name_stream__; - size_t alpha_j_1_max__ = q; - for (size_t j_1__ = 0; j_1__ < alpha_j_1_max__; ++j_1__) { - param_name_stream__.str(std::string()); - param_name_stream__ << "alpha" << '.' << j_1__ + 1; - param_names__.push_back(param_name_stream__.str()); - } - if (!include_gqs__ && !include_tparams__) return; - if (include_tparams__) { - } - if (!include_gqs__) return; - } - void unconstrained_param_names(std::vector& param_names__, - bool include_tparams__ = true, - bool include_gqs__ = true) const { - std::stringstream param_name_stream__; - size_t alpha_j_1_max__ = q; - for (size_t j_1__ = 0; j_1__ < alpha_j_1_max__; ++j_1__) { - param_name_stream__.str(std::string()); - param_name_stream__ << "alpha" << '.' << j_1__ + 1; - param_names__.push_back(param_name_stream__.str()); - } - if (!include_gqs__ && !include_tparams__) return; - if (include_tparams__) { - } - if (!include_gqs__) return; - } -}; // model -} // namespace -typedef model_gaussian_identity_model_namespace::model_gaussian_identity_model stan_model; -#ifndef USING_R -stan::model::model_base& new_model( - stan::io::var_context& data_context, - unsigned int seed, - std::ostream* msg_stream) { - stan_model* m = new stan_model(data_context, seed, msg_stream); - return *m; -} -#endif -#endif diff --git a/src/stanExports_poisson_log_model.cc b/src/stanExports_poisson_log_model.cc deleted file mode 100644 index f850891..0000000 --- a/src/stanExports_poisson_log_model.cc +++ /dev/null @@ -1,32 +0,0 @@ -// Generated by rstantools. Do not edit by hand. - -#include -using namespace Rcpp ; -#include "stanExports_poisson_log_model.h" - -RCPP_MODULE(stan_fit4poisson_log_model_mod) { - - - class_ >("model_poisson_log_model") - - .constructor() - - - .method("call_sampler", &rstan::stan_fit ::call_sampler) - .method("param_names", &rstan::stan_fit ::param_names) - .method("param_names_oi", &rstan::stan_fit ::param_names_oi) - .method("param_fnames_oi", &rstan::stan_fit ::param_fnames_oi) - .method("param_dims", &rstan::stan_fit ::param_dims) - .method("param_dims_oi", &rstan::stan_fit ::param_dims_oi) - .method("update_param_oi", &rstan::stan_fit ::update_param_oi) - .method("param_oi_tidx", &rstan::stan_fit ::param_oi_tidx) - .method("grad_log_prob", &rstan::stan_fit ::grad_log_prob) - .method("log_prob", &rstan::stan_fit ::log_prob) - .method("unconstrain_pars", &rstan::stan_fit ::unconstrain_pars) - .method("constrain_pars", &rstan::stan_fit ::constrain_pars) - .method("num_pars_unconstrained", &rstan::stan_fit ::num_pars_unconstrained) - .method("unconstrained_param_names", &rstan::stan_fit ::unconstrained_param_names) - .method("constrained_param_names", &rstan::stan_fit ::constrained_param_names) - .method("standalone_gqs", &rstan::stan_fit ::standalone_gqs) - ; -} diff --git a/src/stanExports_poisson_log_model.h b/src/stanExports_poisson_log_model.h deleted file mode 100644 index e93633e..0000000 --- a/src/stanExports_poisson_log_model.h +++ /dev/null @@ -1,335 +0,0 @@ -// Generated by rstantools. Do not edit by hand. - -/* - glmmPen is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - glmmPen is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with glmmPen. If not, see . -*/ -#ifndef MODELS_HPP -#define MODELS_HPP -#define STAN__SERVICES__COMMAND_HPP -#include -// Code generated by Stan version 2.21.0 -#include -namespace model_poisson_log_model_namespace { -using std::istream; -using std::string; -using std::stringstream; -using std::vector; -using stan::io::dump; -using stan::math::lgamma; -using stan::model::prob_grad; -using namespace stan::math; -static int current_statement_begin__; -stan::io::program_reader prog_reader__() { - stan::io::program_reader reader; - reader.add_event(0, 0, "start", "model_poisson_log_model"); - reader.add_event(19, 17, "end", "model_poisson_log_model"); - return reader; -} -#include -class model_poisson_log_model - : public stan::model::model_base_crtp { -private: - int N; - int q; - vector_d eta_fef; - std::vector y; - matrix_d Z; -public: - model_poisson_log_model(stan::io::var_context& context__, - std::ostream* pstream__ = 0) - : model_base_crtp(0) { - ctor_body(context__, 0, pstream__); - } - model_poisson_log_model(stan::io::var_context& context__, - unsigned int random_seed__, - std::ostream* pstream__ = 0) - : model_base_crtp(0) { - ctor_body(context__, random_seed__, pstream__); - } - void ctor_body(stan::io::var_context& context__, - unsigned int random_seed__, - std::ostream* pstream__) { - typedef double local_scalar_t__; - boost::ecuyer1988 base_rng__ = - stan::services::util::create_rng(random_seed__, 0); - (void) base_rng__; // suppress unused var warning - current_statement_begin__ = -1; - static const char* function__ = "model_poisson_log_model_namespace::model_poisson_log_model"; - (void) function__; // dummy to suppress unused var warning - size_t pos__; - (void) pos__; // dummy to suppress unused var warning - std::vector vals_i__; - std::vector vals_r__; - local_scalar_t__ DUMMY_VAR__(std::numeric_limits::quiet_NaN()); - (void) DUMMY_VAR__; // suppress unused var warning - try { - // initialize data block variables from context__ - current_statement_begin__ = 2; - context__.validate_dims("data initialization", "N", "int", context__.to_vec()); - N = int(0); - vals_i__ = context__.vals_i("N"); - pos__ = 0; - N = vals_i__[pos__++]; - check_greater_or_equal(function__, "N", N, 0); - current_statement_begin__ = 3; - context__.validate_dims("data initialization", "q", "int", context__.to_vec()); - q = int(0); - vals_i__ = context__.vals_i("q"); - pos__ = 0; - q = vals_i__[pos__++]; - check_greater_or_equal(function__, "q", q, 0); - current_statement_begin__ = 4; - validate_non_negative_index("eta_fef", "N", N); - context__.validate_dims("data initialization", "eta_fef", "vector_d", context__.to_vec(N)); - eta_fef = Eigen::Matrix(N); - vals_r__ = context__.vals_r("eta_fef"); - pos__ = 0; - size_t eta_fef_j_1_max__ = N; - for (size_t j_1__ = 0; j_1__ < eta_fef_j_1_max__; ++j_1__) { - eta_fef(j_1__) = vals_r__[pos__++]; - } - current_statement_begin__ = 5; - validate_non_negative_index("y", "N", N); - context__.validate_dims("data initialization", "y", "int", context__.to_vec(N)); - y = std::vector(N, int(0)); - vals_i__ = context__.vals_i("y"); - pos__ = 0; - size_t y_k_0_max__ = N; - for (size_t k_0__ = 0; k_0__ < y_k_0_max__; ++k_0__) { - y[k_0__] = vals_i__[pos__++]; - } - size_t y_i_0_max__ = N; - for (size_t i_0__ = 0; i_0__ < y_i_0_max__; ++i_0__) { - check_greater_or_equal(function__, "y[i_0__]", y[i_0__], 0); - } - current_statement_begin__ = 6; - validate_non_negative_index("Z", "N", N); - validate_non_negative_index("Z", "q", q); - context__.validate_dims("data initialization", "Z", "matrix_d", context__.to_vec(N,q)); - Z = Eigen::Matrix(N, q); - vals_r__ = context__.vals_r("Z"); - pos__ = 0; - size_t Z_j_2_max__ = q; - size_t Z_j_1_max__ = N; - for (size_t j_2__ = 0; j_2__ < Z_j_2_max__; ++j_2__) { - for (size_t j_1__ = 0; j_1__ < Z_j_1_max__; ++j_1__) { - Z(j_1__, j_2__) = vals_r__[pos__++]; - } - } - // initialize transformed data variables - // execute transformed data statements - // validate transformed data - // validate, set parameter ranges - num_params_r__ = 0U; - param_ranges_i__.clear(); - current_statement_begin__ = 10; - validate_non_negative_index("alpha", "q", q); - num_params_r__ += q; - } catch (const std::exception& e) { - stan::lang::rethrow_located(e, current_statement_begin__, prog_reader__()); - // Next line prevents compiler griping about no return - throw std::runtime_error("*** IF YOU SEE THIS, PLEASE REPORT A BUG ***"); - } - } - ~model_poisson_log_model() { } - void transform_inits(const stan::io::var_context& context__, - std::vector& params_i__, - std::vector& params_r__, - std::ostream* pstream__) const { - typedef double local_scalar_t__; - stan::io::writer writer__(params_r__, params_i__); - size_t pos__; - (void) pos__; // dummy call to supress warning - std::vector vals_r__; - std::vector vals_i__; - current_statement_begin__ = 10; - if (!(context__.contains_r("alpha"))) - stan::lang::rethrow_located(std::runtime_error(std::string("Variable alpha missing")), current_statement_begin__, prog_reader__()); - vals_r__ = context__.vals_r("alpha"); - pos__ = 0U; - validate_non_negative_index("alpha", "q", q); - context__.validate_dims("parameter initialization", "alpha", "vector_d", context__.to_vec(q)); - Eigen::Matrix alpha(q); - size_t alpha_j_1_max__ = q; - for (size_t j_1__ = 0; j_1__ < alpha_j_1_max__; ++j_1__) { - alpha(j_1__) = vals_r__[pos__++]; - } - try { - writer__.vector_unconstrain(alpha); - } catch (const std::exception& e) { - stan::lang::rethrow_located(std::runtime_error(std::string("Error transforming variable alpha: ") + e.what()), current_statement_begin__, prog_reader__()); - } - params_r__ = writer__.data_r(); - params_i__ = writer__.data_i(); - } - void transform_inits(const stan::io::var_context& context, - Eigen::Matrix& params_r, - std::ostream* pstream__) const { - std::vector params_r_vec; - std::vector params_i_vec; - transform_inits(context, params_i_vec, params_r_vec, pstream__); - params_r.resize(params_r_vec.size()); - for (int i = 0; i < params_r.size(); ++i) - params_r(i) = params_r_vec[i]; - } - template - T__ log_prob(std::vector& params_r__, - std::vector& params_i__, - std::ostream* pstream__ = 0) const { - typedef T__ local_scalar_t__; - local_scalar_t__ DUMMY_VAR__(std::numeric_limits::quiet_NaN()); - (void) DUMMY_VAR__; // dummy to suppress unused var warning - T__ lp__(0.0); - stan::math::accumulator lp_accum__; - try { - stan::io::reader in__(params_r__, params_i__); - // model parameters - current_statement_begin__ = 10; - Eigen::Matrix alpha; - (void) alpha; // dummy to suppress unused var warning - if (jacobian__) - alpha = in__.vector_constrain(q, lp__); - else - alpha = in__.vector_constrain(q); - // model body - current_statement_begin__ = 14; - lp_accum__.add(normal_log(alpha, 0, 1)); - current_statement_begin__ = 15; - lp_accum__.add(poisson_log_log(y, add(eta_fef, multiply(Z, alpha)))); - } catch (const std::exception& e) { - stan::lang::rethrow_located(e, current_statement_begin__, prog_reader__()); - // Next line prevents compiler griping about no return - throw std::runtime_error("*** IF YOU SEE THIS, PLEASE REPORT A BUG ***"); - } - lp_accum__.add(lp__); - return lp_accum__.sum(); - } // log_prob() - template - T_ log_prob(Eigen::Matrix& params_r, - std::ostream* pstream = 0) const { - std::vector vec_params_r; - vec_params_r.reserve(params_r.size()); - for (int i = 0; i < params_r.size(); ++i) - vec_params_r.push_back(params_r(i)); - std::vector vec_params_i; - return log_prob(vec_params_r, vec_params_i, pstream); - } - void get_param_names(std::vector& names__) const { - names__.resize(0); - names__.push_back("alpha"); - } - void get_dims(std::vector >& dimss__) const { - dimss__.resize(0); - std::vector dims__; - dims__.resize(0); - dims__.push_back(q); - dimss__.push_back(dims__); - } - template - void write_array(RNG& base_rng__, - std::vector& params_r__, - std::vector& params_i__, - std::vector& vars__, - bool include_tparams__ = true, - bool include_gqs__ = true, - std::ostream* pstream__ = 0) const { - typedef double local_scalar_t__; - vars__.resize(0); - stan::io::reader in__(params_r__, params_i__); - static const char* function__ = "model_poisson_log_model_namespace::write_array"; - (void) function__; // dummy to suppress unused var warning - // read-transform, write parameters - Eigen::Matrix alpha = in__.vector_constrain(q); - size_t alpha_j_1_max__ = q; - for (size_t j_1__ = 0; j_1__ < alpha_j_1_max__; ++j_1__) { - vars__.push_back(alpha(j_1__)); - } - double lp__ = 0.0; - (void) lp__; // dummy to suppress unused var warning - stan::math::accumulator lp_accum__; - local_scalar_t__ DUMMY_VAR__(std::numeric_limits::quiet_NaN()); - (void) DUMMY_VAR__; // suppress unused var warning - if (!include_tparams__ && !include_gqs__) return; - try { - if (!include_gqs__ && !include_tparams__) return; - if (!include_gqs__) return; - } catch (const std::exception& e) { - stan::lang::rethrow_located(e, current_statement_begin__, prog_reader__()); - // Next line prevents compiler griping about no return - throw std::runtime_error("*** IF YOU SEE THIS, PLEASE REPORT A BUG ***"); - } - } - template - void write_array(RNG& base_rng, - Eigen::Matrix& params_r, - Eigen::Matrix& vars, - bool include_tparams = true, - bool include_gqs = true, - std::ostream* pstream = 0) const { - std::vector params_r_vec(params_r.size()); - for (int i = 0; i < params_r.size(); ++i) - params_r_vec[i] = params_r(i); - std::vector vars_vec; - std::vector params_i_vec; - write_array(base_rng, params_r_vec, params_i_vec, vars_vec, include_tparams, include_gqs, pstream); - vars.resize(vars_vec.size()); - for (int i = 0; i < vars.size(); ++i) - vars(i) = vars_vec[i]; - } - std::string model_name() const { - return "model_poisson_log_model"; - } - void constrained_param_names(std::vector& param_names__, - bool include_tparams__ = true, - bool include_gqs__ = true) const { - std::stringstream param_name_stream__; - size_t alpha_j_1_max__ = q; - for (size_t j_1__ = 0; j_1__ < alpha_j_1_max__; ++j_1__) { - param_name_stream__.str(std::string()); - param_name_stream__ << "alpha" << '.' << j_1__ + 1; - param_names__.push_back(param_name_stream__.str()); - } - if (!include_gqs__ && !include_tparams__) return; - if (include_tparams__) { - } - if (!include_gqs__) return; - } - void unconstrained_param_names(std::vector& param_names__, - bool include_tparams__ = true, - bool include_gqs__ = true) const { - std::stringstream param_name_stream__; - size_t alpha_j_1_max__ = q; - for (size_t j_1__ = 0; j_1__ < alpha_j_1_max__; ++j_1__) { - param_name_stream__.str(std::string()); - param_name_stream__ << "alpha" << '.' << j_1__ + 1; - param_names__.push_back(param_name_stream__.str()); - } - if (!include_gqs__ && !include_tparams__) return; - if (include_tparams__) { - } - if (!include_gqs__) return; - } -}; // model -} // namespace -typedef model_poisson_log_model_namespace::model_poisson_log_model stan_model; -#ifndef USING_R -stan::model::model_base& new_model( - stan::io::var_context& data_context, - unsigned int seed, - std::ostream* msg_stream) { - stan_model* m = new stan_model(data_context, seed, msg_stream); - return *m; -} -#endif -#endif From cec15bda06ef81b32a9e1aa00e99bd733a92a978 Mon Sep 17 00:00:00 2001 From: Andrew Johnson Date: Thu, 9 Feb 2023 10:38:56 +0200 Subject: [PATCH 2/3] Revert stray change --- R/RcppExports.R | 36 ++++++++++++++++++++++-------------- 1 file changed, 22 insertions(+), 14 deletions(-) diff --git a/R/RcppExports.R b/R/RcppExports.R index d63ac9a..a3d987d 100644 --- a/R/RcppExports.R +++ b/R/RcppExports.R @@ -2,58 +2,66 @@ # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 grp_CD_XZ_FA_step <- function(y, X, Z, group, pBigMat, J_f, dims, beta, offset, step_size, sig_g, family, link, init, phi, X_group, K, penalty, params, trace) { - .Call(`_glmmPen_grp_CD_XZ_FA_step`, y, X, Z, group, pBigMat, J_f, dims, beta, offset, step_size, sig_g, family, link, init, phi, X_group, K, penalty, params, trace) + .Call('_glmmPen_grp_CD_XZ_FA_step', PACKAGE = 'glmmPen', y, X, Z, group, pBigMat, J_f, dims, beta, offset, step_size, sig_g, family, link, init, phi, X_group, K, penalty, params, trace) } grp_CD_XZ_step <- function(y, X, Z, group, pBigMat, J_q, dims, beta, offset, step_size, sig_g, family, link, init, phi, XZ_group, K, penalty, params, trace) { - .Call(`_glmmPen_grp_CD_XZ_step`, y, X, Z, group, pBigMat, J_q, dims, beta, offset, step_size, sig_g, family, link, init, phi, XZ_group, K, penalty, params, trace) + .Call('_glmmPen_grp_CD_XZ_step', PACKAGE = 'glmmPen', y, X, Z, group, pBigMat, J_q, dims, beta, offset, step_size, sig_g, family, link, init, phi, XZ_group, K, penalty, params, trace) } soft_thresh <- function(zeta, lambda) { - .Call(`_glmmPen_soft_thresh`, zeta, lambda) + .Call('_glmmPen_soft_thresh', PACKAGE = 'glmmPen', zeta, lambda) } MCP_soln <- function(zeta, nu, lambda, gamma, alpha) { - .Call(`_glmmPen_MCP_soln`, zeta, nu, lambda, gamma, alpha) + .Call('_glmmPen_MCP_soln', PACKAGE = 'glmmPen', zeta, nu, lambda, gamma, alpha) } SCAD_soln <- function(zeta, nu, lambda, gamma, alpha) { - .Call(`_glmmPen_SCAD_soln`, zeta, nu, lambda, gamma, alpha) + .Call('_glmmPen_SCAD_soln', PACKAGE = 'glmmPen', zeta, nu, lambda, gamma, alpha) } pglm_fit <- function(y, X, dims, beta, offset, family, link, penalty, params, penalty_factor, trace) { - .Call(`_glmmPen_pglm_fit`, y, X, dims, beta, offset, family, link, penalty, params, penalty_factor, trace) + .Call('_glmmPen_pglm_fit', PACKAGE = 'glmmPen', y, X, dims, beta, offset, family, link, penalty, params, penalty_factor, trace) } sample_mc_inner_gibbs <- function(f, z, y, t, NMC, u0, family, link, phi, sig_g) { - .Call(`_glmmPen_sample_mc_inner_gibbs`, f, z, y, t, NMC, u0, family, link, phi, sig_g) + .Call('_glmmPen_sample_mc_inner_gibbs', PACKAGE = 'glmmPen', f, z, y, t, NMC, u0, family, link, phi, sig_g) } sample_mc_gibbs_adapt_rw <- function(f, z, y, NMC, u0, proposal_SD, batch, batch_length, offset, nMC_burnin, family, link, phi, sig_g) { - .Call(`_glmmPen_sample_mc_gibbs_adapt_rw`, f, z, y, NMC, u0, proposal_SD, batch, batch_length, offset, nMC_burnin, family, link, phi, sig_g) + .Call('_glmmPen_sample_mc_gibbs_adapt_rw', PACKAGE = 'glmmPen', f, z, y, NMC, u0, proposal_SD, batch, batch_length, offset, nMC_burnin, family, link, phi, sig_g) +} + +Qfun_FA <- function(y, X, Z, pBigMat, group, J_f, beta, offset, dims, family, link, sig_g, phi) { + .Call('_glmmPen_Qfun_FA', PACKAGE = 'glmmPen', y, X, Z, pBigMat, group, J_f, beta, offset, dims, family, link, sig_g, phi) +} + +sig_gaus_FA <- function(y, X, Z, pBigMat, group, J_q, beta, offset, dims, link) { + .Call('_glmmPen_sig_gaus_FA', PACKAGE = 'glmmPen', y, X, Z, pBigMat, group, J_q, beta, offset, dims, link) } invlink <- function(link, eta) { - .Call(`_glmmPen_invlink`, link, eta) + .Call('_glmmPen_invlink', PACKAGE = 'glmmPen', link, eta) } Qfun <- function(y, X, Z, pBigMat, group, J_q, beta, offset, dims, family, link, sig_g, phi) { - .Call(`_glmmPen_Qfun`, y, X, Z, pBigMat, group, J_q, beta, offset, dims, family, link, sig_g, phi) + .Call('_glmmPen_Qfun', PACKAGE = 'glmmPen', y, X, Z, pBigMat, group, J_q, beta, offset, dims, family, link, sig_g, phi) } sig_gaus <- function(y, X, Z, pBigMat, group, J_q, beta, offset, dims, link) { - .Call(`_glmmPen_sig_gaus`, y, X, Z, pBigMat, group, J_q, beta, offset, dims, link) + .Call('_glmmPen_sig_gaus', PACKAGE = 'glmmPen', y, X, Z, pBigMat, group, J_q, beta, offset, dims, link) } phi_ml <- function(y, eta, link, limit, eps, phi) { - .Call(`_glmmPen_phi_ml`, y, eta, link, limit, eps, phi) + .Call('_glmmPen_phi_ml', PACKAGE = 'glmmPen', y, eta, link, limit, eps, phi) } phi_ml_init <- function(y, eta, link, limit, eps) { - .Call(`_glmmPen_phi_ml_init`, y, eta, link, limit, eps) + .Call('_glmmPen_phi_ml_init', PACKAGE = 'glmmPen', y, eta, link, limit, eps) } Qfun_quad_beta <- function(Q0, step_size, diff0, eta, eta0, beta, beta0) { - .Call(`_glmmPen_Qfun_quad_beta`, Q0, step_size, diff0, eta, eta0, beta, beta0) + .Call('_glmmPen_Qfun_quad_beta', PACKAGE = 'glmmPen', Q0, step_size, diff0, eta, eta0, beta, beta0) } From b9d54c4533786bb8f8cc554179b6d3a079367985 Mon Sep 17 00:00:00 2001 From: Andrew Johnson Date: Wed, 15 Mar 2023 23:19:51 +0200 Subject: [PATCH 3/3] Add missing DESCRIPTION entries --- DESCRIPTION | 24 +++++++++++++----------- 1 file changed, 13 insertions(+), 11 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index fae0a71..5aa8a07 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -10,24 +10,24 @@ Authors@R: c( person("Quefeng", "Li", email = "quefeng@email.unc.edu", role = c("aut")), person("Joseph", "Ibrahim", email = "ibrahim@bios.unc.edu", role = c("aut"))) Maintainer: Hillary Heiling -Description: Fits high dimensional penalized generalized linear - mixed models using - the Monte Carlo Expectation Conditional Minimization (MCECM) algorithm. - The purpose of the package is to perform variable selection on both the fixed and +Description: Fits high dimensional penalized generalized linear + mixed models using + the Monte Carlo Expectation Conditional Minimization (MCECM) algorithm. + The purpose of the package is to perform variable selection on both the fixed and random effects simultaneously for generalized linear mixed models. The package supports fitting of Binomial, Gaussian, and Poisson data with canonical links, and supports penalization using the MCP, SCAD, or LASSO penalties. The MCECM algorithm is described in Rashid et al. (2020) . The techniques used in the minimization portion of the procedure (the M-step) are - derived from the procedures of the 'ncvreg' package (Breheny and Huang (2011) + derived from the procedures of the 'ncvreg' package (Breheny and Huang (2011) ) and 'grpreg' package (Breheny and Huang (2015) ), with appropriate modifications to account for the estimation and penalization of - the random effects. The 'ncvreg' and 'grpreg' packages also describe the MCP, SCAD, + the random effects. The 'ncvreg' and 'grpreg' packages also describe the MCP, SCAD, and LASSO penalties. License: GPL (>= 2) Encoding: UTF-8 -Imports: +Imports: ggplot2, Matrix, methods, @@ -37,17 +37,19 @@ Imports: stringr, mvtnorm, MASS, - coxme -Depends: + coxme, + rstantools +Depends: lme4, bigmemory, Rcpp (>= 0.12.0), R (>= 3.6.0) -LinkingTo: +LinkingTo: BH (>= 1.66.0), bigmemory, Rcpp (>= 0.12.0), RcppArmadillo, + RcppParallel, RcppEigen (>= 0.3.3.3.0), rstan (>= 2.18.1), StanHeaders (>= 2.18.0) @@ -58,7 +60,7 @@ Author: Hillary Heiling [aut, cre], Naim Rashid [aut], Quefeng Li [aut], Joseph Ibrahim [aut] -Suggests: +Suggests: testthat, knitr, rmarkdown