Defines functions sanitize_model sanity_model_supported_class sanitize_model_specific.default

Documented in sanitize_model_specific.default

#' Method to raise model-specific warnings and errors
#' @inheritParams slopes
#' @return A warning, an error, or nothing
#' @rdname sanitize_model_specific
#' @keywords internal
sanitize_model_specific <- function (model, ...) {
    UseMethod("sanitize_model_specific", model)

#' @rdname sanitize_model_specific
sanitize_model_specific.default <- function(model,
                                          vcov = NULL,
                                          calling_function = "marginaleffects",
                                          ...) {

sanity_model_supported_class <- function(model) {
        getOption("marginaleffects_model_classes", default = NULL),
        null.ok = TRUE)
    custom_classes <- getOption("marginaleffects_model_classes", default = NULL)
    custom_classes <- as.list(custom_classes)
    supported <- append(custom_classes, list(
        "amest", #package: Amelia
        "bart", # package: dbarts
        # "bife",
        c("bigglm", "biglm"),
        c("bracl", "brmultinom", "brglmFit"),
        c("brnb", "negbin", "glm"),
        c("clogit", "coxph"),
        c("clmm2", "clm2"),
        "flexsurvreg", # package: flexsurv
        c("Gam", "glm", "lm"), # package: gam
        c("gam", "glm", "lm"), # package: mgcv
        c("gamlss", "gam", "glm", "lm"), # package: gamlss
        c("geeglm", "gee", "glm"),
        c("Gls", "rms", "gls"),
        c("glmmPQL", "lme"),
        # "logitr",
        c("lrm", "lm"),
        c("lrm", "rms", "glm"),
        c("mblogit", "mclogit"),
        c("mclogit", "lm"),
        c("multinom", "nnet"),
        c("negbin", "glm", "lm"),
        c("ols", "rms", "lm"),
        c("orm", "rms"),
        c("oohbchoice", "dbchoice"),
        c("plm", "panelmodel"),
        c("scam", "glm", "lm"),
        c("selection", "selection", "list"),
        c("tobit", "survreg"),
    flag <- FALSE
    for (sup in supported) {
        if (!is.null(sup) && isTRUE(all(sup %in% class(model)))) {
            flag <- TRUE
    if (isFALSE(flag)) {
        support <- paste(sort(unique(sapply(supported, function(x) x[1]))), collapse = ", ")
        msg <- c(
            sprintf('Models of class "%s" are not supported. Supported model classes include:', class(model)[1]),
            "New modeling packages can usually be supported by `marginaleffects` if they include a working `predict()` method. If you believe that this is the case, please file a feature request on Github: https://github.com/vincentarelbundock/marginaleffects/issues")
        msg <- insight::format_message(msg)
        stop(msg, call. = FALSE)

sanitize_model <- function(model,
                           newdata = NULL,
                           vcov = NULL,
                           by = FALSE,
                           ...) {

    model <- sanitize_model_specific(model, vcov = vcov, newdata = newdata, by = by, ...)

Try the marginaleffects package in your browser

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

marginaleffects documentation built on May 29, 2024, 4:03 a.m.