Tests: Avoid redundancies by defining get_fit_fun_nm().

stan-dev · Mar 22, 2023 · 9d649a2 · 9d649a2
1 parent f9f8bf4
commit 9d649a2
Show file tree

Hide file tree

Showing 4 changed files with 16 additions and 35 deletions.
diff --git a/tests/testthat/helpers/getters.R b/tests/testthat/helpers/getters.R
@@ -89,3 +89,14 @@ get_dat <- function(tstsetup, dat_crr = dat, offs_ylat = 0, ...) {
 get_penal_possbl <- function(formul_crr) {
   return(setdiff(colnames(model.matrix(formul_crr, data = dat)), "(Intercept)"))
 }
+
+# A function to get the name of a fitting function for a reference model:
+get_fit_fun_nm <- function(args_fit_i) {
+  switch(args_fit_i$pkg_nm,
+         "rstanarm" = switch(args_fit_i$mod_nm,
+                             "glm" = "stan_glm",
+                             "glmm" = "stan_glmer",
+                             "stan_gamm4"),
+         "brms" = "brm",
+         stop("Unknown `pkg_nm`."))
+}
diff --git a/tests/testthat/setup.R b/tests/testthat/setup.R
@@ -760,13 +760,7 @@ if (!run_more) {
 ## Run --------------------------------------------------------------------
 
 fits <- suppressWarnings(lapply(args_fit, function(args_fit_i) {
-  fit_fun_nm <- switch(args_fit_i$pkg_nm,
-                       "rstanarm" = switch(args_fit_i$mod_nm,
-                                           "glm" = "stan_glm",
-                                           "glmm" = "stan_glmer",
-                                           "stan_gamm4"),
-                       "brms" = "brm",
-                       stop("Unknown `pkg_nm`."))
+  fit_fun_nm <- get_fit_fun_nm(args_fit_i)
   if (args_fit_i$pkg_nm == "rstanarm" && args_fit_i$fam_nm == "cumul") {
     fit_fun_nm <- "stan_polr"
     args_fit_i$family <- NULL

diff --git a/tests/testthat/test_refmodel.R b/tests/testthat/test_refmodel.R
@@ -78,13 +78,7 @@ test_that("`formula` as a character string fails", {
 test_that("reference models lacking an intercept work", {
   args_fit_i <- args_fit$rstanarm.glm.gauss.stdformul.with_wobs.with_offs
   skip_if_not(!is.null(args_fit_i))
-  fit_fun_nm <- switch(args_fit_i$pkg_nm,
-                       "rstanarm" = switch(args_fit_i$mod_nm,
-                                           "glm" = "stan_glm",
-                                           "glmm" = "stan_glmer",
-                                           "stan_gamm4"),
-                       "brms" = "brm",
-                       stop("Unknown `pkg_nm`."))
+  fit_fun_nm <- get_fit_fun_nm(args_fit_i)
   fit_no_icpt <- suppressWarnings(do.call(
     get(fit_fun_nm, asNamespace(args_fit_i$pkg_nm)),
     c(list(formula = update(args_fit_i$formula, . ~ . - 1)),
@@ -108,13 +102,7 @@ test_that("reference models lacking an intercept work", {
 test_that("offsets specified via argument `offset` work", {
   args_fit_i <- args_fit$rstanarm.glm.gauss.stdformul.with_wobs.with_offs
   skip_if_not(!is.null(args_fit_i))
-  fit_fun_nm <- switch(args_fit_i$pkg_nm,
-                       "rstanarm" = switch(args_fit_i$mod_nm,
-                                           "glm" = "stan_glm",
-                                           "glmm" = "stan_glmer",
-                                           "stan_gamm4"),
-                       "brms" = "brm",
-                       stop("Unknown `pkg_nm`."))
+  fit_fun_nm <- get_fit_fun_nm(args_fit_i)
   upd_no_offs <- paste(". ~", sub(" \\+ offset\\(offs_col\\)", "",
                                   as.character(args_fit_i$formula[3])))
   fit_offs_arg <- suppressWarnings(do.call(
@@ -167,13 +155,7 @@ test_that(paste(
 test_that("extra arguments in s() or t2() terms fail", {
   args_fit_i <- args_fit$rstanarm.gam.gauss.stdformul.with_wobs.without_offs
   skip_if_not(!is.null(args_fit_i))
-  fit_fun_nm <- switch(args_fit_i$pkg_nm,
-                       "rstanarm" = switch(args_fit_i$mod_nm,
-                                           "glm" = "stan_glm",
-                                           "glmm" = "stan_glmer",
-                                           "stan_gamm4"),
-                       "brms" = "brm",
-                       stop("Unknown `pkg_nm`."))
+  fit_fun_nm <- get_fit_fun_nm(args_fit_i)
   fit_s <- suppressWarnings(do.call(
     get(fit_fun_nm, asNamespace(args_fit_i$pkg_nm)),
     c(list(formula = update(args_fit_i$formula,

diff --git a/tests/testthat/test_varsel.R b/tests/testthat/test_varsel.R
@@ -920,13 +920,7 @@ test_that(paste(
   warn_L1_ia_orig <- options(projpred.warn_L1_interactions = TRUE)
   args_fit_i <- args_fit$rstanarm.glm.gauss.stdformul.with_wobs.with_offs
   skip_if_not(!is.null(args_fit_i))
-  fit_fun_nm <- switch(args_fit_i$pkg_nm,
-                       "rstanarm" = switch(args_fit_i$mod_nm,
-                                           "glm" = "stan_glm",
-                                           "glmm" = "stan_glmer",
-                                           "stan_gamm4"),
-                       "brms" = "brm",
-                       stop("Unknown `pkg_nm`."))
+  fit_fun_nm <- get_fit_fun_nm(args_fit_i)
   fit_ia <- suppressWarnings(do.call(
     get(fit_fun_nm, asNamespace(args_fit_i$pkg_nm)),
     c(list(formula = update(args_fit_i$formula, . ~ . + xco.1:xca.2)),