From 2f28eafda8dee7b7b34d34779a056be4e88ca62e Mon Sep 17 00:00:00 2001 From: Jacob Long Date: Sun, 28 Jul 2024 12:14:38 -0400 Subject: [PATCH] Add support for "at" argument in sim_slopes --- DESCRIPTION | 2 +- R/int_utils.R | 50 +++++++++++++++++++++++++++++++---------------- R/simple_slopes.R | 16 +++++++++++---- man/sim_slopes.Rd | 9 +++++++++ 4 files changed, 55 insertions(+), 22 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index f175d6e..8b25c3b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -42,4 +42,4 @@ Enhances: rstanarm VignetteBuilder: knitr Roxygen: list(markdown = TRUE) -RoxygenNote: 7.2.3 +RoxygenNote: 7.3.2.9000 diff --git a/R/int_utils.R b/R/int_utils.R index 20a8861..8ec64dd 100644 --- a/R/int_utils.R +++ b/R/int_utils.R @@ -354,18 +354,19 @@ auto_mod_vals <- ## Centering center_ss <- function(d, weights, facvars = NULL, fvars, pred, resp, modx, - survey, design = NULL, mod2, wname, offname, centered) { + survey, design = NULL, mod2, wname, offname, centered, + at = NULL) { # Just need to pick a helper function based on survey vs no survey if (survey == TRUE) { out <- center_ss_survey(d, weights, facvars, fvars, pred, resp, modx, - survey, design, mod2, wname, offname, centered) + survey, design, mod2, wname, offname, centered, at) } else { out <- center_ss_non_survey(d, weights, facvars, fvars, pred, resp, modx, - mod2, wname, offname, centered) + mod2, wname, offname, centered, at) } @@ -377,7 +378,7 @@ center_ss <- function(d, weights, facvars = NULL, fvars, pred, resp, modx, ## If not svydesign, centering is fairly straightforward center_ss_non_survey <- function(d, weights, facvars = NULL, fvars, pred, - resp, modx, mod2, wname, offname, centered) { + resp, modx, mod2, wname, offname, centered, at) { omitvars <- c(pred, resp, modx, mod2, wname, offname) @@ -389,8 +390,8 @@ center_ss_non_survey <- function(d, weights, facvars = NULL, fvars, pred, if (centered[1] != "all" && centered[1] != "none") { if (any(omitvars %in% centered)) { - warning("Moderators, outcome variables, and weights/offsets", - " cannot be centered.") + warn_wrap("Moderators, outcome variables, and weights/offsets + cannot be centered.") centered <- centered[centered %nin% omitvars] } if (length(centered) > 0) { @@ -431,8 +432,9 @@ center_ss_non_survey <- function(d, weights, facvars = NULL, fvars, pred, } - # Fixes a data type error with predict() later - d <- as.data.frame(d) + if (!is.null(at)) { + d <- set_at(at = at, d = d) + } out <- list(d = d, facvars = facvars, fvars = fvars, design = NULL) @@ -444,9 +446,9 @@ center_ss_non_survey <- function(d, weights, facvars = NULL, fvars, pred, center_ss_survey <- function(d, weights, facvars = NULL, fvars, pred, resp, modx, survey, design, mod2, wname, offname, - centered) { + centered, at) { - omitvars <- c(pred, resp, modx, mod2, wname, offname) + omitvars <- c(pred, resp, modx, mod2, wname, offname, names(at)) # Dealing with two-level factors that aren't part of an interaction # /focal pred @@ -456,8 +458,8 @@ center_ss_survey <- function(d, weights, facvars = NULL, fvars, pred, resp, if (centered[1] != "all" && centered[1] != "none") { if (any(omitvars %in% centered)) { - warning("Moderators, outcome variables, and weights/offsets", - " cannot be centered.") + warn_wrap("Moderators, outcome variables, and weights/offsets cannot be + centered.") centered <- centered[centered %nin% omitvars] } design <- gscale(vars = centered, data = design, center.only = TRUE) @@ -475,19 +477,15 @@ center_ss_survey <- function(d, weights, facvars = NULL, fvars, pred, resp, } } else if (centered == "none") { - # Dealing with two-level factors that aren't part # of an interaction/focal pred for (v in fv2) { if (is.factor(d[[v]]) && length(unique(d[[v]])) == 2) { - facvars <- c(facvars, v) - } } } else if (centered == "all") { - # Center all non-focal ndfvars <- fvars[fvars %nin% omitvars] @@ -495,13 +493,32 @@ center_ss_survey <- function(d, weights, facvars = NULL, fvars, pred, resp, design <- gscale(vars = ndfvars, data = design, center.only = TRUE) d <- design$variables } + } + if (!is.null(at)) { + d <- set_at(at = at, d = d) } out <- list(d = d, design = design, facvars = facvars, fvars = fvars) return(out) +} +#### Deal with at variables ################################################# +set_at <- function(at, d) { + for (v in names(at)) { + if (v %nin% names(d)) stop_wrap("`at` variable ", v, " not found in data.") + if (!is.numeric(d[[v]])) { + warn_wrap("Inclusion of non-numeric variable ", v, " in `at` argument + is not currently supported. As an alternative, treat the + variable as a factor and use the relevel() function to + set this value as its reference level before fitting your + model.") + } else { + d[[v]] <- d[[v]] - at[[v]] + } + } + return(d) } #### Send deprecation warnings ############################################## @@ -923,7 +940,6 @@ drop_factor_levels <- function(d, var, values, labels) { } - # get_contrasts <- function(model) { # form <- as.formula(formula(model)) # as.data.frame(t(attr(terms(form), "factors"))) diff --git a/R/simple_slopes.R b/R/simple_slopes.R index 7db31ad..988b96c 100644 --- a/R/simple_slopes.R +++ b/R/simple_slopes.R @@ -10,6 +10,14 @@ #' also use "none" to base all predictions on variables set at 0. #' The response variable, `modx`, and `mod2` variables are never #' centered. +#' +#' @param at If you want to manually set the values of other variables in the +#' model, do so by providing a named list where the names are the variables and +#' the list values are vectors of the values. Note that you cannot alter the +#' values of the `pred`, `modx`, or `mod2` variables and this will take +#' precedence over the `centered` argument (but any variables unmentioned by +#' `at` will be centered as specified by `centered`). For linear models, +#' this will only change the output of the conditional intercepts. #' #' @param cond.int Should conditional intercepts be printed in addition to the #' slopes? Default is \code{FALSE}. @@ -125,9 +133,9 @@ #' sim_slopes <- function(model, pred, modx, mod2 = NULL, modx.values = NULL, - mod2.values = NULL, centered = "all", data = NULL, - cond.int = FALSE, johnson_neyman = TRUE, jnplot = FALSE, - jnalpha = .05, robust = FALSE, + mod2.values = NULL, centered = "all", at = NULL, + data = NULL, cond.int = FALSE, johnson_neyman = TRUE, + jnplot = FALSE, jnalpha = .05, robust = FALSE, digits = getOption("jtools-digits", default = 2), pvals = TRUE, confint = FALSE, ci.width = .95, cluster = NULL, modx.labels = NULL, mod2.labels = NULL, @@ -271,7 +279,7 @@ sim_slopes <- function(model, pred, modx, mod2 = NULL, modx.values = NULL, fvars = fvars, pred = pred, resp = resp, modx = modx, survey = is_survey, design = design, mod2 = mod2, wname = wname, - offname = offname, centered = centered) + offname = offname, centered = centered, at = at) design <- c_out$design d <- c_out$d diff --git a/man/sim_slopes.Rd b/man/sim_slopes.Rd index b9a4de8..56ae34b 100644 --- a/man/sim_slopes.Rd +++ b/man/sim_slopes.Rd @@ -12,6 +12,7 @@ sim_slopes( modx.values = NULL, mod2.values = NULL, centered = "all", + at = NULL, data = NULL, cond.int = FALSE, johnson_neyman = TRUE, @@ -86,6 +87,14 @@ also use "none" to base all predictions on variables set at 0. The response variable, \code{modx}, and \code{mod2} variables are never centered.} +\item{at}{If you want to manually set the values of other variables in the +model, do so by providing a named list where the names are the variables and +the list values are vectors of the values. Note that you cannot alter the +values of the \code{pred}, \code{modx}, or \code{mod2} variables and this will take +precedence over the \code{centered} argument (but any variables unmentioned by +\code{at} will be centered as specified by \code{centered}). For linear models, +this will only change the output of the conditional intercepts.} + \item{data}{Optional, default is NULL. You may provide the data used to fit the model. This can be a better way to get mean values for centering and can be crucial for models with variable transformations in the formula