Kfold

NAMESPACE

@@ -24,6 +24,7 @@ S3method(extract_var_resp,ermod)
 S3method(extract_var_resp,ersim)
 S3method(extract_var_resp,ersim_med_qi)
 S3method(extract_var_selected,ermod_cov_sel)
+S3method(kfold,ermod)
 S3method(loo,ermod)
 S3method(loo,ermod_bin_emax)
 S3method(loo,ermod_emax)
@@ -40,7 +41,7 @@ S3method(plot_er,ersim_med_qi)
 S3method(print,ermod)
 S3method(print,ermod_cov_sel)
 S3method(print,ermod_exp_sel)
-S3method(print,kfold_cv_ermod)
+S3method(print,kfold_ermod)
 S3method(prior_summary,ermod)
 S3method(summary,ermod)
 export(.dev_ermod_refmodel)
@@ -74,6 +75,7 @@ export(extract_var_cov)
 export(extract_var_exposure)
 export(extract_var_resp)
 export(extract_var_selected)
+export(kfold)
 export(loo)
 export(plot_coveff)
 export(plot_er)
@@ -84,13 +86,13 @@ export(plot_var_ranking)
 export(print_coveff)
 export(prior_summary)
 export(replace_spec_coveff)
-export(run_kfold_cv)
 export(sim_coveff)
 export(sim_er)
 export(sim_er_curve)
 export(sim_er_curve_marg)
 export(sim_er_new_exp)
 export(sim_er_new_exp_marg)
+importFrom(loo,kfold)
 importFrom(loo,loo)
 importFrom(posterior,as_draws)
 importFrom(posterior,as_draws_array)

R/dev_ermod_lin.R

@@ -66,18 +66,19 @@ dev_ermod_bin <- function(
       paste(var_resp, "~", paste(var_full, collapse = " + "))
     )
 
-
-  mod <- rstanarm::stan_glm(
-    formula_final,
+  # Need to construct call and then evaluate. Directly calling
+  # rstanarm::stan_glm with formula_final does not work for the cross-validation
+  call_stan_glm <- rlang::call2(
+    rstanarm::stan_glm,
+    formula = formula_final,
     family = stats::binomial(),
-    data = data,
+    data = quote(data),
     prior = prior,
     prior_intercept = prior_intercept,
     QR = dplyr::if_else(length(var_full) > 1, TRUE, FALSE),
-    refresh = refresh,
-    chains = chains,
-    iter = iter
+    refresh = refresh, chains = chains, iter = iter
   )
+  mod <- eval(call_stan_glm)
 
   new_ermod_bin(
     mod = mod,

R/ermod-methods.R

@@ -239,56 +239,6 @@ extract_coef_exp_ci <- function(x, ci_width = 0.95) {
   return(coef_exp_ci)
 }
 
-
-# LOO -------------------------------------------------------------------------
-
-#' Efficient approximate leave-one-out cross-validation (LOO)
-#'
-#' See [loo::loo()] for details.
-#'
-#' @name loo
-#' @param x An object of class `ermod`
-#' @param ... Additional arguments passed to `loo::loo()`
-#' @importFrom loo loo
-#'
-#' @return An object of class `loo`
-#' @export
-loo::loo
-
-#' @rdname loo
-#' @export
-loo.ermod <- function(x, ...) {
-  loo::loo(x$mod, ...)
-}
-
-#' @rdname loo
-#' @export
-loo.ermod_emax <- function(x, ...) {
-  rlang::check_installed("digest")
-
-  out <- loo::loo(x$mod$stanfit, ...)
-
-  y <- x$mod$standata$response
-  attributes(y) <- NULL
-  attr(out, "yhash") <- digest::sha1(y)
-
-  return(out)
-}
-
-#' @rdname loo
-#' @export
-loo.ermod_bin_emax <- function(x, ...) {
-  rlang::check_installed("digest")
-
-  out <- loo::loo(x$mod$stanfit, ...)
-
-  y <- x$mod$standata$response
-  attributes(y) <- NULL
-  attr(out, "yhash") <- digest::sha1(y)
-
-  return(out)
-}
-
 # as_draws --------------------------------------------------------------------
 
 #' Transform to `draws` objects

R/eval_ermod.R

@@ -72,7 +72,7 @@ eval_ermod <- function(
   }
 
   if (eval_type == "kfold") {
-    cv_results <- run_kfold_cv(
+    cv_results <- kfold(
       ermod,
       newdata = data_to_use, k = k, seed = seed_kfold
     )
@@ -134,5 +134,6 @@ eval_ermod <- function(
 
 .if_run_ex_eval_mod <- function() {
   requireNamespace("rsample", quietly = TRUE) &&
-    requireNamespace("yardstick", quietly = TRUE)
+    requireNamespace("yardstick", quietly = TRUE) &&
+    rlang::is_installed("rstanemax", version = "0.1.9")
 }