R/model_get_contrasts.R

Defines functions model_get_contrasts_3 model_get_contrasts_2 model_get_contrasts_1 model_get_contrasts.default model_get_contrasts

Documented in model_get_contrasts

#' Get contrasts used in the model
#'
#' @param model a model object
#' @export
#' @family model_helpers
#' @examples
#' glm(
#'   am ~ mpg + factor(cyl),
#'   data = mtcars,
#'   family = binomial,
#'   contrasts = list(`factor(cyl)` = contr.sum)
#' ) %>%
#'   model_get_contrasts()
model_get_contrasts <- function(model) {
  UseMethod("model_get_contrasts")
}

#' @export
model_get_contrasts.default <- function(model) {
  # we try 3 different approaches in a row
  mc <- model_get_contrasts_1(model)
  if (is.null(mc))
    mc <- model_get_contrasts_2(model)
  if (is.null(mc))
    mc <- model_get_contrasts_3(model)
  mc
}

model_get_contrasts_1 <- function(model) {
  tryCatch(
    purrr::chuck(model, "contrasts"),
    error = function(e) {
      NULL
    }
  )
}

model_get_contrasts_2 <- function(model) {
  tryCatch(
    attr(model_get_model_matrix(model), "contrasts"),
    error = function(e) {
      NULL
    }
  )
}

model_get_contrasts_3 <- function(model) {
  tryCatch(
    attr(stats::model.matrix(stats::terms(model), stats::model.frame(model)), "contrasts"),
    error = function(e) {
      NULL
    }
  )
}

Try the broom.helpers package in your browser

Any scripts or data that you put into this service are public.

broom.helpers documentation built on Sept. 30, 2021, 5:10 p.m.