R/methods_marginaleffects.R

In easystats/parameters: Processing of Model Parameters

# x <- lm(Sepal.Width ~ Species * Petal.Length, data = iris)
# model <- marginaleffects(x, newdata = insight::get_datagrid(x, at = "Species"), variables = "Petal.Length")

# model_parameters ----------------

#' @export
model_parameters.marginaleffects <- function(model,
                                             ci = 0.95,
                                             exponentiate = FALSE,
                                             ...) {
  insight::check_if_installed("marginaleffects")

  tidy_model <- marginaleffects::tidy(model, conf_level = ci, ...)
  out <- .rename_reserved_marginaleffects(tidy_model)
  out <- insight::standardize_names(out, style = "easystats")
  # in case data grid contained column names that are reserved words,
  # rename those back now...
  colnames(out) <- gsub("#####$", "", colnames(out))

  # contrast_ columns provide indispensable information about the comparisons
  colnames(out)[colnames(out) == "contrast"] <- "Comparison"
  colnames(out) <- gsub("^contrast_", "Comparison: ", colnames(out))

  out <- .safe(.add_model_parameters_attributes(out, model, ci, exponentiate = exponentiate, ...), out)

  attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(model))

  # do not print or report these columns
  out <- out[, !colnames(out) %in% c("predicted_lo", "predicted_hi"), drop = FALSE]

  if (inherits(model, "marginalmeans")) {
    attr(out, "coefficient_name") <- "Marginal Means"
  } else if (inherits(model, "comparisons")) {
    attr(out, "coefficient_name") <- "Estimate"
    attr(out, "title") <- "Contrasts between Adjusted Predictions"
    if ("Type" %in% colnames(out)) {
      attr(out, "prediction_type") <- out$Type[1]
    }
  } else if (inherits(model, "slopes")) {
    attr(out, "coefficient_name") <- "Slope"
  } else if (inherits(model, "predictions")) {
    attr(out, "coefficient_name") <- "Predicted"
  } else if (inherits(model, "hypotheses")) {
    attr(out, "coefficient_name") <- "Estimate"
  }

  # exponentiate coefficients and SE/CI, if requested
  out <- .exponentiate_parameters(out, model = NULL, exponentiate)

  # add further information as attributes
  out <- .add_model_parameters_attributes(
    out,
    model = model,
    ci = ci,
    exponentiate = exponentiate,
    ...
  )

  class(out) <- c("parameters_model", "see_parameters_model", class(out))
  out
}

#' @export
model_parameters.comparisons <- model_parameters.marginaleffects


#' @export
model_parameters.marginalmeans <- model_parameters.marginaleffects


#' @export
model_parameters.hypotheses <- model_parameters.marginaleffects


#' @export
model_parameters.slopes <- model_parameters.marginaleffects


#' @export
model_parameters.predictions <- function(model,
                                         ci = 0.95,
                                         exponentiate = FALSE,
                                         ...) {
  insight::check_if_installed("marginaleffects")

  out <- .rename_reserved_marginaleffects(model)
  out <- datawizard::data_rename(out, "estimate", "predicted")
  out <- datawizard::data_relocate(out, "predicted", before = 1)
  out <- insight::standardize_names(out, style = "easystats")
  out <- insight::standardize_column_order(out, style = "easystats")
  # in case data grid contained column names that are reserved words,
  # rename those back now...
  colnames(out) <- gsub("#####$", "", colnames(out))

  # remove and reorder some columns
  out$rowid <- out$Type <- NULL
  out <- datawizard::data_relocate(out, select = attributes(model)$newdata_at, after = "Predicted")

  # extract response, remove from data frame
  reg_model <- attributes(model)$model
  if (!is.null(reg_model) && insight::is_model(reg_model)) {
    resp <- insight::find_response(reg_model)
    out[[resp]] <- NULL
  }

  out <- .safe(.add_model_parameters_attributes(out, model, ci, exponentiate = exponentiate, ...), out)

  attr(out, "object_name") <- insight::safe_deparse_symbol(substitute(model))
  attr(out, "coefficient_name") <- "Predicted"
  attr(out, "no_caption") <- TRUE

  # exponentiate coefficients and SE/CI, if requested
  out <- .exponentiate_parameters(out, model = NULL, exponentiate)

  # add further information as attributes
  out <- .add_model_parameters_attributes(
    out,
    model = model,
    ci = ci,
    exponentiate = exponentiate,
    ...
  )

  class(out) <- c("parameters_model", "see_parameters_model", class(out))
  out
}


.rename_reserved_marginaleffects <- function(model) {
  # get focal terms - we might escape column names where focal terms
  # equal "reserved" names, like t- or z-statistic
  focal_terms <- attributes(model)$focal_terms
  reserved <- c("t", "z")
  renamed_focal <- NULL

  # any focal terms equals reserved words? if so, rename
  if (any(reserved %in% focal_terms)) {
    renamed_focal <- focal_terms[focal_terms %in% reserved]
    model <- datawizard::data_rename(
      model,
      select = renamed_focal,
      replacement = paste0(renamed_focal, "#####")
    )
  }
  model
}