R/logregord.h.R

Defines functions logRegOrd

Documented in logRegOrd

# This file is automatically generated, you probably don't want to edit this

logRegOrdOptions <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
    "logRegOrdOptions",
    inherit = jmvcore::Options,
    public = list(
        initialize = function(
            dep = NULL,
            covs = NULL,
            factors = NULL,
            blocks = list(
                list()),
            refLevels = NULL,
            modelTest = FALSE,
            dev = TRUE,
            aic = TRUE,
            bic = FALSE,
            pseudoR2 = list(
                "r2mf"),
            omni = FALSE,
            thres = FALSE,
            ci = FALSE,
            ciWidth = 95,
            OR = FALSE,
            ciOR = FALSE,
            ciWidthOR = 95, ...) {

            super$initialize(
                package="jmv",
                name="logRegOrd",
                requiresData=TRUE,
                ...)

            private$..dep <- jmvcore::OptionVariable$new(
                "dep",
                dep,
                suggested=list(
                    "ordinal"),
                permitted=list(
                    "factor"))
            private$..covs <- jmvcore::OptionVariables$new(
                "covs",
                covs,
                suggested=list(
                    "continuous"),
                permitted=list(
                    "numeric"),
                default=NULL)
            private$..factors <- jmvcore::OptionVariables$new(
                "factors",
                factors,
                suggested=list(
                    "nominal"),
                permitted=list(
                    "factor"),
                default=NULL)
            private$..blocks <- jmvcore::OptionArray$new(
                "blocks",
                blocks,
                default=list(
                    list()),
                template=jmvcore::OptionTerms$new(
                    "blocks",
                    NULL))
            private$..refLevels <- jmvcore::OptionArray$new(
                "refLevels",
                refLevels,
                items="(factors)",
                default=NULL,
                template=jmvcore::OptionGroup$new(
                    "refLevels",
                    NULL,
                    elements=list(
                        jmvcore::OptionVariable$new(
                            "var",
                            NULL,
                            content="$key"),
                        jmvcore::OptionLevel$new(
                            "ref",
                            NULL))))
            private$..modelTest <- jmvcore::OptionBool$new(
                "modelTest",
                modelTest,
                default=FALSE)
            private$..dev <- jmvcore::OptionBool$new(
                "dev",
                dev,
                default=TRUE)
            private$..aic <- jmvcore::OptionBool$new(
                "aic",
                aic,
                default=TRUE)
            private$..bic <- jmvcore::OptionBool$new(
                "bic",
                bic,
                default=FALSE)
            private$..pseudoR2 <- jmvcore::OptionNMXList$new(
                "pseudoR2",
                pseudoR2,
                options=list(
                    "r2mf",
                    "r2cs",
                    "r2n"),
                default=list(
                    "r2mf"))
            private$..omni <- jmvcore::OptionBool$new(
                "omni",
                omni,
                default=FALSE)
            private$..thres <- jmvcore::OptionBool$new(
                "thres",
                thres,
                default=FALSE)
            private$..ci <- jmvcore::OptionBool$new(
                "ci",
                ci,
                default=FALSE)
            private$..ciWidth <- jmvcore::OptionNumber$new(
                "ciWidth",
                ciWidth,
                min=50,
                max=99.9,
                default=95)
            private$..OR <- jmvcore::OptionBool$new(
                "OR",
                OR,
                default=FALSE)
            private$..ciOR <- jmvcore::OptionBool$new(
                "ciOR",
                ciOR,
                default=FALSE)
            private$..ciWidthOR <- jmvcore::OptionNumber$new(
                "ciWidthOR",
                ciWidthOR,
                min=50,
                max=99.9,
                default=95)

            self$.addOption(private$..dep)
            self$.addOption(private$..covs)
            self$.addOption(private$..factors)
            self$.addOption(private$..blocks)
            self$.addOption(private$..refLevels)
            self$.addOption(private$..modelTest)
            self$.addOption(private$..dev)
            self$.addOption(private$..aic)
            self$.addOption(private$..bic)
            self$.addOption(private$..pseudoR2)
            self$.addOption(private$..omni)
            self$.addOption(private$..thres)
            self$.addOption(private$..ci)
            self$.addOption(private$..ciWidth)
            self$.addOption(private$..OR)
            self$.addOption(private$..ciOR)
            self$.addOption(private$..ciWidthOR)
        }),
    active = list(
        dep = function() private$..dep$value,
        covs = function() private$..covs$value,
        factors = function() private$..factors$value,
        blocks = function() private$..blocks$value,
        refLevels = function() private$..refLevels$value,
        modelTest = function() private$..modelTest$value,
        dev = function() private$..dev$value,
        aic = function() private$..aic$value,
        bic = function() private$..bic$value,
        pseudoR2 = function() private$..pseudoR2$value,
        omni = function() private$..omni$value,
        thres = function() private$..thres$value,
        ci = function() private$..ci$value,
        ciWidth = function() private$..ciWidth$value,
        OR = function() private$..OR$value,
        ciOR = function() private$..ciOR$value,
        ciWidthOR = function() private$..ciWidthOR$value),
    private = list(
        ..dep = NA,
        ..covs = NA,
        ..factors = NA,
        ..blocks = NA,
        ..refLevels = NA,
        ..modelTest = NA,
        ..dev = NA,
        ..aic = NA,
        ..bic = NA,
        ..pseudoR2 = NA,
        ..omni = NA,
        ..thres = NA,
        ..ci = NA,
        ..ciWidth = NA,
        ..OR = NA,
        ..ciOR = NA,
        ..ciWidthOR = NA)
)

