R/logregmulti.h.R

Defines functions logRegMulti

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

logRegMultiOptions <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
    "logRegMultiOptions",
    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,
            ci = FALSE,
            ciWidth = 95,
            OR = FALSE,
            ciOR = FALSE,
            ciWidthOR = 95,
            emMeans = list(
                list()),
            ciEmm = TRUE,
            ciWidthEmm = 95,
            emmPlots = TRUE,
            emmTables = FALSE,
            emmWeights = TRUE, ...) {

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

            private$..dep <- jmvcore::OptionVariable$new(
                "dep",
                dep,
                suggested=list(
                    "nominal"),
                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,
                rejectUnusedLevels=TRUE,
                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$..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)
            private$..emMeans <- jmvcore::OptionArray$new(
                "emMeans",
                emMeans,
                default=list(
                    list()),
                template=jmvcore::OptionVariables$new(
                    "emMeans",
                    NULL))
            private$..ciEmm <- jmvcore::OptionBool$new(
                "ciEmm",
                ciEmm,
                default=TRUE)
            private$..ciWidthEmm <- jmvcore::OptionNumber$new(
                "ciWidthEmm",
                ciWidthEmm,
                min=50,
                max=99.9,
                default=95)
            private$..emmPlots <- jmvcore::OptionBool$new(
                "emmPlots",
                emmPlots,
                default=TRUE)
            private$..emmTables <- jmvcore::OptionBool$new(
                "emmTables",
                emmTables,
                default=FALSE)
            private$..emmWeights <- jmvcore::OptionBool$new(
                "emmWeights",
                emmWeights,
                default=TRUE)

            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$..ci)
            self$.addOption(private$..ciWidth)
            self$.addOption(private$..OR)
            self$.addOption(private$..ciOR)
            self$.addOption(private$..ciWidthOR)
            self$.addOption(private$..emMeans)
            self$.addOption(private$..ciEmm)
            self$.addOption(private$..ciWidthEmm)
            self$.addOption(private$..emmPlots)
            self$.addOption(private$..emmTables)
            self$.addOption(private$..emmWeights)
        }),
    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,
        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,
        emMeans = function() private$..emMeans$value,
        ciEmm = function() private$..ciEmm$value,
        ciWidthEmm = function() private$..ciWidthEmm$value,
        emmPlots = function() private$..emmPlots$value,
        emmTables = function() private$..emmTables$value,
        emmWeights = function() private$..emmWeights$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,
        ..ci = NA,
        ..ciWidth = NA,
        ..OR = NA,
        ..ciOR = NA,
        ..ciWidthOR = NA,
        ..emMeans = NA,
        ..ciEmm = NA,
        ..ciWidthEmm = NA,
        ..emmPlots = NA,
        ..emmTables = NA,
        ..emmWeights = NA)
)

logRegMultiResults <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
    "logRegMultiResults",
    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="Multinomial 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"]],
                        emm = function() private$.items[["emm"]]),
                    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="nnet",
                                columns=list(
                                    list(
                                        `name`="dep", 
                                        `title`="", 
                                        `type`="text", 
                                        `combineBelow`=TRUE),
                                    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::Array$new(
                                options=options,
                                name="emm",
                                title="Estimated Marginal Means",
                                refs="emmeans",
                                clearWith=list(
                                    "dep",
                                    "blocks",
                                    "emMeans"),
                                template=R6::R6Class(
                                    inherit = jmvcore::Group,
                                    active = list(
                                        emmPlot = function() private$.items[["emmPlot"]],
                                        emmTable = function() private$.items[["emmTable"]]),
                                    private = list(),
                                    public=list(
                                        initialize=function(options) {
                                            super$initialize(
                                                options=options,
                                                name="undefined",
                                                title="")
                                            self$add(jmvcore::Image$new(
                                                options=options,
                                                name="emmPlot",
                                                title="",
                                                width=450,
                                                height=400,
                                                renderFun=".emmPlot",
                                                visible="(emmPlots)",
                                                clearWith=list(
                                                    "dep",
                                                    "blocks",
                                                    "refLevels",
                                                    "ciEmm",
                                                    "ciWidthEmm",
                                                    "emmWeights")))
                                            self$add(jmvcore::Table$new(
                                                options=options,
                                                name="emmTable",
                                                title="",
                                                visible="(emmTables)",
                                                columns=list(),
                                                clearWith=list(
                                                    "dep",
                                                    "blocks",
                                                    "refLevels",
                                                    "ciWidthEmm",
                                                    "emmWeights")))}))$new(options=options)))}))$new(options=options)))}))

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

