R/sanity_model.R

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",
                                          ...) {
    return(model)
}


sanity_model_supported_class <- function(model) {
    checkmate::assert_character(
        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(
        "afex_aov",
        "amest", #package: Amelia
        "betareg",
        "bglmerMod",
        "blmerMod",
        # "bife",
        "biglm",
        c("bigglm", "biglm"),
        "brglmFit",
        "brmsfit",
        c("bracl", "brmultinom", "brglmFit"),
        c("brnb", "negbin", "glm"),
        c("clogit", "coxph"),
        "clm",
        "coxph",
        "crch",
        "fixest",
        "flic",
        "flac",
        c("Gam", "glm", "lm"), # package: gam
        c("gam", "glm", "lm"), # package: mgcv
        c("gamlss", "gam", "glm", "lm"), # package: gamlss
        c("geeglm", "gee", "glm"),
        "glm",
        "gls",
        "glmerMod",
        "glmrob",
        "glmmTMB",
        c("glmmPQL", "lme"),
        "glimML",
        "glmx",
        "hetprob",
        "hurdle",
        "hxlr",
        "ivreg",
        "iv_robust",
        "ivpml",
        "Learner",
        "lm",
        "lme",
        "lmerMod",
        "lmerModLmerTest",
        "lmrob",
        "lmRob",
        "lm_robust",
        # "logitr",
        "loess",
        "logistf",
        c("lrm", "lm"),
        c("lrm", "rms", "glm"),
        c("mblogit", "mclogit"),
        c("mclogit", "lm"),
        "MCMCglmm",
        "mhurdle",
        "mira",
        "mlogit",
        "model_fit",
        c("multinom", "nnet"),
        c("negbin", "glm", "lm"),
        "nls",
        c("ols", "rms", "lm"),
        c("orm", "rms"),
        c("oohbchoice", "dbchoice"),
        "phylolm",
        "phyloglm",
        c("plm", "panelmodel"),
        "polr",
        "Rchoice",
        "rlmerMod",
        "rq",
        c("scam", "glm", "lm"),
        c("selection", "selection", "list"),
        "speedglm",
        "speedlm",
        "stanreg",
        "survreg",
        "svyolr",
        c("tobit", "survreg"),
        "tobit1",
        "truncreg",
        "workflow",
        "zeroinfl"))
    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]),
            "",
            support,
            "",
            "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,
                           ...) {

    model <- sanitize_model_specific(model, vcov = vcov, newdata = newdata, ...)
    sanity_model_supported_class(model)
    return(model)
}

Try the marginaleffects package in your browser

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

marginaleffects documentation built on Oct. 20, 2023, 1:07 a.m.