logRegOrdResults <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
    "logRegOrdResults",
    inherit = jmvcore::Group,
    active = list(
        modelFit = function() private$.items[["modelFit"]],
        modelComp = function() private$.items[["modelComp"]],
        models = function() private$.items[["models"]]),
    private = list(),
    public=list(
        initialize=function(options) {
            super$initialize(
                options=options,
                name="",
                title="Ordinal Logistic Regression")
            self$add(jmvcore::Table$new(
                options=options,
                name="modelFit",
                title="Model Fit Measures",
                clearWith=list(
                    "dep",
                    "blocks"),
                visible="(dev || aic || bic || pseudoR2:r2mf || pseudoR2:r2cs || pseudoR2:r2n || modelTest)",
                columns=list(
                    list(
                        `name`="model", 
                        `title`="Model", 
                        `type`="text"),
                    list(
                        `name`="dev", 
                        `title`="Deviance", 
                        `type`="number", 
                        `visible`="(dev)"),
                    list(
                        `name`="aic", 
                        `title`="AIC", 
                        `type`="number", 
                        `visible`="(aic)"),
                    list(
                        `name`="bic", 
                        `title`="BIC", 
                        `type`="number", 
                        `visible`="(bic)"),
                    list(
                        `name`="r2mf", 
                        `title`="R\u00B2<sub>McF</sub>", 
                        `type`="number", 
                        `visible`="(pseudoR2:r2mf)"),
                    list(
                        `name`="r2cs", 
                        `title`="R\u00B2<sub>CS</sub>", 
                        `type`="number", 
                        `visible`="(pseudoR2:r2cs)"),
                    list(
                        `name`="r2n", 
                        `title`="R\u00B2<sub>N</sub>", 
                        `type`="number", 
                        `visible`="(pseudoR2:r2n)"),
                    list(
                        `name`="chi", 
                        `title`="\u03C7\u00B2", 
                        `type`="number", 
                        `superTitle`="Overall Model Test", 
                        `visible`="(modelTest)"),
                    list(
                        `name`="df", 
                        `title`="df", 
                        `type`="integer", 
                        `superTitle`="Overall Model Test", 
                        `visible`="(modelTest)"),
                    list(
                        `name`="p", 
                        `title`="p", 
                        `type`="number", 
                        `format`="zto,pvalue", 
                        `superTitle`="Overall Model Test", 
                        `visible`="(modelTest)"))))
            self$add(jmvcore::Table$new(
                options=options,
                name="modelComp",
                title="Model Comparisons",
                clearWith=list(
                    "dep",
                    "blocks"),
                columns=list(
                    list(
                        `name`="model1", 
                        `title`="Model", 
                        `content`=".", 
                        `type`="text", 
                        `superTitle`="Comparison"),
                    list(
                        `name`="sep", 
                        `title`="", 
                        `content`="-", 
                        `type`="text", 
                        `format`="narrow", 
                        `superTitle`="Comparison"),
                    list(
                        `name`="model2", 
                        `title`="Model", 
                        `content`=".", 
                        `type`="text", 
                        `superTitle`="Comparison"),
                    list(
                        `name`="chi", 
                        `title`="\u03C7\u00B2", 
                        `type`="number"),
                    list(
                        `name`="df", 
                        `title`="df", 
                        `type`="integer"),
                    list(
                        `name`="p", 
                        `title`="p", 
                        `type`="number", 
                        `format`="zto,pvalue"))))
            self$add(jmvcore::Array$new(
                options=options,
                name="models",
                title="Model Specific Results",
                layout="listSelect",
                hideHeadingOnlyChild=TRUE,
                template=R6::R6Class(
                    inherit = jmvcore::Group,
                    active = list(
                        lrt = function() private$.items[["lrt"]],
                        coef = function() private$.items[["coef"]],
                        thres = function() private$.items[["thres"]]),
                    private = list(),
                    public=list(
                        initialize=function(options) {
                            super$initialize(
                                options=options,
                                name="undefined",
                                title="")
                            self$add(jmvcore::Table$new(
                                options=options,
                                name="lrt",
                                title="Omnibus Likelihood Ratio Tests",
                                clearWith=list(
                                    "dep",
                                    "blocks"),
                                visible="(omni)",
                                refs="car",
                                columns=list(
                                    list(
                                        `name`="term", 
                                        `title`="Predictor", 
                                        `type`="text"),
                                    list(
                                        `name`="chi", 
                                        `title`="\u03C7\u00B2", 
                                        `type`="number"),
                                    list(
                                        `name`="df", 
                                        `title`="df", 
                                        `type`="integer"),
                                    list(
                                        `name`="p", 
                                        `title`="p", 
                                        `type`="number", 
                                        `format`="zto,pvalue"))))
                            self$add(jmvcore::Table$new(
                                options=options,
                                name="coef",
                                title="`Model Coefficients - ${dep}`",
                                clearWith=list(
                                    "dep",
                                    "blocks",
                                    "refLevels"),
                                refs="MASS",
                                columns=list(
                                    list(
                                        `name`="term", 
                                        `title`="Predictor", 
                                        `type`="text"),
                                    list(
                                        `name`="est", 
                                        `title`="Estimate", 
                                        `type`="number"),
                                    list(
                                        `name`="lower", 
                                        `title`="Lower", 
                                        `type`="number", 
                                        `visible`="(ci)"),
                                    list(
                                        `name`="upper", 
                                        `title`="Upper", 
                                        `type`="number", 
                                        `visible`="(ci)"),
                                    list(
                                        `name`="se", 
                                        `title`="SE", 
                                        `type`="number"),
                                    list(
                                        `name`="z", 
                                        `title`="Z", 
                                        `type`="number"),
                                    list(
                                        `name`="p", 
                                        `title`="p", 
                                        `type`="number", 
                                        `format`="zto,pvalue"),
                                    list(
                                        `name`="odds", 
                                        `title`="Odds ratio", 
                                        `type`="number", 
                                        `visible`="(OR)"),
                                    list(
                                        `name`="oddsLower", 
                                        `title`="Lower", 
                                        `type`="number", 
                                        `visible`="(ciOR && OR)"),
                                    list(
                                        `name`="oddsUpper", 
                                        `title`="Upper", 
                                        `type`="number", 
                                        `visible`="(ciOR && OR)"))))
                            self$add(jmvcore::Table$new(
                                options=options,
                                name="thres",
                                title="Model Thresholds",
                                clearWith=list(
                                    "dep",
                                    "blocks",
                                    "refLevels"),
                                visible="(thres)",
                                columns=list(
                                    list(
                                        `name`="term", 
                                        `title`="Threshold", 
                                        `type`="text"),
                                    list(
                                        `name`="est", 
                                        `title`="Estimate", 
                                        `type`="number"),
                                    list(
                                        `name`="se", 
                                        `title`="SE", 
                                        `type`="number"),
                                    list(
                                        `name`="z", 
                                        `title`="Z", 
                                        `type`="number"),
                                    list(
                                        `name`="p", 
                                        `title`="p", 
                                        `type`="number", 
                                        `format`="zto,pvalue"),
                                    list(
                                        `name`="odds", 
                                        `title`="Odds ratio", 
                                        `type`="number", 
                                        `visible`="(OR)"))))}))$new(options=options)))}))