#' Multinomial Logistic Regression
#'
#' Multinomial Logistic Regression
#'
#' @examples
#' data('birthwt', package='MASS')
#'
#' dat <- data.frame(
#'             race = factor(birthwt$race),
#'             age = birthwt$age,
#'             low = factor(birthwt$low))
#'
#' logRegMulti(data = dat, dep = race,
#'             covs = age, factors = low,
#'             blocks = list(list("age", "low")),
#'             refLevels = list(
#'                 list(var="race", ref="1"),
#'                 list(var="low", ref="0")))
#'
#' #
#' #  MULTINOMIAL LOGISTIC REGRESSION
#' #
#' #  Model Fit Measures
#' #  --------------------------------------
#' #    Model    Deviance    AIC    R²-McF
#' #  --------------------------------------
#' #        1         360    372    0.0333
#' #  --------------------------------------
#' #
#' #
#' #  MODEL SPECIFIC RESULTS
#' #
#' #  MODEL 1
#' #
#' #  Model Coefficients
#' #  ---------------------------------------------------------------
#' #    race     Predictor    Estimate    SE        Z         p
#' #  ---------------------------------------------------------------
#' #    2 - 1    Intercept      0.8155    1.1186     0.729    0.466
#' #             age           -0.1038    0.0487    -2.131    0.033
#' #             low:
#' #             1 – 0          0.7527    0.4700     1.601    0.109
#' #    3 - 1    Intercept      1.0123    0.7798     1.298    0.194
#' #             age           -0.0663    0.0324    -2.047    0.041
#' #             low:
#' #             1 – 0          0.5677    0.3522     1.612    0.107
#' #  ---------------------------------------------------------------
#' #
#' #
#'
#' @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 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
#' @param emMeans a list of lists specifying the variables for which the
#'   estimated marginal means need to be calculate. Supports up to three
#'   variables per term.
#' @param ciEmm \code{TRUE} (default) or \code{FALSE}, provide a confidence
#'   interval for the estimated marginal means
#' @param ciWidthEmm a number between 50 and 99.9 (default: 95) specifying the
#'   confidence interval width for the estimated marginal means
#' @param emmPlots \code{TRUE} (default) or \code{FALSE}, provide estimated
#'   marginal means plots
#' @param emmTables \code{TRUE} or \code{FALSE} (default), provide estimated
#'   marginal means tables
#' @param emmWeights \code{TRUE} (default) or \code{FALSE}, weigh each cell
#'   equally or weigh them according to the cell frequency
#' @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
logRegMulti <- 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,
    ci = FALSE,
    ciWidth = 95,
    OR = FALSE,
    ciOR = FALSE,
    ciWidthOR = 95,
    emMeans = list(
                list()),
    ciEmm = TRUE,
    ciWidthEmm = 95,
    emmPlots = TRUE,
    emmTables = FALSE,
    emmWeights = TRUE) {

    if ( ! requireNamespace("jmvcore", quietly=TRUE))
        stop("logRegMulti 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]])
    if (inherits(emMeans, "formula")) emMeans <- jmvcore::decomposeFormula(emMeans)

    options <- logRegMultiOptions$new(
        dep = dep,
        covs = covs,
        factors = factors,
        blocks = blocks,
        refLevels = refLevels,
        modelTest = modelTest,
        dev = dev,
        aic = aic,
        bic = bic,
        pseudoR2 = pseudoR2,
        omni = omni,
        ci = ci,
        ciWidth = ciWidth,
        OR = OR,
        ciOR = ciOR,
        ciWidthOR = ciWidthOR,
        emMeans = emMeans,
        ciEmm = ciEmm,
        ciWidthEmm = ciWidthEmm,
        emmPlots = emmPlots,
        emmTables = emmTables,
        emmWeights = emmWeights)

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

    analysis$run()

    analysis$results
}
jamovi/Rjamovi documentation built on March 19, 2024, 6:36 a.m.