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.

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

Rename at arguments into by #255

Merged
merged 24 commits into from
May 24, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
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
3 changes: 2 additions & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
Type: Package
Package: modelbased
Title: Estimation of Model-Based Predictions, Contrasts and Means
Version: 0.8.7
Version: 0.8.7.1
Authors@R:
c(person(given = "Dominique",
family = "Makowski",
Expand Down Expand Up @@ -76,3 +76,4 @@ Config/Needs/website:
rstudio/bslib,
r-lib/pkgdown,
easystats/easystatstemplate
Remotes: easystats/insight, easystats/datawizard, easystats/parameters, easystats/performance
64 changes: 35 additions & 29 deletions R/estimate_contrasts.R
Original file line number Diff line number Diff line change
Expand Up @@ -38,7 +38,7 @@
#' estimate_contrasts(model, fixed = "Petal.Width")
#'
#' # Or modulate it
#' estimate_contrasts(model, at = "Petal.Width", length = 4)
#' estimate_contrasts(model, by = "Petal.Width", length = 4)
#'
#' # Standardized differences
#' estimated <- estimate_contrasts(lm(Sepal.Width ~ Species, data = iris))
Expand Down Expand Up @@ -67,24 +67,30 @@
#' model <- stan_glm(mpg ~ cyl * wt, data = data, refresh = 0)
#' estimate_contrasts(model)
#' estimate_contrasts(model, fixed = "wt")
#' estimate_contrasts(model, at = "wt", length = 4)
#' estimate_contrasts(model, by = "wt", length = 4)
#'
#' model <- stan_glm(Sepal.Width ~ Species + Petal.Width + Petal.Length, data = iris, refresh = 0)
#' estimate_contrasts(model, at = "Petal.Length", test = "bf")
#' estimate_contrasts(model, by = "Petal.Length", test = "bf")
#' }
#'
#' @return A data frame of estimated contrasts.
#' @export
estimate_contrasts <- function(model,
contrast = NULL,
at = NULL,
by = NULL,
fixed = NULL,
transform = "none",
ci = 0.95,
p_adjust = "holm",
method = "pairwise",
adjust = NULL,
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
}

# Deprecation
if (!is.null(adjust)) {
insight::format_warning("The `adjust` argument is deprecated. Please write `p_adjust` instead.")
Expand All @@ -94,7 +100,7 @@ estimate_contrasts <- function(model,
# Run emmeans
estimated <- get_emcontrasts(model,
contrast = contrast,
at = at,
by = by,
fixed = fixed,
transform = transform,
method = method,
Expand All @@ -106,58 +112,58 @@ estimate_contrasts <- function(model,

# Summarize and clean
if (insight::model_info(model)$is_bayesian) {
contrasts <- bayestestR::describe_posterior(estimated, ci = ci, ...)
contrasts <- cbind(estimated@grid, contrasts)
contrasts <- .clean_names_bayesian(contrasts, model, transform, type = "contrast")
out <- cbind(estimated@grid, bayestestR::describe_posterior(estimated, ci = ci, verbose = FALSE, ...))
out <- .clean_names_bayesian(out, model, transform, type = "contrast")
} else {
contrasts <- as.data.frame(merge(
out <- as.data.frame(merge(
as.data.frame(estimated),
stats::confint(estimated, level = ci, adjust = p_adjust)
))
contrasts <- .clean_names_frequentist(contrasts)
out <- .clean_names_frequentist(out)
}
contrasts$null <- NULL # introduced in emmeans 1.6.1 (#115)
contrasts <- datawizard::data_relocate(
contrasts,
out$null <- NULL # introduced in emmeans 1.6.1 (#115)
out <- datawizard::data_relocate(
out,
c("CI_low", "CI_high"),
after = c("Difference", "Odds_ratio", "Ratio")
)


# Format contrasts names
# Split by either " - " or "/"
level_cols <- strsplit(as.character(contrasts$contrast), " - |\\/")
level_cols <- strsplit(as.character(out$contrast), " - |\\/")
level_cols <- data.frame(do.call(rbind, lapply(level_cols, trimws)))
names(level_cols) <- c("Level1", "Level2")
level_cols$Level1 <- gsub(",", " - ", level_cols$Level1, fixed = TRUE)
level_cols$Level2 <- gsub(",", " - ", level_cols$Level2, fixed = TRUE)

# Merge levels and rest
contrasts$contrast <- NULL
contrasts <- cbind(level_cols, contrasts)
out$contrast <- NULL
out <- cbind(level_cols, out)


# Table formatting
attr(contrasts, "table_title") <- c("Marginal Contrasts Analysis", "blue")
attr(contrasts, "table_footer") <- .estimate_means_footer(
contrasts,
attr(out, "table_title") <- c("Marginal Contrasts Analysis", "blue")
attr(out, "table_footer") <- .estimate_means_footer(
out,
info$contrast,
type = "contrasts",
p_adjust = p_adjust
)

# Add attributes
attr(contrasts, "model") <- model
attr(contrasts, "response") <- insight::find_response(model)
attr(contrasts, "ci") <- ci
attr(contrasts, "transform") <- transform
attr(contrasts, "at") <- info$at
attr(contrasts, "fixed") <- info$fixed
attr(contrasts, "contrast") <- info$contrast
attr(contrasts, "p_adjust") <- p_adjust
attr(out, "model") <- model
attr(out, "response") <- insight::find_response(model)
attr(out, "ci") <- ci
attr(out, "transform") <- transform
attr(out, "at") <- info$by
attr(out, "by") <- info$by
attr(out, "fixed") <- info$fixed
attr(out, "contrast") <- info$contrast
attr(out, "p_adjust") <- p_adjust


# Output
class(contrasts) <- c("estimate_contrasts", "see_estimate_contrasts", class(contrasts))
contrasts
class(out) <- c("estimate_contrasts", "see_estimate_contrasts", class(out))
out
}
43 changes: 17 additions & 26 deletions R/estimate_grouplevel.R
Original file line number Diff line number Diff line change
Expand Up @@ -18,39 +18,30 @@
#' indices (such as SE and CI), as these are not computable.
#' @param ... Other arguments passed to or from other methods.
#'
#' @examples
#' @examplesIf require("lme4") && require("see")
#' # lme4 model
#' if (require("lme4") && require("see")) {
#' model <- lmer(mpg ~ hp + (1 | carb), data = mtcars)
#' random <- estimate_grouplevel(model)
#' random
#' data(mtcars)
#' model <- lme4::lmer(mpg ~ hp + (1 | carb), data = mtcars)
#' random <- estimate_grouplevel(model)
#' random
#'
#' # Visualize random effects
#' plot(random)
#' # Visualize random effects
#' plot(random)
#'
#' # Show group-specific effects
#' estimate_grouplevel(model, deviation = FALSE)
#' # Show group-specific effects
#' estimate_grouplevel(model, deviation = FALSE)
#'
#' # Reshape to wide data so that it matches the original dataframe...
#' reshaped <- reshape_grouplevel(random, indices = c("Coefficient", "SE"))
#' # Reshape to wide data so that it matches the original dataframe...
#' reshaped <- reshape_grouplevel(random, indices = c("Coefficient", "SE"))
#'
#' # ... and can be easily combined
#' alldata <- cbind(mtcars, reshaped)
#' # ... and can be easily combined
#' alldata <- cbind(mtcars, reshaped)
#'
#' # Use summary() to remove duplicated rows
#' summary(reshaped)
#' # Use summary() to remove duplicated rows
#' summary(reshaped)
#'
#' # Compute BLUPs
#' estimate_grouplevel(model, type = "total")
#' }
#'
#' # Bayesian models
#' \donttest{
#' if (require("rstanarm")) {
#' model <- rstanarm::stan_lmer(mpg ~ hp + (1 | carb) + (1 | gear), data = mtcars, refresh = 0)
#' # Broken estimate_grouplevel(model)
#' }
#' }
#' # Compute BLUPs
#' estimate_grouplevel(model, type = "total")
#' @export
estimate_grouplevel <- function(model, type = "random", ...) {
# Extract params
Expand Down
36 changes: 21 additions & 15 deletions R/estimate_means.R
Original file line number Diff line number Diff line change
Expand Up @@ -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")
Expand All @@ -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, ...)
}

Expand Down Expand Up @@ -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
Expand All @@ -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")
}
7 changes: 5 additions & 2 deletions R/estimate_predicted.R
Original file line number Diff line number Diff line change
Expand Up @@ -176,7 +176,10 @@
#' # Bayesian models
#' \donttest{
#' if (require("rstanarm")) {
#' model <- rstanarm::stan_glm(mpg ~ wt, data = mtcars, refresh = 0, iter = 200)
#' model <- suppressWarnings(rstanarm::stan_glm(
#' mpg ~ wt,
#' data = mtcars, refresh = 0, iter = 200
#' ))
#' estimate_response(model)
#' estimate_relation(model)
#' }
Expand Down Expand Up @@ -207,7 +210,7 @@ estimate_response <- function(...) {
# TODO: If estimate_response() is removed, document `NULL` with this text.
insight::format_alert(
"`estimate_response()` is deprecated.",
"Please use `estimate_expectation()` (for conditional expected values) or `estimate_prediction()` (for individual case predictions) instead."
"Please use `estimate_expectation()` (for conditional expected values) or `estimate_prediction()` (for individual case predictions) instead." # nolint
)
estimate_expectation(...)
}
Expand Down
Loading
Loading