Keep code R-3.6 compatible (#252)

* Keep code R-3.6 compatible
Fixes #251

* lintr

* use format_alerts

* simplify

* fix styling issues

---------

Co-authored-by: Indrajeet Patil <[email protected]>

R/estimate_means.R

@@ -53,12 +53,10 @@ estimate_means <- function(model,
                            ci = 0.95,
                            backend = "emmeans",
                            ...) {
-
   if (backend == "emmeans") {
     # Emmeans ------------------------------------------------------------------
     estimated <- get_emmeans(model, at, fixed, transform = transform, ...)
     means <- .format_emmeans_means(estimated, model, ci, transform, ...)
-
   } else {
     # Marginalmeans ------------------------------------------------------------
     estimated <- .get_marginalmeans(model, at, ci = ci, ...)
@@ -112,5 +110,3 @@ estimate_means <- function(model,
   if (all(table_footer == "")) table_footer <- NULL
   c(table_footer, "blue")
 }
-
-

R/get_emmeans.R

@@ -233,7 +233,7 @@ model_emmeans <- get_emmeans
     for (var_at in names(args$emmeans_at)) {
       term <- terms[grepl(var_at, terms, fixed = TRUE)]
       if (any(grepl(paste0("as.factor(", var_at, ")"), term, fixed = TRUE)) ||
-          any(grepl(paste0("as.character(", var_at, ")"), term, fixed = TRUE))) {
+        any(grepl(paste0("as.character(", var_at, ")"), term, fixed = TRUE))) {
         args$retransform[[var_at]] <- args$emmeans_at[[var_at]]
         args$emmeans_at[[var_at]] <- as.numeric(as.character(args$emmeans_at[[var_at]]))
       }

R/get_marginalmeans.R

@@ -13,7 +13,7 @@
   # Get corresponding datagrid (and deal with particular ats)
   datagrid <- insight::get_datagrid(model, at = args$at, ...)
   # Drop random effects
-  datagrid <- datagrid[insight::find_predictors(model, effects="fixed", flatten = TRUE)]
+  datagrid <- datagrid[insight::find_predictors(model, effects = "fixed", flatten = TRUE)]
   at_specs <- attributes(datagrid)$at_specs
 
   if (marginal) {
@@ -46,12 +46,15 @@
 
 #' @keywords internal
 .format_marginaleffects_means <- function(means, model, ...) {
+  # check if available
+  insight::check_if_installed("datawizard")
+
   # Format
-  params <- parameters::parameters(means) |>
-    datawizard::data_relocate(c("Predicted", "SE", "CI_low", "CI_high"), after = -1) |>
-    datawizard::data_rename("Predicted", "Mean") |>
-    datawizard::data_remove(c("p", "Statistic", "s.value", "S", "CI")) |>
-    datawizard::data_restoretype(insight::get_data(model))
+  params <- parameters::parameters(means)
+  params <- datawizard::data_relocate(params, c("Predicted", "SE", "CI_low", "CI_high"), after = -1)
+  params <- datawizard::data_rename(params, "Predicted", "Mean")
+  params <- datawizard::data_remove(params, c("p", "Statistic", "s.value", "S", "CI"))
+  params <- datawizard::data_restoretype(params, insight::get_data(model))
 
   # Store info
   attr(params, "at") <- attr(means, "at")
@@ -67,13 +70,13 @@
   data <- insight::get_data(model)
 
   # Guess arguments ('at' and 'fixed')
-  if (!is.null(at) && length(at) == 1 && at == "auto") {
+  if (identical(at, "auto")) {
     # Find categorical predictors
-    at <- predictors[!sapply(data[predictors], is.numeric)]
+    at <- predictors[!vapply(data[predictors], is.numeric, logical(1))]
     if (!length(at) || all(is.na(at))) {
-      stop("Model contains no categorical factor. Please specify 'at'.", call. = FALSE)
+      insight::format_error("Model contains no categorical factor. Please specify 'at'.")
     }
-    message("We selected `at = c(", toString(paste0('"', at, '"')), ")`.")
+    insight::format_alert("We selected `at = c(", toString(paste0('"', at, '"')), ")`.")
   }
 
   list(at = at)

tests/testthat/test-estimate_means.R

@@ -14,23 +14,23 @@ test_that("estimate_means() - core", {
   model <- lm(vs ~ cyl, data = dat)
   estim1 <- suppressMessages(estimate_means(model))
   expect_equal(dim(estim1), c(3, 5))
-  estim2 <- suppressMessages(estimate_means(model, backend="marginaleffects"))
+  estim2 <- suppressMessages(estimate_means(model, backend = "marginaleffects"))
   expect_equal(dim(estim2), c(3, 5))
   expect_true(max(estim1$Mean - estim2$Mean) < 1e-10)
 
   # Interaction (factor * continuous)
   model <- lm(mpg ~ wt * gear, data = dat)
   estim1 <- suppressMessages(estimate_means(model))
   expect_equal(dim(estim1), c(3, 5))
-  estim2 <- suppressMessages(estimate_means(model, backend="marginaleffects"))
+  estim2 <- suppressMessages(estimate_means(model, backend = "marginaleffects"))
   expect_equal(dim(estim2), c(3, 6))
   expect_true(max(estim1$Mean - estim2$Mean) < 1e-10)
 
   # At specific levels
   model <- lm(Sepal.Width ~ Species, data = iris)
   estim1 <- suppressMessages(estimate_means(model, at = "Species=c('versicolor', 'virginica')"))
   expect_equal(dim(estim1), c(2, 5))
-  estim2 <- suppressMessages(estimate_means(model, at = "Species=c('versicolor', 'virginica')", backend="marginaleffects"))
+  estim2 <- suppressMessages(estimate_means(model, at = "Species=c('versicolor', 'virginica')", backend = "marginaleffects"))
   expect_equal(dim(estim2), c(2, 5))
   expect_true(max(estim1$Mean - estim2$Mean) < 1e-10)
 
@@ -42,22 +42,22 @@ test_that("estimate_means() - core", {
   model <- lm(Sepal.Width ~ Species * Petal.Length_factor, data = dat)
   estim1 <- suppressMessages(estimate_means(model, at = "all"))
   expect_equal(dim(estim1), c(6, 6))
-  estim2 <- suppressWarnings(suppressMessages(estimate_means(model, at = "all", backend="marginaleffects")))
+  estim2 <- suppressWarnings(suppressMessages(estimate_means(model, at = "all", backend = "marginaleffects")))
   expect_equal(dim(estim2), c(6, 6))
 
   # No interaction (two factors)
   model <- lm(Petal.Length ~ Sepal.Width + Species, data = iris)
   estim1 <- suppressMessages(estimate_means(model))
   expect_equal(dim(estim1), c(3, 5))
-  estim2 <- suppressMessages(estimate_means(model, backend="marginaleffects"))
+  estim2 <- suppressMessages(estimate_means(model, backend = "marginaleffects"))
   expect_equal(dim(estim2), c(3, 6))
   expect_true(max(estim1$Mean - estim2$Mean) < 1e-10)
 
 
   # At specific levels of continuous
   estim1 <- suppressMessages(estimate_means(model, at = "Sepal.Width"))
   expect_equal(dim(estim1), c(10, 5))
-  estim2 <- suppressMessages(estimate_means(model, at = "Sepal.Width", backend="marginaleffects"))
+  estim2 <- suppressMessages(estimate_means(model, at = "Sepal.Width", backend = "marginaleffects"))
   expect_equal(dim(estim2), c(10, 6))
   # Note that the absolute values are different here... for unclear reasons
   expect_true(max(diff(estim1$Mean) - diff(estim2$Mean)) < 1e-10)
@@ -177,14 +177,14 @@ test_that("estimate_means() - mixed models", {
 
   estim1 <- suppressMessages(estimate_means(model))
   expect_equal(dim(estim1), c(3, 5))
-  estim2 <- suppressMessages(estimate_means(model, backend="marginaleffects"))
+  estim2 <- suppressMessages(estimate_means(model, backend = "marginaleffects"))
   expect_equal(dim(estim2), c(3, 5))
   expect_true(max(estim1$Mean - estim2$Mean) < 1e-10)
 
   model <- lme4::glmer(Sepal.Width ~ Species + (1 | Petal.Length_factor), data = dat, family = "Gamma")
   estim1 <- suppressMessages(estimate_means(model))
   expect_equal(dim(estim1), c(3, 5))
-  estim2 <- suppressMessages(estimate_means(model, backend="marginaleffects"))
+  estim2 <- suppressMessages(estimate_means(model, backend = "marginaleffects"))
   expect_equal(dim(estim2), c(3, 5))
   expect_true(max(estim1$Mean - estim2$Mean) < 1e-10)
 })