From 04458114b01850b490a928a57da8a65c29896f92 Mon Sep 17 00:00:00 2001 From: Daniel Date: Thu, 23 May 2024 08:12:38 +0200 Subject: [PATCH] fixes --- R/estimate_means.R | 36 ++++++----- R/get_emcontrasts.R | 49 ++++++++------- R/get_emmeans.R | 36 +++++------ R/get_emtrends.R | 50 ++++++++------- R/get_marginalcontrasts.R | 16 ++--- R/get_marginaleffects.R | 28 ++++++--- R/get_marginalmeans.R | 30 ++++----- man/estimate_means.Rd | 22 ++++--- man/get_emmeans.Rd | 32 +++++----- man/get_marginaleffects.Rd | 20 ++++-- tests/testthat/test-estimate_contrasts.R | 80 ++++++++++++------------ tests/testthat/test-glmmTMB.R | 14 ++--- 12 files changed, 231 insertions(+), 182 deletions(-) diff --git a/R/estimate_means.R b/R/estimate_means.R index 042d89cc..f870cb14 100644 --- a/R/estimate_means.R +++ b/R/estimate_means.R @@ -20,12 +20,12 @@ #' #' estimate_means(model) #' estimate_means(model, fixed = "Sepal.Width") -#' estimate_means(model, at = c("Species", "Sepal.Width"), length = 2) -#' estimate_means(model, at = "Species=c('versicolor', 'setosa')") -#' estimate_means(model, at = "Sepal.Width=c(2, 4)") -#' estimate_means(model, at = c("Species", "Sepal.Width=0")) -#' estimate_means(model, at = "Sepal.Width", length = 5) -#' estimate_means(model, at = "Sepal.Width=c(2, 4)") +#' estimate_means(model, by = c("Species", "Sepal.Width"), length = 2) +#' estimate_means(model, by = "Species=c('versicolor', 'setosa')") +#' estimate_means(model, by = "Sepal.Width=c(2, 4)") +#' estimate_means(model, by = c("Species", "Sepal.Width=0")) +#' estimate_means(model, by = "Sepal.Width", length = 5) +#' estimate_means(model, by = "Sepal.Width=c(2, 4)") #' #' # Methods that can be applied to it: #' means <- estimate_means(model, fixed = "Sepal.Width") @@ -42,24 +42,30 @@ #' #' model <- lmer(Petal.Length ~ Sepal.Width + Species + (1 | Petal.Length_factor), data = data) #' estimate_means(model) -#' estimate_means(model, at = "Sepal.Width", length = 3) +#' estimate_means(model, by = "Sepal.Width", length = 3) #' } #' @return A data frame of estimated marginal means. #' @export estimate_means <- function(model, - at = "auto", + by = "auto", fixed = NULL, transform = "response", ci = 0.95, backend = "emmeans", + at = NULL, ...) { + if (!is.null(at)) { + insight::format_warning("The `at` argument is deprecated and will be removed in the future. Please use `by` instead.") # nolint + by <- at + } + if (backend == "emmeans") { # Emmeans ------------------------------------------------------------------ - estimated <- get_emmeans(model, at, fixed, transform = transform, ...) + estimated <- get_emmeans(model, by, fixed, transform = transform, ...) means <- .format_emmeans_means(estimated, model, ci, transform, ...) } else { # Marginalmeans ------------------------------------------------------------ - estimated <- .get_marginalmeans(model, at, ci = ci, ...) + estimated <- .get_marginalmeans(model, by, ci = ci, ...) means <- .format_marginaleffects_means(estimated, model, ...) } @@ -88,14 +94,14 @@ estimate_means <- function(model, # Table Formating ---------------------------------------------------------- -.estimate_means_footer <- function(x, at = NULL, type = "means", p_adjust = NULL) { +.estimate_means_footer <- function(x, by = NULL, type = "means", p_adjust = NULL) { table_footer <- paste("\nMarginal", type) # Levels - if (!is.null(at) && length(at) > 0) { - table_footer <- paste0(table_footer, " estimated at ", toString(at)) + if (!is.null(by) && length(by) > 0) { + table_footer <- paste0(table_footer, " estimated at ", toString(by)) } else { - table_footer <- paste0(table_footer, " estimated at ", attr(x, "at")) + table_footer <- paste0(table_footer, " estimated at ", attr(x, "by")) } # P-value adjustment footer @@ -107,6 +113,6 @@ estimate_means <- function(model, } } - if (all(table_footer == "")) table_footer <- NULL + if (all(table_footer == "")) table_footer <- NULL # nolint c(table_footer, "blue") } diff --git a/R/get_emcontrasts.R b/R/get_emcontrasts.R index 17d0d71e..24ce04a3 100644 --- a/R/get_emcontrasts.R +++ b/R/get_emcontrasts.R @@ -23,41 +23,48 @@ #' # Can fixate the numeric at a specific value #' get_emcontrasts(model, fixed = "Petal.Width") #' # Or modulate it -#' get_emcontrasts(model, at = "Petal.Width", length = 4) +#' get_emcontrasts(model, by = "Petal.Width", length = 4) #' } #' @export get_emcontrasts <- function(model, contrast = NULL, - at = NULL, + by = NULL, fixed = NULL, transform = "none", method = "pairwise", + at = NULL, ...) { # check if available insight::check_if_installed("emmeans") + if (!is.null(at)) { + insight::format_warning("The `at` argument is deprecated and will be removed in the future. Please use `by` instead.") # nolint + by <- at + } + # Guess arguments - args <- .guess_emcontrasts_arguments(model, contrast, at, fixed, ...) + my_args <- .guess_emcontrasts_arguments(model, contrast, by, fixed, ...) # Run emmeans estimated <- emmeans::emmeans( model, - specs = args$emmeans_specs, - at = args$emmeans_at, + specs = my_args$emmeans_specs, + at = my_args$emmeans_at, type = transform, ... ) # Find by variables - by <- args$emmeans_specs[!args$emmeans_specs %in% args$contrast] - if (length(by) == 0) by <- NULL + emm_by <- my_args$emmeans_specs[!my_args$emmeans_specs %in% my_args$contrast] + if (length(emm_by) == 0) emm_by <- NULL - contrasts <- emmeans::contrast(estimated, by = by, method = method, ...) + out <- emmeans::contrast(estimated, by = emm_by, method = method, ...) - attr(contrasts, "contrast") <- args$contrast - attr(contrasts, "at") <- args$at - attr(contrasts, "fixed") <- args$fixed - contrasts + attr(out, "contrast") <- my_args$contrast + attr(out, "at") <- my_args$by + attr(out, "by") <- my_args$by + attr(out, "fixed") <- my_args$fixed + out } #' @rdname get_emmeans @@ -72,26 +79,24 @@ model_emcontrasts <- get_emcontrasts #' @keywords internal .guess_emcontrasts_arguments <- function(model, contrast = NULL, - at = NULL, + by = NULL, fixed = NULL, ...) { # Gather info predictors <- insight::find_predictors(model, effects = "fixed", flatten = TRUE, ...) - data <- insight::get_data(model) + model_data <- insight::get_data(model) # Guess arguments if (is.null(contrast)) { - contrast <- predictors[!sapply(data[predictors], is.numeric)][1] + contrast <- predictors[!sapply(model_data[predictors], is.numeric)][1] if (!length(contrast) || is.na(contrast)) { contrast <- predictors[1] } - message('No variable was specified for contrast estimation. Selecting `contrast = "', contrast, '"`.') - } else { - if (all(contrast == "all")) { - contrast <- predictors - } + insight::format_alert('No variable was specified for contrast estimation. Selecting `contrast = "', contrast, '"`.') # nolint + } else if (all(contrast == "all")) { + contrast <- predictors } - args <- list(contrast = contrast, at = at, fixed = fixed) - .format_emmeans_arguments(model, args, data, ...) + my_args <- list(contrast = contrast, by = by, fixed = fixed) + .format_emmeans_arguments(model, args = my_args, data = model_data, ...) } diff --git a/R/get_emmeans.R b/R/get_emmeans.R index 988eb3da..e0f58938 100644 --- a/R/get_emmeans.R +++ b/R/get_emmeans.R @@ -172,33 +172,33 @@ model_emmeans <- get_emmeans data <- data[insight::find_predictors(model, effects = "fixed", flatten = TRUE, ...)] # Deal with 'at' - if (is.null(args$at)) { + if (is.null(args$by)) { args$data_matrix <- NULL - } else if (is.data.frame(args$at)) { - args$data_matrix <- args$at - args$at <- names(args$at) - } else if (is.list(args$at)) { - args$data_matrix <- expand.grid(args$at) - args$at <- names(args$data_matrix) - } else if (inherits(args$at, "formula")) { - args$data_matrix <- stats::model.frame(args$at, data = data) - args$at <- names(args$data_matrix) + } else if (is.data.frame(args$by)) { + args$data_matrix <- args$by + args$by <- names(args$by) + } else if (is.list(args$by)) { + args$data_matrix <- expand.grid(args$by) + args$by <- names(args$data_matrix) + } else if (inherits(args$by, "formula")) { + args$data_matrix <- stats::model.frame(args$by, data = data) + args$by <- names(args$data_matrix) } else { - if (!is.null(args$at) && all(args$at == "all")) { + if (!is.null(args$by) && all(args$by == "all")) { target <- insight::find_predictors(model, effects = "fixed", flatten = TRUE) target <- target[!target %in% args$fixed] } else { - target <- args$at + target <- args$by } - datagrid <- insight::get_datagrid(data, at = target, ...) - args$at <- attributes(datagrid)$at_specs$varname - args$data_matrix <- as.data.frame(datagrid[args$at]) - if (length(args$at) == 0) args$at <- NULL # Post-clean + datagrid <- insight::get_datagrid(data, by = target, ...) + args$by <- attributes(datagrid)$at_specs$varname + args$data_matrix <- as.data.frame(datagrid[args$by]) + if (length(args$by) == 0) args$by <- NULL # Post-clean } # Deal with 'contrast' if (!is.null(args$contrast)) { - contrast <- insight::get_datagrid(data, at = args$contrast, ...) + contrast <- insight::get_datagrid(data, by = args$contrast, ...) args$contrast <- attributes(contrast)$at_specs$varname contrast <- as.data.frame(contrast[args$contrast]) if (is.null(args$data_matrix)) { @@ -211,7 +211,7 @@ model_emmeans <- get_emmeans # Deal with 'fixed' if (!is.null(args$fixed)) { - fixed <- insight::get_datagrid(data[args$fixed], at = NULL, ...) + fixed <- insight::get_datagrid(data[args$fixed], by = NULL, ...) if (is.null(args$data_matrix)) { args$data_matrix <- fixed } else { diff --git a/R/get_emtrends.R b/R/get_emtrends.R index d29334b0..6623c664 100644 --- a/R/get_emtrends.R +++ b/R/get_emtrends.R @@ -8,46 +8,52 @@ #' model <- lm(Sepal.Width ~ Species * Petal.Length, data = iris) #' #' get_emtrends(model) -#' get_emtrends(model, at = "Species") -#' get_emtrends(model, at = "Petal.Length") -#' get_emtrends(model, at = c("Species", "Petal.Length")) +#' get_emtrends(model, by = "Species") +#' get_emtrends(model, by = "Petal.Length") +#' get_emtrends(model, by = c("Species", "Petal.Length")) #' #' model <- lm(Petal.Length ~ poly(Sepal.Width, 4), data = iris) #' get_emtrends(model) -#' get_emtrends(model, at = "Sepal.Width") +#' get_emtrends(model, by = "Sepal.Width") #' } #' @export get_emtrends <- function(model, trend = NULL, - at = NULL, + by = NULL, fixed = NULL, levels = NULL, modulate = NULL, + at = NULL, ...) { # Deprecation + if (!is.null(at)) { + insight::format_warning("The `at` argument is deprecated and will be removed in the future. Please use `by` instead.") # nolint + by <- at + } if (!is.null(levels) || !is.null(modulate)) { - warning("The `levels` and `modulate` arguments are deprecated. Please use `at` instead.", call. = FALSE) - at <- c(levels, modulate) + insight::format_warning("The `levels` and `modulate` arguments are deprecated. Please use `by` instead.") # nolint + by <- c(levels, modulate) } # check if available insight::check_if_installed("emmeans") # Guess arguments - args <- .guess_emtrends_arguments(model, trend, at, fixed, ...) + my_args <- .guess_emtrends_arguments(model, trend, by, fixed, ...) # Run emtrends estimated <- emmeans::emtrends( model, - specs = args$emmeans_specs, - var = args$trend, - at = args$emmeans_at, + specs = my_args$emmeans_specs, + var = my_args$trend, + at = my_args$emmeans_at, ... ) - attr(estimated, "trend") <- args$trend - attr(estimated, "at") <- args$at - attr(estimated, "fixed") <- args$fixed + attr(estimated, "trend") <- my_args$trend + attr(estimated, "at") <- my_args$by + attr(estimated, "by") <- my_args$by + attr(estimated, "fixed") <- my_args$fixed estimated } @@ -62,26 +68,26 @@ model_emtrends <- get_emtrends #' @keywords internal .guess_emtrends_arguments <- function(model, trend = NULL, - at = NULL, + by = NULL, fixed = NULL, ...) { # Gather info predictors <- insight::find_predictors(model, effects = "fixed", flatten = TRUE, ...) - data <- insight::get_data(model) + model_data <- insight::get_data(model) # Guess arguments if (is.null(trend)) { - trend <- predictors[sapply(data[predictors], is.numeric)][1] + trend <- predictors[sapply(model_data[predictors], is.numeric)][1] if (!length(trend) || is.na(trend)) { - stop("Model contains no numeric predictor. Please specify 'trend'.", call. = FALSE) + insight::format_error("Model contains no numeric predictor. Please specify `trend`.") } - message('No numeric variable was specified for slope estimation. Selecting `trend = "', trend, '"`.') + insight::format_alert('No numeric variable was specified for slope estimation. Selecting `trend = "', trend, '"`.') } if (length(trend) > 1) { - message("More than one numeric variable was selected for slope estimation. Keeping only ", trend[1], ".") + insight::format_alert("More than one numeric variable was selected for slope estimation. Keeping only ", trend[1], ".") trend <- trend[1] } - args <- list(trend = trend, at = at, fixed = fixed) - .format_emmeans_arguments(model, args, data, ...) + my_args <- list(trend = trend, by = by, fixed = fixed) + .format_emmeans_arguments(model, args = my_args, data = model_data, ...) } diff --git a/R/get_marginalcontrasts.R b/R/get_marginalcontrasts.R index d2d9edc8..b57561b4 100644 --- a/R/get_marginalcontrasts.R +++ b/R/get_marginalcontrasts.R @@ -9,12 +9,12 @@ # # estimate_means(model) # estimate_means(model, fixed = "Sepal.Width") -# estimate_means(model, at = c("Species", "Sepal.Width"), length = 2) -# estimate_means(model, at = "Species=c('versicolor', 'setosa')") -# estimate_means(model, at = "Sepal.Width=c(2, 4)") -# estimate_means(model, at = c("Species", "Sepal.Width=0")) -# estimate_means(model, at = "Sepal.Width", length = 5) -# estimate_means(model, at = "Sepal.Width=c(2, 4)") +# estimate_means(model, by = c("Species", "Sepal.Width"), length = 2) +# estimate_means(model, by = "Species=c('versicolor', 'setosa')") +# estimate_means(model, by = "Sepal.Width=c(2, 4)") +# estimate_means(model, by = c("Species", "Sepal.Width=0")) +# estimate_means(model, by = "Sepal.Width", length = 5) +# estimate_means(model, by = "Sepal.Width=c(2, 4)") # # # Methods that can be applied to it: # means <- estimate_means(model, fixed = "Sepal.Width") @@ -29,13 +29,13 @@ # # model <- lmer(Petal.Length ~ Sepal.Width + Species + (1 | Petal.Length_factor), data = data) # estimate_means(model) -# estimate_means(model, at = "Sepal.Width", length = 3) +# estimate_means(model, by = "Sepal.Width", length = 3) # } # } # } # #' @keywords internal # .get_marginalmeans <- function(model, -# at = "auto", +# by = "auto", # fixed = NULL, # transform = "response", # ci = 0.95, diff --git a/R/get_marginaleffects.R b/R/get_marginaleffects.R index 8a0a6783..7481eb0e 100644 --- a/R/get_marginaleffects.R +++ b/R/get_marginaleffects.R @@ -9,19 +9,26 @@ #' if (require("marginaleffects")) { #' model <- lm(Sepal.Width ~ Species * Petal.Length, data = iris) #' -#' get_marginaleffects(model, trend = "Petal.Length", at = "Species") -#' get_marginaleffects(model, trend = "Petal.Length", at = "Petal.Length") -#' get_marginaleffects(model, trend = "Petal.Length", at = c("Species", "Petal.Length")) +#' get_marginaleffects(model, trend = "Petal.Length", by = "Species") +#' get_marginaleffects(model, trend = "Petal.Length", by = "Petal.Length") +#' get_marginaleffects(model, trend = "Petal.Length", by = c("Species", "Petal.Length")) #' } #' @export get_marginaleffects <- function(model, trend = NULL, - at = NULL, + by = NULL, fixed = NULL, + at = NULL, ...) { # check if available insight::check_if_installed("marginaleffects") + # Deprecation + if (!is.null(at)) { + insight::format_warning("The `at` argument is deprecated and will be removed in the future. Please use `by` instead.") # nolint + by <- at + } + # Guess arguments if (is.null(trend)) { trend <- insight::find_predictors(model, effects = "fixed", flatten = TRUE)[1] @@ -30,21 +37,22 @@ get_marginaleffects <- function(model, ) } - if (is.null(at)) { - at <- insight::find_predictors(model, effects = "fixed", flatten = TRUE) - at <- at[!at %in% trend] + if (is.null(by)) { + by <- insight::find_predictors(model, effects = "fixed", flatten = TRUE) + by <- by[!by %in% trend] } - newdata <- insight::get_datagrid(model, at = at, ...) + newdata <- insight::get_datagrid(model, by = by, ...) - fixed <- names(newdata)[!names(newdata) %in% c(at, trend)] + fixed <- names(newdata)[!names(newdata) %in% c(by, trend)] if (length(fixed) == 0) fixed <- NULL # Compute stuff estimated <- marginaleffects::slopes(model, variables = trend, newdata = newdata, ...) attr(estimated, "trend") <- trend - attr(estimated, "at") <- at + attr(estimated, "at") <- by + attr(estimated, "by") <- by attr(estimated, "fixed") <- fixed estimated } diff --git a/R/get_marginalmeans.R b/R/get_marginalmeans.R index ecd81135..4a141289 100644 --- a/R/get_marginalmeans.R +++ b/R/get_marginalmeans.R @@ -1,6 +1,6 @@ #' @keywords internal .get_marginalmeans <- function(model, - at = "auto", + by = "auto", ci = 0.95, marginal = FALSE, ...) { @@ -8,10 +8,10 @@ insight::check_if_installed("marginaleffects") # Guess arguments - args <- .guess_arguments_means(model, at, ...) + my_args <- .guess_arguments_means(model, by, ...) # Get corresponding datagrid (and deal with particular ats) - datagrid <- insight::get_datagrid(model, at = args$at, ...) + datagrid <- insight::get_datagrid(model, by = my_args$by, ...) # Drop random effects datagrid <- datagrid[insight::find_predictors(model, effects = "fixed", flatten = TRUE)] at_specs <- attributes(datagrid)$at_specs @@ -36,7 +36,8 @@ conf_level = ci ) } - attr(means, "at") <- args$at + attr(means, "at") <- my_args$by + attr(means, "by") <- my_args$by means } @@ -57,27 +58,28 @@ params <- datawizard::data_restoretype(params, insight::get_data(model)) # Store info - attr(params, "at") <- attr(means, "at") + attr(params, "at") <- attr(means, "by") + attr(params, "by") <- attr(means, "by") params } # Guess ------------------------------------------------------------------- #' @keywords internal -.guess_arguments_means <- function(model, at = NULL, ...) { +.guess_arguments_means <- function(model, by = NULL, ...) { # Gather info and data from model predictors <- insight::find_predictors(model, flatten = TRUE, ...) - data <- insight::get_data(model) + model_data <- insight::get_data(model) - # Guess arguments ('at' and 'fixed') - if (identical(at, "auto")) { + # Guess arguments ('by' and 'fixed') + if (identical(by, "auto")) { # Find categorical predictors - at <- predictors[!vapply(data[predictors], is.numeric, logical(1))] - if (!length(at) || all(is.na(at))) { - insight::format_error("Model contains no categorical factor. Please specify 'at'.") + by <- predictors[!vapply(model_data[predictors], is.numeric, logical(1))] + if (!length(by) || all(is.na(by))) { + insight::format_error("Model contains no categorical factor. Please specify 'by'.") } - insight::format_alert("We selected `at = c(", toString(paste0('"', at, '"')), ")`.") + insight::format_alert("We selected `by = c(", toString(paste0('"', by, '"')), ")`.") } - list(at = at) + list(by = by) } diff --git a/man/estimate_means.Rd b/man/estimate_means.Rd index 660b8f24..64040e93 100644 --- a/man/estimate_means.Rd +++ b/man/estimate_means.Rd @@ -6,17 +6,23 @@ \usage{ estimate_means( model, - at = "auto", + by = "auto", fixed = NULL, transform = "response", ci = 0.95, backend = "emmeans", + at = NULL, ... ) } \arguments{ \item{model}{A statistical model.} +\item{by}{The predictor variable(s) at which to evaluate the desired effect +/ mean / contrasts. Other predictors of the model that are not included +here will be collapsed and "averaged" over (the effect will be estimated +across them).} + \item{fixed}{A character vector indicating the names of the predictors to be "fixed" (i.e., maintained), so that the estimation is made at these values.} @@ -113,12 +119,12 @@ model <- lm(Petal.Length ~ Sepal.Width * Species, data = iris) estimate_means(model) estimate_means(model, fixed = "Sepal.Width") -estimate_means(model, at = c("Species", "Sepal.Width"), length = 2) -estimate_means(model, at = "Species=c('versicolor', 'setosa')") -estimate_means(model, at = "Sepal.Width=c(2, 4)") -estimate_means(model, at = c("Species", "Sepal.Width=0")) -estimate_means(model, at = "Sepal.Width", length = 5) -estimate_means(model, at = "Sepal.Width=c(2, 4)") +estimate_means(model, by = c("Species", "Sepal.Width"), length = 2) +estimate_means(model, by = "Species=c('versicolor', 'setosa')") +estimate_means(model, by = "Sepal.Width=c(2, 4)") +estimate_means(model, by = c("Species", "Sepal.Width=0")) +estimate_means(model, by = "Sepal.Width", length = 5) +estimate_means(model, by = "Sepal.Width=c(2, 4)") # Methods that can be applied to it: means <- estimate_means(model, fixed = "Sepal.Width") @@ -135,7 +141,7 @@ data$Petal.Length_factor <- ifelse(data$Petal.Length < 4.2, "A", "B") model <- lmer(Petal.Length ~ Sepal.Width + Species + (1 | Petal.Length_factor), data = data) estimate_means(model) -estimate_means(model, at = "Sepal.Width", length = 3) +estimate_means(model, by = "Sepal.Width", length = 3) } \dontshow{\}) # examplesIf} } diff --git a/man/get_emmeans.Rd b/man/get_emmeans.Rd index d0662b52..b8a714fd 100644 --- a/man/get_emmeans.Rd +++ b/man/get_emmeans.Rd @@ -13,20 +13,22 @@ get_emcontrasts( model, contrast = NULL, - at = NULL, + by = NULL, fixed = NULL, transform = "none", method = "pairwise", + at = NULL, ... ) model_emcontrasts( model, contrast = NULL, - at = NULL, + by = NULL, fixed = NULL, transform = "none", method = "pairwise", + at = NULL, ... ) @@ -55,20 +57,22 @@ model_emmeans( get_emtrends( model, trend = NULL, - at = NULL, + by = NULL, fixed = NULL, levels = NULL, modulate = NULL, + at = NULL, ... ) model_emtrends( model, trend = NULL, - at = NULL, + by = NULL, fixed = NULL, levels = NULL, modulate = NULL, + at = NULL, ... ) } @@ -78,6 +82,11 @@ model_emtrends( \item{contrast}{A character vector indicating the name of the variable(s) for which to compute the contrasts.} +\item{by}{The predictor variable(s) at which to evaluate the desired effect +/ mean / contrasts. Other predictors of the model that are not included +here will be collapsed and "averaged" over (the effect will be estimated +across them).} + \item{fixed}{A character vector indicating the names of the predictors to be "fixed" (i.e., maintained), so that the estimation is made at these values.} @@ -96,11 +105,6 @@ probabilities.} \item{...}{Other arguments passed for instance to \code{\link[insight:get_datagrid]{insight::get_datagrid()}}.} -\item{by}{The predictor variable(s) at which to evaluate the desired effect -/ mean / contrasts. Other predictors of the model that are not included -here will be collapsed and "averaged" over (the effect will be estimated -across them).} - \item{levels, modulate, at}{Deprecated, use \code{by} instead.} \item{trend}{A character indicating the name of the variable @@ -133,7 +137,7 @@ if (require("emmeans", quietly = TRUE)) { # Can fixate the numeric at a specific value get_emcontrasts(model, fixed = "Petal.Width") # Or modulate it - get_emcontrasts(model, at = "Petal.Width", length = 4) + get_emcontrasts(model, by = "Petal.Width", length = 4) } model <- lm(Sepal.Length ~ Species + Petal.Width, data = iris) @@ -158,12 +162,12 @@ if (require("emmeans")) { model <- lm(Sepal.Width ~ Species * Petal.Length, data = iris) get_emtrends(model) - get_emtrends(model, at = "Species") - get_emtrends(model, at = "Petal.Length") - get_emtrends(model, at = c("Species", "Petal.Length")) + get_emtrends(model, by = "Species") + get_emtrends(model, by = "Petal.Length") + get_emtrends(model, by = c("Species", "Petal.Length")) model <- lm(Petal.Length ~ poly(Sepal.Width, 4), data = iris) get_emtrends(model) - get_emtrends(model, at = "Sepal.Width") + get_emtrends(model, by = "Sepal.Width") } } diff --git a/man/get_marginaleffects.Rd b/man/get_marginaleffects.Rd index 5b8a47a3..b344146e 100644 --- a/man/get_marginaleffects.Rd +++ b/man/get_marginaleffects.Rd @@ -4,7 +4,14 @@ \alias{get_marginaleffects} \title{Easy marginaleffects} \usage{ -get_marginaleffects(model, trend = NULL, at = NULL, fixed = NULL, ...) +get_marginaleffects( + model, + trend = NULL, + by = NULL, + fixed = NULL, + at = NULL, + ... +) } \arguments{ \item{model}{A statistical model.} @@ -12,6 +19,11 @@ get_marginaleffects(model, trend = NULL, at = NULL, fixed = NULL, ...) \item{trend}{A character indicating the name of the variable for which to compute the slopes.} +\item{by}{The predictor variable(s) at which to evaluate the desired effect +/ mean / contrasts. Other predictors of the model that are not included +here will be collapsed and "averaged" over (the effect will be estimated +across them).} + \item{fixed}{A character vector indicating the names of the predictors to be "fixed" (i.e., maintained), so that the estimation is made at these values.} @@ -25,8 +37,8 @@ Work-in-progress. if (require("marginaleffects")) { model <- lm(Sepal.Width ~ Species * Petal.Length, data = iris) - get_marginaleffects(model, trend = "Petal.Length", at = "Species") - get_marginaleffects(model, trend = "Petal.Length", at = "Petal.Length") - get_marginaleffects(model, trend = "Petal.Length", at = c("Species", "Petal.Length")) + get_marginaleffects(model, trend = "Petal.Length", by = "Species") + get_marginaleffects(model, trend = "Petal.Length", by = "Petal.Length") + get_marginaleffects(model, trend = "Petal.Length", by = c("Species", "Petal.Length")) } } diff --git a/tests/testthat/test-estimate_contrasts.R b/tests/testthat/test-estimate_contrasts.R index 9a2db2b0..381ea981 100644 --- a/tests/testthat/test-estimate_contrasts.R +++ b/tests/testthat/test-estimate_contrasts.R @@ -8,10 +8,10 @@ test_that("estimate_contrasts - Frequentist", { model <- lm(Sepal.Width ~ Species, data = dat) estim <- suppressMessages(estimate_contrasts(model)) - expect_equal(dim(estim), c(3, 9)) + expect_identical(dim(estim), c(3L, 9L)) - estim <- suppressMessages(estimate_contrasts(model, at = "Species=c('versicolor', 'virginica')")) - expect_equal(dim(estim), c(1, 9)) + estim <- suppressMessages(estimate_contrasts(model, by = "Species=c('versicolor', 'virginica')")) + expect_identical(dim(estim), c(1L, 9L)) # Two factors dat <- iris @@ -21,29 +21,29 @@ test_that("estimate_contrasts - Frequentist", { model <- lm(Sepal.Width ~ Species * fac, data = dat) estim <- suppressMessages(estimate_contrasts(model)) - expect_equal(dim(estim), c(3, 9)) + expect_identical(dim(estim), c(3L, 9L)) estim <- suppressMessages(estimate_contrasts(model, levels = "Species")) - expect_equal(dim(estim), c(3, 9)) + expect_identical(dim(estim), c(3L, 9L)) estim <- suppressMessages(estimate_contrasts(model, fixed = "fac")) - expect_equal(dim(estim), c(3, 10)) + expect_identical(dim(estim), c(3L, 10L)) # One factor and one continuous model <- lm(Sepal.Width ~ Species * Petal.Width, data = iris) estim <- suppressMessages(estimate_contrasts(model)) - expect_equal(dim(estim), c(3, 9)) + expect_identical(dim(estim), c(3L, 9L)) estim <- suppressMessages(estimate_contrasts(model, fixed = "Petal.Width")) - expect_equal(dim(estim), c(3, 10)) - estim <- suppressMessages(estimate_contrasts(model, at = "Petal.Width", length = 4)) - expect_equal(dim(estim), c(12, 10)) + expect_identical(dim(estim), c(3L, 10L)) + estim <- suppressMessages(estimate_contrasts(model, by = "Petal.Width", length = 4)) + expect_identical(dim(estim), c(12L, 10L)) # Contrast between continuous model <- lm(Sepal.Width ~ Petal.Length, data = iris) - estim <- suppressMessages(estimate_contrasts(model, at = "Petal.Length=c(2.3, 3)")) - expect_equal(dim(estim), c(1, 9)) - estim <- suppressMessages(estimate_contrasts(model, at = "Petal.Length=c(2, 3, 4)")) - expect_equal(dim(estim), c(3, 9)) + estim <- suppressMessages(estimate_contrasts(model, by = "Petal.Length=c(2.3, 3)")) + expect_identical(dim(estim), c(1L, 9L)) + estim <- suppressMessages(estimate_contrasts(model, by = "Petal.Length=c(2, 3, 4)")) + expect_identical(dim(estim), c(3L, 9L)) # Three factors @@ -52,12 +52,12 @@ test_that("estimate_contrasts - Frequentist", { dat <<- dat model <- lm(mpg ~ gear * vs * am, data = dat) - estim <- suppressMessages(estimate_contrasts(model, at = "all")) - expect_equal(dim(estim), c(12, 11)) + estim <- suppressMessages(estimate_contrasts(model, by = "all")) + expect_identical(dim(estim), c(12L, 11L)) estim <- suppressMessages(estimate_contrasts(model, contrast = c("vs", "am"), fixed = "gear")) - expect_equal(dim(estim), c(6, 10)) - estim <- suppressMessages(estimate_contrasts(model, contrast = c("vs", "am"), at = "gear='5'")) - expect_equal(dim(estim), c(1, 10)) + expect_identical(dim(estim), c(6L, 10L)) + estim <- suppressMessages(estimate_contrasts(model, contrast = c("vs", "am"), by = "gear='5'")) + expect_identical(dim(estim), c(1L, 10L)) dat <- iris @@ -68,14 +68,14 @@ test_that("estimate_contrasts - Frequentist", { model <- lm(Petal.Width ~ factor1 * factor2 * factor3, data = dat) - estim <- suppressMessages(estimate_contrasts(model, contrast = c("factor1", "factor2", "factor3"), at = "all")) - expect_equal(dim(estim), c(28, 9)) + estim <- suppressMessages(estimate_contrasts(model, contrast = c("factor1", "factor2", "factor3"), by = "all")) + expect_identical(dim(estim), c(28L, 9L)) estim <- suppressMessages(estimate_contrasts(model, contrast = c("factor1", "factor2"), fixed = "factor3")) - expect_equal(dim(estim), c(6, 10)) - estim <- suppressMessages(estimate_contrasts(model, contrast = c("factor1", "factor2"), at = "factor3='F'")) - expect_equal(dim(estim), c(6, 10)) - estim <- suppressMessages(estimate_contrasts(model, contrast = c("factor1", "factor2"), at = "factor3")) - expect_equal(dim(estim), c(12, 10)) + expect_identical(dim(estim), c(6L, 10L)) + estim <- suppressMessages(estimate_contrasts(model, contrast = c("factor1", "factor2"), by = "factor3='F'")) + expect_identical(dim(estim), c(6L, 10L)) + estim <- suppressMessages(estimate_contrasts(model, contrast = c("factor1", "factor2"), by = "factor3")) + expect_identical(dim(estim), c(12L, 10L)) # Mixed models @@ -84,7 +84,7 @@ test_that("estimate_contrasts - Frequentist", { model <- lme4::lmer(Sepal.Width ~ Species + (1 | Petal.Length_factor), data = data) estim <- suppressMessages(estimate_contrasts(model)) - expect_equal(dim(estim), c(3, 9)) + expect_identical(dim(estim), c(3L, 9L)) # GLM - binomial @@ -94,9 +94,9 @@ test_that("estimate_contrasts - Frequentist", { model <- glm(y ~ Species, family = "binomial", data = dat) estim <- suppressMessages(estimate_contrasts(model)) - expect_equal(dim(estim), c(3, 9)) + expect_identical(dim(estim), c(3L, 9L)) estim <- suppressMessages(estimate_contrasts(model, transform = "response")) - expect_equal(dim(estim), c(3, 9)) + expect_identical(dim(estim), c(3L, 9L)) # GLM - poisson dat <- data.frame( @@ -107,7 +107,7 @@ test_that("estimate_contrasts - Frequentist", { model <- glm(counts ~ treatment, data = dat, family = poisson()) estim <- suppressMessages(estimate_contrasts(model, transform = "response")) - expect_equal(dim(estim), c(3, 9)) + expect_identical(dim(estim), c(3L, 9L)) }) @@ -131,9 +131,9 @@ test_that("estimate_contrasts - Bayesian", { ) ) estim <- suppressMessages(estimate_contrasts(model, contrast = "all")) - expect_equal(dim(estim), c(15, 7)) + expect_identical(dim(estim), c(15L, 7L)) estim <- suppressMessages(estimate_contrasts(model, fixed = "Petal.Length_factor")) - expect_equal(dim(estim), c(3, 8)) + expect_identical(dim(estim), c(3L, 8L)) model <- suppressWarnings( rstanarm::stan_glm( @@ -145,11 +145,11 @@ test_that("estimate_contrasts - Bayesian", { ) ) estim <- suppressMessages(estimate_contrasts(model)) - expect_equal(dim(estim), c(3, 7)) + expect_identical(dim(estim), c(3L, 7L)) estim <- suppressMessages(estimate_contrasts(model, fixed = "Petal.Width")) - expect_equal(dim(estim), c(3, 8)) - estim <- suppressMessages(estimate_contrasts(model, at = "Petal.Width", length = 4)) - expect_equal(dim(estim), c(12, 8)) + expect_identical(dim(estim), c(3L, 8L)) + estim <- suppressMessages(estimate_contrasts(model, by = "Petal.Width", length = 4)) + expect_identical(dim(estim), c(12L, 8L)) # GLM dat <- iris @@ -161,14 +161,14 @@ test_that("estimate_contrasts - Bayesian", { )) estim <- suppressMessages(estimate_contrasts(model)) - expect_equal(dim(estim), c(3, 7)) + expect_identical(dim(estim), c(3L, 7L)) estim <- suppressMessages(estimate_contrasts(model, transform = "response")) - expect_equal(dim(estim), c(3, 7)) + expect_identical(dim(estim), c(3L, 7L)) estim <- suppressWarnings(suppressMessages(estimate_contrasts(model, test = "bf"))) - expect_equal(dim(estim), c(3, 6)) + expect_identical(dim(estim), c(3L, 6L)) estim <- suppressWarnings(suppressMessages(estimate_contrasts(model, transform = "response", test = "bf"))) - expect_equal(dim(estim), c(3, 6)) + expect_identical(dim(estim), c(3L, 6L)) }) diff --git a/tests/testthat/test-glmmTMB.R b/tests/testthat/test-glmmTMB.R index ab844581..61d72c8b 100644 --- a/tests/testthat/test-glmmTMB.R +++ b/tests/testthat/test-glmmTMB.R @@ -28,14 +28,14 @@ test_that("estimate_means - glmmTMB", { test_that("estimate_contrasts - glmmTMB", { estim <- suppressMessages(estimate_contrasts(model)) - expect_equal(dim(estim), c(1, 9)) + expect_identical(dim(estim), c(1L, 9L)) expect_equal(estim$Difference, -1.141923, tolerance = 1e-1) - expect_equal(c(estim$Level1[1], estim$Level2[1]), c("yes", "no")) + expect_identical(c(estim$Level1[1], estim$Level2[1]), c("yes", "no")) estim <- suppressMessages(estimate_contrasts(model, component = "zi")) - expect_equal(dim(estim), c(1, 9)) + expect_identical(dim(estim), c(1L, 9L)) expect_equal(estim$Difference, 1.736067, tolerance = 1e-1) - expect_equal(c(estim$Level1[1], estim$Level2[1]), c("yes", "no")) + expect_identical(c(estim$Level1[1], estim$Level2[1]), c("yes", "no")) }) test_that("estimate_slope - glmmTMB", { @@ -50,15 +50,15 @@ test_that("estimate_slope - glmmTMB", { test_that("estimate_response - glmmTMB", { estim <- suppressMessages(estimate_expectation(model2)) - expect_equal(dim(estim), c(nrow(data), 8)) + expect_identical(dim(estim), c(nrow(data), 8L)) }) test_that("estimate_link - glmmTMB", { estim <- suppressMessages(estimate_link(model2, preserve_range = FALSE)) - expect_equal(dim(estim), c(20, 7)) + expect_identical(dim(estim), c(20L, 7L)) }) test_that("estimate_response - glmmTMB", { estim <- suppressMessages(estimate_expectation(model2)) - expect_equal(dim(estim), c(644, 8)) + expect_identical(dim(estim), c(644L, 8L)) })