R/get_degrees_of_freedom.R

In marginaleffects: Predictions, Comparisons, Slopes, Marginal Means, and Hypothesis Tests

get_degrees_of_freedom <- function(model, df = Inf, newdata = NULL) {
    # before NULL return
    if (isTRUE(checkmate::check_choice(vcov, c("satterthwaite", "kenward-roger")))) {
        df <- vcov
    }

    if (isTRUE(checkmate::check_choice(df, c("satterthwaite", "kenward-roger")))) {
        checkmate::assert_data_frame(newdata)
        # predict.lmerTest requires the DV
        if (inherits(model, "lmerMod")) {
            dv <- insight::find_response(model)
            if (!dv %in% colnames(newdata)) {
                newdata[[dv]] <- mean(insight::get_response(model))
            }
        }

        tmp <- try(
            insight::get_df(x = model, data = newdata, type = df, df_per_obs = TRUE),
            silent = TRUE
        )
        if (inherits(tmp, "try-error")) {
            msg <- "Unable to extract degrees of freedom of type `%s` for model of class `%s`."
            stop_sprintf(msg, df, class(model)[1])
        }
        df <- tmp

    } else if (isTRUE(checkmate::check_choice(df, "residual"))) {
        tmp <- try(
            insight::get_df(x = model, data = newdata, type = df, df_per_obs = TRUE),
            silent = TRUE
        )
        if (inherits(tmp, "try-error")) {
            msg <- "Unable to extract degrees of freedom of type `%s` for model of class `%s`."
            stop_sprintf(msg, df, class(model)[1])
        }
        df <- tmp

    } else if (
        isTRUE(checkmate::check_number(df, lower = Inf)) ||
            isFALSE(df) ||
            isTRUE(checkmate::check_null(df))
    ) {
        return(Inf)
    } else if (isTRUE(checkmate::check_numeric(df))) {
        # pass
    } else if (isTRUE(df)) {
        df <- try(insight::get_df(x = model), silent = TRUE)
    } else {
        stop("Invalid arguments for `get_df`.")
    }

    if (isTRUE(checkmate::check_data_frame(newdata))) {
        checkmate::assert(
            checkmate::check_numeric(df, len = 1),
            checkmate::check_numeric(df, len = nrow(newdata))
        )
    }

    return(df)
}


sanitize_df <- function(
    df,
    model,
    newdata = NULL,
    by = NULL,
    hypothesis = NULL,
    vcov = NULL
) {
    # K-W changes both the vcov and the df
    # Satterthwaite changes the df but not the vcov
    if (isTRUE(checkmate::check_choice(vcov, c("satterthwaite", "kenward-roger")))) {
        if (
            !isFALSE(by) ||
                !isTRUE(checkmate::check_number(hypothesis, null.ok = TRUE))
        ) {
            msg <- sprintf(
                "Satterthwaite and Kenward-Roger adjustments are not supported in this command with the `by` or `hypothesis` arguments, or with the `avg_` function prefix. One common strategy is to use the smallest unit-level degree of freedom. This can be obtained from the `df` column generated by calling the same function without `by` or `hypothesis` argument."
            )
            stop(msg, call. = FALSE)
        }
        df <- vcov
    }
    checkmate::assert(
        checkmate::check_true(df),
        checkmate::check_number(df, lower = 1),
        checkmate::check_numeric(df, len = nrow(newdata)),
        checkmate::check_choice(df, c("residual", "satterthwaite", "kenward-roger"))
    )

    return(df)
}