Prepare CRAN release (#616)

* Prepare CRAN release * use insight function * trigger CI * trigger CI * Update DESCRIPTION * Update DESCRIPTION * Update test-averaging.R * silence tests * fix
strengejacke · Nov 27, 2024 · d383f1c · d383f1c
1 parent 66cc497
commit d383f1c
Show file tree

Hide file tree

Showing 21 changed files with 49 additions and 80 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -2,7 +2,7 @@ Package: ggeffects
 Type: Package
 Encoding: UTF-8
 Title: Create Tidy Data Frames of Marginal Effects for 'ggplot' from Model Outputs
-Version: 1.8.21
+Version: 2.0.0
 Authors@R: c(
       person("Daniel", "Lüdecke", role = c("aut", "cre"), email = "d.luedecke@uke.de", comment = c(ORCID = "0000-0002-8895-3206")),
       person("Frederik", "Aust", role = "ctb", comment = c(ORCID = "0000-0003-4900-788X")),
@@ -22,7 +22,7 @@ Depends:
     R (>= 3.6)
 Imports:
     graphics,
-    insight (>= 0.20.5),
+    insight (>= 1.0.0),
     datawizard (>= 0.13.0),
     stats,
     utils
@@ -61,7 +61,7 @@ Suggests:
     knitr,
     lme4 (>= 1.1-35),
     logistf,
-    marginaleffects (>= 0.19.0),
+    marginaleffects (>= 0.24.0),
     MASS,
     Matrix,
     mice,
@@ -107,4 +107,3 @@ Config/testthat/edition: 3
 Roxygen: list(markdown = TRUE)
 License: MIT + file LICENSE
 LazyData: true
-Remotes: vincentarelbundock/marginaleffects
diff --git a/R/get_predictions_glmgee.R b/R/get_predictions_glmgee.R
@@ -17,7 +17,7 @@ get_predictions.glmgee <- function(model,
   if (is.null(vcov)) {
     vcov <- "robust"
   }
-  vcov <- .validate_argument(
+  vcov <- insight::validate_argument(
     vcov,
     c("robust", "df-adjusted", "model", "bias-corrected")
   )

diff --git a/R/ggemmeans.R b/R/ggemmeans.R
@@ -33,7 +33,7 @@ ggemmeans <- function(model,
   insight::formula_ok(model, verbose = verbose)
 
   # check arguments
-  interval <- .validate_argument(interval, c("confidence", "prediction"))
+  interval <- insight::validate_argument(interval, c("confidence", "prediction"))
   model_name <- deparse(substitute(model))
   type <- .validate_type_argument(model, type, emmeans_call = TRUE)
 

diff --git a/R/ggpredict.R b/R/ggpredict.R
@@ -78,7 +78,7 @@ ggpredict <- function(model,
   insight::formula_ok(model, verbose = verbose)
 
   # make sure we have valid values
-  interval <- .validate_argument(interval, c("confidence", "prediction"))
+  interval <- insight::validate_argument(interval, c("confidence", "prediction"))
 
   model.name <- deparse(substitute(model))
 

diff --git a/R/johnson_neyman.R b/R/johnson_neyman.R
@@ -98,7 +98,7 @@ johnson_neyman <- function(x, precision = 500, p_adjust = NULL, ...) {
 
   # check arguments
   if (!is.null(p_adjust)) {
-    p_adjust <- .validate_argument(p_adjust, c("esarey", "es", "fdr", "bh"))
+    p_adjust <- insight::validate_argument(p_adjust, c("esarey", "es", "fdr", "bh"))
     # just keep one shortcut
     p_adjust <- switch(p_adjust,
       esarey = "es",

diff --git a/R/predict_response.R b/R/predict_response.R
@@ -639,7 +639,7 @@ predict_response <- function(model,
   # default for "margin" argument?
   margin <- getOption("ggeffects_margin", margin)
   # validate "margin" argument
-  margin <- .validate_argument(
+  margin <- insight::validate_argument(
     argument = margin,
     options = c(
       "mean_reference", "mean_mode", "marginalmeans", "empirical",
@@ -663,7 +663,7 @@ predict_response <- function(model,
   )
 
   # make sure we have valid values
-  interval <- .validate_argument(interval, c("confidence", "prediction"))
+  interval <- insight::validate_argument(interval, c("confidence", "prediction"))
 
   out <- switch(margin,
     mean_reference = ggpredict(

diff --git a/R/sanitize_type_arg.R b/R/sanitize_type_arg.R
@@ -182,7 +182,7 @@
       "cumulative_hazard", "simulate_random", "debug", "quantile" # for survreg
     )
   }
-  type <- .validate_argument(type, type_choices)
+  type <- insight::validate_argument(type, type_choices)
 
   switch(type,
     count = "fixed",

diff --git a/R/test_predictions.R b/R/test_predictions.R
@@ -896,7 +896,7 @@ test_predictions.ggeffects <- function(object,
   # default for "engine" argument?
   engine <- getOption("ggeffects_test_engine", engine)
   # validate "engine" argument
-  engine <- .validate_argument(engine, c("marginaleffects", "emmeans", "ggeffects"))
+  engine <- insight::validate_argument(engine, c("marginaleffects", "emmeans", "ggeffects"))
 
   if (!insight::check_if_installed("marginaleffects", quietly = TRUE) && engine == "marginaleffects") { # nolint
     engine <- "emmeans"
@@ -1002,7 +1002,7 @@ test_predictions.ggeffects <- function(object,
   # default for "margin" argument?
   margin <- getOption("ggeffects_margin", margin)
   # validate "margin" argument
-  margin <- .validate_argument(
+  margin <- insight::validate_argument(
     margin,
     c(
       "mean_reference", "mean_mode", "marginalmeans", "empirical",

diff --git a/R/test_predictions_emmeans.R b/R/test_predictions_emmeans.R
@@ -35,7 +35,7 @@
     custom_contrasts <- test
     test <- "custom"
   }
-  test <- .validate_argument(
+  test <- insight::validate_argument(
     test,
     c("contrast", "pairwise", "interaction", "custom", "exclude", "consecutive", "polynomial")
   )

diff --git a/R/test_predictions_ggeffects.R b/R/test_predictions_ggeffects.R
@@ -21,7 +21,7 @@
   if (is.null(test) || test %in% c("trend", "slope")) {
     test <- "contrast"
   }
-  test <- .validate_argument(test, c("contrast", "pairwise", "interaction"))
+  test <- insight::validate_argument(test, c("contrast", "pairwise", "interaction"))
 
   # we convert the ggeffects object to a data frame, using the original
   # names of the focal terms as column names

diff --git a/R/utils.R b/R/utils.R
@@ -420,40 +420,6 @@ is.gamm4 <- function(x) {
 }
 
 
-.validate_argument <- function(argument, options) {
-  # save this information for printin
-  argument_name <- deparse(substitute(argument))
-  original_argument <- argument
-  # catch error, we want our own message
-  argument <- .safe(match.arg(argument, options))
-  # proceed here if argument option was invalid
-  if (is.null(argument)) {
-    # check whether we find a typo
-    suggestion <- .misspelled_string(options, original_argument)
-    msg <- sprintf("Invalid option for argument `%s`.", argument_name)
-    if (is.null(suggestion$msg) || !length(suggestion$msg) || !nzchar(suggestion$msg)) {
-      msg <- paste(
-        msg,
-        "Please use one of the following options:",
-        datawizard::text_concatenate(options, last = " or ", enclose = "\"")
-      )
-    } else {
-      options <- setdiff(options, suggestion$possible_strings)
-      msg <- paste(msg, suggestion$msg)
-      if (length(options)) {
-        msg <- paste(
-          msg,
-          "Otherwise, use one of the following options:",
-          datawizard::text_concatenate(options, last = " or ", enclose = "\"")
-        )
-      }
-    }
-    insight::format_error(msg)
-  }
-  argument
-}
-
-
 .misspelled_string <- function(source, searchterm, default_message = NULL) {
   if (is.null(searchterm) || length(searchterm) < 1) {
     return(default_message)

diff --git a/R/vcov.R b/R/vcov.R
@@ -416,7 +416,7 @@ vcov.ggeffects <- function(object,
   }
   dots <- list(...)
   if (!is.null(dots$vcov_fun) || !is.null(dots$vcov_type)) {
-    insight::format_warning("The arguments `vcov_fun` and `vcov_type` are deprecated and no longer. Please only use `vcov` to specify a variance-covariance matrix or a string to identify the function to compute heteroscedasticity-consistent standard errors, and the `vcov_args` argument for further arguments passed to that function.") # nolint
+    insight::format_warning("The arguments `vcov_fun` and `vcov_type` are deprecated. Please only use `vcov` to specify a variance-covariance matrix or a string to identify the function to compute heteroscedasticity-consistent standard errors, and the `vcov_args` argument for further arguments passed to that function.") # nolint
   }
   if (!is.null(dots$vcov_type)) {
     return(dots$vcov_type)

diff --git a/cran-comments.md b/cran-comments.md
@@ -1 +1 @@
-Maintainance release 2
+Release that fixes CRAN check issues.
diff --git a/tests/testthat/test-averaging.R b/tests/testthat/test-averaging.R
@@ -15,8 +15,8 @@ test_that("ggpredict, glmmTMB averaging", {
     family = glmmTMB::beta_family()
   )
   set.seed(123)
-  dr <- MuMIn::dredge(m)
-  avg <- MuMIn::model.avg(object = dr, fit = TRUE)
+  dr <- suppressMessages(MuMIn::dredge(m))
+  avg <- suppressMessages(MuMIn::model.avg(object = dr, fit = TRUE))
   out <- predict_response(avg, "income", verbose = FALSE)
 
   expect_equal(
@@ -47,9 +47,9 @@ withr::with_options(
 
     set.seed(123)
     m <- lm(disp ~ mpg + I(mpg^2) + am + gear, mtcars)
-    dr <- MuMIn::dredge(m, subset = dc(mpg, I(mpg^2)))
+    dr <- suppressMessages(MuMIn::dredge(m, subset = dc(mpg, I(mpg^2))))
     dr <- subset(dr, !(has(mpg) & !has(I(mpg^2))))
-    mod.avg.i <- MuMIn::model.avg(dr, fit = TRUE)
+    mod.avg.i <- suppressMessages(MuMIn::model.avg(dr, fit = TRUE))
     out <- suppressWarnings(ggpredict(mod.avg.i, terms = c("mpg [all]", "am"), verbose = FALSE))
     expect_equal(
       out$predicted[1:5],
@@ -64,8 +64,8 @@ withr::with_options(
 
     set.seed(123)
     m <- lm(disp ~ poly(mpg, 2, raw = TRUE) + am + gear, mtcars)
-    dr <- MuMIn::dredge(m)
-    mod.avg.poly <- MuMIn::model.avg(dr, fit = TRUE)
+    dr <- suppressMessages(MuMIn::dredge(m))
+    mod.avg.poly <- suppressMessages(MuMIn::model.avg(dr, fit = TRUE))
     out <- suppressWarnings(ggpredict(mod.avg.poly, terms = c("mpg [all]", "am")))
     expect_equal(
       out$predicted[1:5],

diff --git a/tests/testthat/test-brms-ppd.R b/tests/testthat/test-brms-ppd.R
@@ -35,9 +35,9 @@ test_that("ggpredict, brms-ppd", {
   expect_s3_class(ggpredict(m2, "x", interval = "confidence"), "data.frame")
 
   set.seed(123)
-  out1 <- suppressWarnings(ggpredict(m1, "x", interval = "prediction"))
+  out1 <- suppressWarnings(ggpredict(m1, "x", interval = "prediction", verbose = FALSE))
   set.seed(123)
-  out2 <- ggpredict(m1, "x", interval = "prediction")
+  out2 <- ggpredict(m1, "x", interval = "prediction", verbose = FALSE)
   expect_equal(out1$predicted, out2$predicted, tolerance = 1e-3)
   expect_equal(out1$conf.low, out2$conf.low, tolerance = 1e-3)
 })
diff --git a/tests/testthat/test-clmm.R b/tests/testthat/test-clmm.R
@@ -14,17 +14,17 @@ withr::with_package(
     m1 <- ordinal::clmm(rating ~ temp + contact + (1 | judge), data = wine)
 
     # ggpredict
-    p <- ggpredict(m1, "temp")
+    p <- ggpredict(m1, "temp", verbose = FALSE)
     expect_equal(p$predicted[1], 0.09760731, tolerance = 1e-3)
     ggpredict(m1, c("temp", "contact"))
 
     # ggeffect
-    p <- ggeffect(m1, "temp")
+    p <- ggeffect(m1, "temp", verbose = FALSE)
     expect_equal(p$predicted[1], 0.0730260420584538, tolerance = 1e-3)
     ggeffect(m1, c("temp", "contact"))
 
     # ggemmeans
-    p <- ggemmeans(m1, "contact")
+    p <- ggemmeans(m1, "contact", verbose = FALSE)
     expect_equal(p$predicted[1], 0.08691649, tolerance = 1e-5)
     ggemmeans(m1, c("temp", "contact"))
   })

diff --git a/tests/testthat/test-gamlss.R b/tests/testthat/test-gamlss.R
@@ -4,11 +4,11 @@ skip_if_not_installed("gamlss")
 
 test_that("ggpredict", {
   data(iris)
-  m1 <- gamlss::gamlss(
+  m1 <- suppressMessages(gamlss::gamlss(
     Sepal.Length ~ Sepal.Width + gamlss::random(Species),
     sigma.formula = ~Sepal.Width,
     data = iris
-  )
+  ))
 
   p <- ggpredict(m1, "Sepal.Width")
   expect_equal(
@@ -52,10 +52,10 @@ withr::with_environment(
       cat1 = sample(LETTERS[1:3], 100, replace = TRUE),
       stringsAsFactors = FALSE
     )
-    m <- gamlss::gamlss(
+    m <- suppressMessages(gamlss::gamlss(
       Y ~ date + scale(cont1) + scale(cont2) + I(scale(cont2)^2) * cat1,
       data = dat
-    )
+    ))
     expect_warning(expect_message(
       predict_response(m, "cont2"),
       regex = "is used on"

diff --git a/tests/testthat/test-glmmTMB.R b/tests/testthat/test-glmmTMB.R
@@ -47,12 +47,15 @@ withr::with_options(
 
     expect_s3_class(ggpredict(m1, c("ArrivalTime", "SexParent")), "data.frame")
     expect_s3_class(ggpredict(m2, c("ArrivalTime", "SexParent")), "data.frame")
-    expect_s3_class(ggpredict(m4, c("FoodTreatment", "ArrivalTime [21,24,30]", "SexParent")), "data.frame")
+    expect_s3_class(ggpredict(m4, c("FoodTreatment", "ArrivalTime [21,24,30]", "SexParent")), "data.frame") # nolint
     expect_s3_class(
       ggpredict(m1, c("ArrivalTime", "SexParent"), type = "random", verbose = FALSE),
       "data.frame"
     )
-    expect_s3_class(ggpredict(m4, c("FoodTreatment", "ArrivalTime [21,24,30]", "SexParent"), type = "random"), "data.frame")
+    expect_s3_class(
+      ggpredict(m4, c("FoodTreatment", "ArrivalTime [21,24,30]", "SexParent"), type = "random", verbose = FALSE), # nolint
+      "data.frame"
+    )
 
     expect_message(ggpredict(m1, c("ArrivalTime", "SexParent"), type = "zero_inflated"))
 

diff --git a/tests/testthat/test-lmer.R b/tests/testthat/test-lmer.R
@@ -32,7 +32,8 @@ test_that("validate ggpredict lmer against marginaleffects", {
     "e42dep",
     condition = c(grp = "child"),
     type = "random",
-    interval = "confidence"
+    interval = "confidence",
+    verbose = FALSE
   )
   expect_equal(
     out1$estimate,
@@ -53,9 +54,9 @@ test_that("ggpredict, lmer", {
   expect_s3_class(ggpredict(fit, "c12hour"), "data.frame")
   expect_s3_class(ggpredict(fit, c("c12hour", "c161sex")), "data.frame")
   expect_s3_class(ggpredict(fit, c("c12hour", "c161sex", "c172code")), "data.frame")
-  expect_s3_class(ggpredict(fit, "c12hour", type = "random"), "data.frame")
-  expect_s3_class(ggpredict(fit, c("c12hour", "c161sex"), type = "random"), "data.frame")
-  expect_s3_class(ggpredict(fit, c("c12hour", "c161sex", "c172code"), type = "random"), "data.frame")
+  expect_s3_class(ggpredict(fit, "c12hour", type = "random", verbose = FALSE), "data.frame")
+  expect_s3_class(ggpredict(fit, c("c12hour", "c161sex"), type = "random", verbose = FALSE), "data.frame") # nolint
+  expect_s3_class(ggpredict(fit, c("c12hour", "c161sex", "c172code"), type = "random", verbose = FALSE), "data.frame") # nolint
 })
 
 

diff --git a/tests/testthat/test-nlme.R b/tests/testthat/test-nlme.R
@@ -8,8 +8,8 @@ test_that("ggpredict, lme", {
   fit <- nlme::lme(distance ~ age + Sex, data = Orthodont, random = ~ 1 | Subject)
   expect_s3_class(ggpredict(fit, "age"), "data.frame")
   expect_s3_class(ggpredict(fit, c("age", "Sex")), "data.frame")
-  expect_s3_class(ggpredict(fit, "age", type = "random"), "data.frame")
-  expect_s3_class(ggpredict(fit, c("age", "Sex"), type = "random"), "data.frame")
+  expect_s3_class(ggpredict(fit, "age", type = "random", verbose = FALSE), "data.frame")
+  expect_s3_class(ggpredict(fit, c("age", "Sex"), type = "random", verbose = FALSE), "data.frame")
   expect_s3_class(ggeffect(fit, "age"), "data.frame")
   expect_s3_class(ggeffect(fit, c("age", "Sex")), "data.frame")
 })
@@ -20,8 +20,8 @@ test_that("ggpredict, lme", {
   m6 <- nlme::lme(distance ~ age * Sex, data = Orthodont, random = ~ age | Subject)
   expect_s3_class(ggpredict(m5, c("age", "Sex")), "data.frame")
   expect_s3_class(ggpredict(m6, c("age", "Sex")), "data.frame")
-  expect_s3_class(ggpredict(m5, c("age", "Sex"), type = "random"), "data.frame")
-  expect_s3_class(ggpredict(m6, c("age", "Sex"), type = "random"), "data.frame")
+  expect_s3_class(ggpredict(m5, c("age", "Sex"), type = "random", verbose = FALSE), "data.frame")
+  expect_s3_class(ggpredict(m6, c("age", "Sex"), type = "random", verbose = FALSE), "data.frame")
 })
 
 test_that("ggpredict, lme, type=re", {

diff --git a/tests/testthat/test-plot.R b/tests/testthat/test-plot.R
@@ -183,7 +183,7 @@ test_that("collapse groups works", {
   gge <- ggpredict(m, terms = "Diet")
   vdiffr::expect_doppelganger(
     "Collapse random effects works again",
-    plot(gge, collapse_group = TRUE)
+    plot(gge, collapse_group = TRUE, verbose = FALSE)
   )
 })
 
@@ -201,12 +201,12 @@ test_that("addn residuals", {
   set.seed(123)
   vdiffr::expect_doppelganger(
     "show residuals",
-    plot(pr, show_residuals = TRUE)
+    plot(pr, show_residuals = TRUE, verbose = FALSE)
   )
   set.seed(123)
   vdiffr::expect_doppelganger(
     "show residuals line",
-    plot(pr, show_residuals = TRUE, show_residuals_line = TRUE)
+    plot(pr, show_residuals = TRUE, show_residuals_line = TRUE, verbose = FALSE)
   )
 })
 
@@ -238,7 +238,7 @@ test_that("test plots from vignette", {
   set.seed(123)
   vdiffr::expect_doppelganger(
     "add-data-points",
-    plot(dat, show_data = TRUE)
+    plot(dat, show_data = TRUE, verbose = FALSE)
   )
   dat <- predict_response(fit, terms = c("c172code", "c161sex"))
   vdiffr::expect_doppelganger(
Original file line number	Diff line number	Diff line change
		@@ -1 +1 @@
		Maintainance release 2
		Release that fixes CRAN check issues.