From 51d6e0ef02ff342dc715a86129bd6f6c1461a118 Mon Sep 17 00:00:00 2001 From: Daniel Date: Sat, 27 Apr 2024 21:40:43 +0200 Subject: [PATCH] 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 --- R/estimate_means.R | 4 ---- R/get_emmeans.R | 2 +- R/get_marginalmeans.R | 23 +++++++++++++---------- tests/testthat/test-estimate_means.R | 16 ++++++++-------- 4 files changed, 22 insertions(+), 23 deletions(-) diff --git a/R/estimate_means.R b/R/estimate_means.R index b410698b..042d89cc 100644 --- a/R/estimate_means.R +++ b/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") } - - diff --git a/R/get_emmeans.R b/R/get_emmeans.R index 6ff28d18..9f3782af 100644 --- a/R/get_emmeans.R +++ b/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]])) } diff --git a/R/get_marginalmeans.R b/R/get_marginalmeans.R index 89ae1b02..ecd81135 100644 --- a/R/get_marginalmeans.R +++ b/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) diff --git a/tests/testthat/test-estimate_means.R b/tests/testthat/test-estimate_means.R index a333f134..5eee7896 100644 --- a/tests/testthat/test-estimate_means.R +++ b/tests/testthat/test-estimate_means.R @@ -14,7 +14,7 @@ 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) @@ -22,7 +22,7 @@ test_that("estimate_means() - core", { 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) @@ -30,7 +30,7 @@ test_that("estimate_means() - core", { 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,14 +42,14 @@ 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) @@ -57,7 +57,7 @@ test_that("estimate_means() - core", { # 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) })