Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Keep code R-3.6 compatible #252

Merged
merged 6 commits into from
Apr 27, 2024
Merged

Keep code R-3.6 compatible #252

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
6 commits
Select commit Hold shift + click to select a range
6eea589
Keep code R-3.6 compatible
strengejacke Apr 25, 2024
2269146
lintr
strengejacke Apr 25, 2024
8d9d366
use format_alerts
strengejacke Apr 25, 2024
64dd6ee
simplify
strengejacke Apr 25, 2024
ee7b9ad
fix styling issues
IndrajeetPatil Apr 27, 2024
a91a5fa
Merge branch 'main' into strengejacke/issue251
IndrajeetPatil Apr 27, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
4 changes: 0 additions & 4 deletions R/estimate_means.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -53,12 +53,10 @@
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, ...)
Expand Down Expand Up @@ -109,8 +107,6 @@
}
}

if (all(table_footer == "")) table_footer <- NULL

Check warning on line 110 in R/estimate_means.R

View workflow job for this annotation

GitHub Actions / lint-changed-files / lint-changed-files 

file=R/estimate_means.R,line=110,col=11,[nzchar_linter] Use !nzchar(x) instead of x == "". Note that unlike nzchar(), EQ coerces to character, so you'll have to use as.character() if x is a factor. Whenever missing data is possible, please take care to use nzchar(., keepNA = TRUE); nzchar(NA) is TRUE by default.

Check warning on line 110 in R/estimate_means.R

View workflow job for this annotation

GitHub Actions / lint / lint 

file=R/estimate_means.R,line=110,col=11,[nzchar_linter] Use !nzchar(x) instead of x == "". Note that unlike nzchar(), EQ coerces to character, so you'll have to use as.character() if x is a factor. Whenever missing data is possible, please take care to use nzchar(., keepNA = TRUE); nzchar(NA) is TRUE by default.
c(table_footer, "blue")
}


2 changes: 1 addition & 1 deletion R/get_emmeans.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -65,7 +65,7 @@
insight::check_if_installed("emmeans")

# Guess arguments
args <- .guess_emmeans_arguments(model, at, fixed, ...)

Check warning on line 68 in R/get_emmeans.R

View workflow job for this annotation

GitHub Actions / lint-changed-files / lint-changed-files 

file=R/get_emmeans.R,line=68,col=3,[object_overwrite_linter] 'args' is an exported object from package 'base'. Avoid re-using such symbols.


# Run emmeans
Expand Down Expand Up @@ -142,7 +142,7 @@
...) {
# Gather info
predictors <- insight::find_predictors(model, effects = "fixed", flatten = TRUE, ...)
data <- insight::get_data(model)

Check warning on line 145 in R/get_emmeans.R

View workflow job for this annotation

GitHub Actions / lint-changed-files / lint-changed-files 

file=R/get_emmeans.R,line=145,col=3,[object_overwrite_linter] 'data' is an exported object from package 'utils'. Avoid re-using such symbols.

# Guess arguments
if (!is.null(at) && length(at) == 1 && at == "auto") {
Expand All @@ -153,7 +153,7 @@
message("We selected `at = c(", toString(paste0('"', at, '"')), ")`.")
}

args <- list(at = at, fixed = fixed)

Check warning on line 156 in R/get_emmeans.R

View workflow job for this annotation

GitHub Actions / lint-changed-files / lint-changed-files 

file=R/get_emmeans.R,line=156,col=3,[object_overwrite_linter] 'args' is an exported object from package 'base'. Avoid re-using such symbols.
.format_emmeans_arguments(model, args, data, ...)
}

Expand All @@ -169,7 +169,7 @@
if (is.null(args$at)) {
args$data_matrix <- NULL
} else {
if (is.data.frame(args$at)) {

Check warning on line 172 in R/get_emmeans.R

View workflow job for this annotation

GitHub Actions / lint-changed-files / lint-changed-files 

file=R/get_emmeans.R,line=172,col=5,[unnecessary_nesting_linter] Simplify this condition by using 'else if' instead of 'else { if.
args$data_matrix <- args$at
args$at <- names(args$at)
} else if (is.list(args$at)) {
Expand All @@ -185,7 +185,7 @@
} else {
target <- args$at
}
grid <- insight::get_datagrid(data, at = target, ...)

Check warning on line 188 in R/get_emmeans.R

View workflow job for this annotation

GitHub Actions / lint-changed-files / lint-changed-files 

file=R/get_emmeans.R,line=188,col=7,[object_overwrite_linter] 'grid' is an exported object from package 'graphics'. Avoid re-using such symbols.
args$at <- attributes(grid)$at_specs$varname
args$data_matrix <- as.data.frame(grid[args$at])
if (length(args$at) == 0) args$at <- NULL # Post-clean
Expand Down Expand Up @@ -229,11 +229,11 @@
# It's annoying and an ugly fix, not sure how to address
if (!is.null(args$emmeans_at)) {
args$retransform <- list()
terms <- insight::find_terms(model)$conditional

Check warning on line 232 in R/get_emmeans.R

View workflow job for this annotation

GitHub Actions / lint-changed-files / lint-changed-files 

file=R/get_emmeans.R,line=232,col=5,[object_overwrite_linter] 'terms' is an exported object from package 'stats'. Avoid re-using such symbols.
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]]))
}
Expand Down
23 changes: 13 additions & 10 deletions R/get_marginalmeans.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -8,12 +8,12 @@
insight::check_if_installed("marginaleffects")

# Guess arguments
args <- .guess_arguments_means(model, at, ...)

Check warning on line 11 in R/get_marginalmeans.R

View workflow job for this annotation

GitHub Actions / lint-changed-files / lint-changed-files 

file=R/get_marginalmeans.R,line=11,col=3,[object_overwrite_linter] 'args' is an exported object from package 'base'. Avoid re-using such symbols.

# 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) {
Expand Down Expand Up @@ -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")
Expand All @@ -64,16 +67,16 @@
.guess_arguments_means <- function(model, at = NULL, ...) {
# Gather info and data from model
predictors <- insight::find_predictors(model, flatten = TRUE, ...)
data <- insight::get_data(model)

Check warning on line 70 in R/get_marginalmeans.R

View workflow job for this annotation

GitHub Actions / lint-changed-files / lint-changed-files 

file=R/get_marginalmeans.R,line=70,col=3,[object_overwrite_linter] 'data' is an exported object from package 'utils'. Avoid re-using such symbols.

# 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)
Expand Down
16 changes: 8 additions & 8 deletions tests/testthat/test-estimate_means.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -13,24 +13,24 @@
# Simple
model <- lm(vs ~ cyl, data = dat)
estim1 <- suppressMessages(estimate_means(model))
expect_equal(dim(estim1), c(3, 5))

Check warning on line 16 in tests/testthat/test-estimate_means.R

View workflow job for this annotation

GitHub Actions / lint-changed-files / lint-changed-files 

file=tests/testthat/test-estimate_means.R,line=16,col=3,[expect_identical_linter] Use expect_identical(x, y) by default; resort to expect_equal() only when needed, e.g. when setting ignore_attr= or tolerance=.
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)

Expand All @@ -42,22 +42,22 @@
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)
Expand Down Expand Up @@ -177,14 +177,14 @@

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)
})
Loading