logRegOrdBase <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
    "logRegOrdBase",
    inherit = jmvcore::Analysis,
    public = list(
        initialize = function(options, data=NULL, datasetId="", analysisId="", revision=0) {
            super$initialize(
                package = "jmv",
                name = "logRegOrd",
                version = c(1,0,0),
                options = options,
                results = logRegOrdResults$new(options=options),
                data = data,
                datasetId = datasetId,
                analysisId = analysisId,
                revision = revision,
                pause = NULL,
                completeWhenFilled = FALSE,
                requiresMissings = FALSE,
                weightsSupport = 'integerOnly')
        }))

#' Ordinal Logistic Regression
#'
#' Ordinal Logistic Regression
#'
#' @examples
#' set.seed(1337)
#'
#' y <- factor(sample(1:3, 100, replace = TRUE))
#' x1 <- rnorm(100)
#' x2 <- rnorm(100)
#'
#' df <- data.frame(y=y, x1=x1, x2=x2)
#'
#' logRegOrd(data = df, dep = y,
#'           covs = vars(x1, x2),
#'           blocks = list(list("x1", "x2")))
#'
#' #
#' #  ORDINAL LOGISTIC REGRESSION
#' #
#' #  Model Fit Measures
#' #  ---------------------------------------
#' #    Model    Deviance    AIC    R²-McF
#' #  ---------------------------------------
#' #        1         218    226    5.68e-4
#' #  ---------------------------------------
#' #
#' #
#' #  MODEL SPECIFIC RESULTS
#' #
#' #  MODEL 1
#' #
#' #  Model Coefficients
#' #  ----------------------------------------------------
#' #    Predictor    Estimate    SE       Z        p
#' #  ----------------------------------------------------
#' #    x1             0.0579    0.193    0.300    0.764
#' #    x2             0.0330    0.172    0.192    0.848
#' #  ----------------------------------------------------
#' #
#' #
#'
#' @param data the data as a data frame
#' @param dep a string naming the dependent variable from \code{data},
#'   variable must be a factor
#' @param covs a vector of strings naming the covariates from \code{data}
#' @param factors a vector of strings naming the fixed factors from
#'   \code{data}
#' @param blocks a list containing vectors of strings that name the predictors
#'   that are added to the model. The elements are added to the model according
#'   to their order in the list
#' @param refLevels a list of lists specifying reference levels of the
#'   dependent variable and all the factors
#' @param modelTest \code{TRUE} or \code{FALSE} (default), provide the model
#'   comparison between the models and the NULL model
#' @param dev \code{TRUE} (default) or \code{FALSE}, provide the deviance (or
#'   -2LogLikelihood) for the models
#' @param aic \code{TRUE} (default) or \code{FALSE}, provide Aikaike's
#'   Information Criterion (AIC) for the models
#' @param bic \code{TRUE} or \code{FALSE} (default), provide Bayesian
#'   Information Criterion (BIC) for the models
#' @param pseudoR2 one or more of \code{'r2mf'}, \code{'r2cs'}, or
#'   \code{'r2n'}; use McFadden's, Cox & Snell, and Nagelkerke pseudo-R²,
#'   respectively
#' @param omni \code{TRUE} or \code{FALSE} (default), provide the omnibus
#'   likelihood ratio tests for the predictors
#' @param thres \code{TRUE} or \code{FALSE} (default), provide the thresholds
#'   that are used as cut-off scores for the levels of the dependent variable
#' @param ci \code{TRUE} or \code{FALSE} (default), provide a confidence
#'   interval for the model coefficient estimates
#' @param ciWidth a number between 50 and 99.9 (default: 95) specifying the
#'   confidence interval width
#' @param OR \code{TRUE} or \code{FALSE} (default), provide the exponential of
#'   the log-odds ratio estimate, or the odds ratio estimate
#' @param ciOR \code{TRUE} or \code{FALSE} (default), provide a confidence
#'   interval for the model coefficient odds ratio estimates
#' @param ciWidthOR a number between 50 and 99.9 (default: 95) specifying the
#'   confidence interval width
#' @return A results object containing:
#' \tabular{llllll}{
#'   \code{results$modelFit} \tab \tab \tab \tab \tab a table \cr
#'   \code{results$modelComp} \tab \tab \tab \tab \tab a table \cr
#'   \code{results$models} \tab \tab \tab \tab \tab an array of model specific results \cr
#' }
#'
#' Tables can be converted to data frames with \code{asDF} or \code{\link{as.data.frame}}. For example:
#'
#' \code{results$modelFit$asDF}
#'
#' \code{as.data.frame(results$modelFit)}
#'
#' @export
logRegOrd <- function(
    data,
    dep,
    covs = NULL,
    factors = NULL,
    blocks = list(
                list()),
    refLevels = NULL,
    modelTest = FALSE,
    dev = TRUE,
    aic = TRUE,
    bic = FALSE,
    pseudoR2 = list(
                "r2mf"),
    omni = FALSE,
    thres = FALSE,
    ci = FALSE,
    ciWidth = 95,
    OR = FALSE,
    ciOR = FALSE,
    ciWidthOR = 95) {

    if ( ! requireNamespace("jmvcore", quietly=TRUE))
        stop("logRegOrd requires jmvcore to be installed (restart may be required)")

    if ( ! missing(dep)) dep <- jmvcore::resolveQuo(jmvcore::enquo(dep))
    if ( ! missing(covs)) covs <- jmvcore::resolveQuo(jmvcore::enquo(covs))
    if ( ! missing(factors)) factors <- jmvcore::resolveQuo(jmvcore::enquo(factors))
    if (missing(data))
        data <- jmvcore::marshalData(
            parent.frame(),
            `if`( ! missing(dep), dep, NULL),
            `if`( ! missing(covs), covs, NULL),
            `if`( ! missing(factors), factors, NULL))

    for (v in dep) if (v %in% names(data)) data[[v]] <- as.factor(data[[v]])
    for (v in factors) if (v %in% names(data)) data[[v]] <- as.factor(data[[v]])

    options <- logRegOrdOptions$new(
        dep = dep,
        covs = covs,
        factors = factors,
        blocks = blocks,
        refLevels = refLevels,
        modelTest = modelTest,
        dev = dev,
        aic = aic,
        bic = bic,
        pseudoR2 = pseudoR2,
        omni = omni,
        thres = thres,
        ci = ci,
        ciWidth = ciWidth,
        OR = OR,
        ciOR = ciOR,
        ciWidthOR = ciWidthOR)

    analysis <- logRegOrdClass$new(
        options = options,
        data = data)

    analysis$run()

    analysis$results
}

Try the jmv package in your browser

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

jmv documentation built on Oct. 12, 2023, 5:13 p.m.