R/proptest2.h.R

Defines functions propTest2

Documented in propTest2

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

propTest2Options <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
    "propTest2Options",
    inherit = jmvcore::Options,
    public = list(
        initialize = function(
            vars = NULL,
            areCounts = FALSE,
            testValue = 0.5,
            hypothesis = "notequal",
            ci = FALSE,
            ciWidth = 95,
            bf = FALSE,
            priorA = 1,
            priorB = 1,
            ciBayes = FALSE,
            ciBayesWidth = 95,
            postPlots = FALSE, ...) {

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

            private$..vars <- jmvcore::OptionVariables$new(
                "vars",
                vars,
                suggested=list(
                    "nominal",
                    "ordinal"),
                permitted=list(
                    "factor"))
            private$..areCounts <- jmvcore::OptionBool$new(
                "areCounts",
                areCounts,
                default=FALSE)
            private$..testValue <- jmvcore::OptionNumber$new(
                "testValue",
                testValue,
                default=0.5)
            private$..hypothesis <- jmvcore::OptionList$new(
                "hypothesis",
                hypothesis,
                options=list(
                    "notequal",
                    "greater",
                    "less"),
                default="notequal")
            private$..ci <- jmvcore::OptionBool$new(
                "ci",
                ci,
                default=FALSE)
            private$..ciWidth <- jmvcore::OptionNumber$new(
                "ciWidth",
                ciWidth,
                min=50,
                max=99.9,
                default=95)
            private$..bf <- jmvcore::OptionBool$new(
                "bf",
                bf,
                default=FALSE)
            private$..priorA <- jmvcore::OptionNumber$new(
                "priorA",
                priorA,
                min=0.01,
                default=1)
            private$..priorB <- jmvcore::OptionNumber$new(
                "priorB",
                priorB,
                min=0.01,
                default=1)
            private$..ciBayes <- jmvcore::OptionBool$new(
                "ciBayes",
                ciBayes,
                default=FALSE)
            private$..ciBayesWidth <- jmvcore::OptionNumber$new(
                "ciBayesWidth",
                ciBayesWidth,
                min=50,
                max=99.9,
                default=95)
            private$..postPlots <- jmvcore::OptionBool$new(
                "postPlots",
                postPlots,
                default=FALSE)

            self$.addOption(private$..vars)
            self$.addOption(private$..areCounts)
            self$.addOption(private$..testValue)
            self$.addOption(private$..hypothesis)
            self$.addOption(private$..ci)
            self$.addOption(private$..ciWidth)
            self$.addOption(private$..bf)
            self$.addOption(private$..priorA)
            self$.addOption(private$..priorB)
            self$.addOption(private$..ciBayes)
            self$.addOption(private$..ciBayesWidth)
            self$.addOption(private$..postPlots)
        }),
    active = list(
        vars = function() private$..vars$value,
        areCounts = function() private$..areCounts$value,
        testValue = function() private$..testValue$value,
        hypothesis = function() private$..hypothesis$value,
        ci = function() private$..ci$value,
        ciWidth = function() private$..ciWidth$value,
        bf = function() private$..bf$value,
        priorA = function() private$..priorA$value,
        priorB = function() private$..priorB$value,
        ciBayes = function() private$..ciBayes$value,
        ciBayesWidth = function() private$..ciBayesWidth$value,
        postPlots = function() private$..postPlots$value),
    private = list(
        ..vars = NA,
        ..areCounts = NA,
        ..testValue = NA,
        ..hypothesis = NA,
        ..ci = NA,
        ..ciWidth = NA,
        ..bf = NA,
        ..priorA = NA,
        ..priorB = NA,
        ..ciBayes = NA,
        ..ciBayesWidth = NA,
        ..postPlots = NA)
)

propTest2Results <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
    "propTest2Results",
    inherit = jmvcore::Group,
    active = list(
        table = function() private$.items[["table"]],
        postPlots = function() private$.items[["postPlots"]]),
    private = list(),
    public=list(
        initialize=function(options) {
            super$initialize(
                options=options,
                name="",
                title="Proportion Test (2 Outcomes)")
            self$add(jmvcore::Table$new(
                options=options,
                name="table",
                title="Binomial Test",
                clearWith=list(
                    "vars",
                    "areCounts",
                    "testValue",
                    "hypothesis",
                    "ciWidth",
                    "bf",
                    "ciBayes",
                    "ciBayesWidth",
                    "priorA",
                    "priorB",
                    "ci"),
                columns=list(
                    list(
                        `name`="var", 
                        `title`="", 
                        `type`="text", 
                        `combineBelow`=TRUE),
                    list(
                        `name`="level", 
                        `title`="Level", 
                        `type`="text"),
                    list(
                        `name`="count", 
                        `title`="Count", 
                        `type`="integer"),
                    list(
                        `name`="total", 
                        `title`="Total", 
                        `type`="integer"),
                    list(
                        `name`="prop", 
                        `title`="Proportion", 
                        `type`="number", 
                        `format`="zto"),
                    list(
                        `name`="p", 
                        `title`="p", 
                        `type`="number", 
                        `format`="zto,pvalue"),
                    list(
                        `name`="cil", 
                        `title`="Lower", 
                        `superTitle`="Confidence Interval", 
                        `type`="number", 
                        `visible`="(ci)"),
                    list(
                        `name`="ciu", 
                        `title`="Upper", 
                        `superTitle`="Confidence Interval", 
                        `type`="number", 
                        `visible`="(ci)"),
                    list(
                        `name`="bf", 
                        `title`="Bayes factor\u2081\u2080", 
                        `type`="number", 
                        `visible`="(bf)"),
                    list(
                        `name`="cilBayes", 
                        `title`="Lower", 
                        `superTitle`="Credible Interval", 
                        `type`="number", 
                        `visible`="(ciBayes)"),
                    list(
                        `name`="ciuBayes", 
                        `title`="Upper", 
                        `superTitle`="Credible Interval", 
                        `type`="number", 
                        `visible`="(ciBayes)"))))
            self$add(jmvcore::Array$new(
                options=options,
                name="postPlots",
                title="Posterior Plots",
                visible="(postPlots)",
                items="(vars)",
                template=jmvcore::Array$new(
                    options=options,
                    title="($key)",
                    template=jmvcore::Image$new(
                        options=options,
                        title="($key)",
                        renderFun=".postPlot",
                        width=400,
                        height=350,
                        clearWith=list(
                            "priorA",
                            "priorB",
                            "testValue",
                            "hypothesis")))))}))

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

#' Proportion Test (2 Outcomes)
#'
#' The Binomial test is used to test the Null hypothesis that the proportion 
#' of observations match some expected value. If the p-value is low, this 
#' suggests that the Null hypothesis is false, and that the true proportion 
#' must be some other value.
#' 
#'
#' @examples
#' \donttest{
#' dat <- data.frame(x=c(8, 15))
#'
#' propTest2(dat, vars = x, areCounts = TRUE)
#'
#' #
#' #  PROPORTION TEST (2 OUTCOMES)
#' #
#' #  Binomial Test
#' #  -------------------------------------------------------
#' #         Level    Count    Total    Proportion    p
#' #  -------------------------------------------------------
#' #    x    1            8       23         0.348    0.210
#' #         2           15       23         0.652    0.210
#' #  -------------------------------------------------------
#' #    Note. Ha is proportion != 0.5
#' #
#'}
#' @param data the data as a data frame
#' @param vars a vector of strings naming the variables of interest in
#'   \code{data}
#' @param areCounts \code{TRUE} or \code{FALSE} (default), the variables are
#'   counts
#' @param testValue a number (default: 0.5), the value for the null hypothesis
#' @param hypothesis \code{'notequal'} (default), \code{'greater'} or
#'   \code{'less'}, the alternative hypothesis
#' @param ci \code{TRUE} or \code{FALSE} (default), provide confidence
#'   intervals
#' @param ciWidth a number between 50 and 99.9 (default: 95), the confidence
#'   interval width
#' @param bf \code{TRUE} or \code{FALSE} (default), provide Bayes factors
#' @param priorA a number (default: 1), the beta prior 'a' parameter
#' @param priorB a number (default: 1), the beta prior 'b' parameter
#' @param ciBayes \code{TRUE} or \code{FALSE} (default), provide Bayesian
#'   credible intervals
#' @param ciBayesWidth a number between 50 and 99.9 (default: 95), the
#'   credible interval width
#' @param postPlots \code{TRUE} or \code{FALSE} (default), provide posterior
#'   plots
#' @return A results object containing:
#' \tabular{llllll}{
#'   \code{results$table} \tab \tab \tab \tab \tab a table of the proportions and test results \cr
#'   \code{results$postPlots} \tab \tab \tab \tab \tab an array of the posterior plots \cr
#' }
#'
#' Tables can be converted to data frames with \code{asDF} or \code{\link{as.data.frame}}. For example:
#'
#' \code{results$table$asDF}
#'
#' \code{as.data.frame(results$table)}
#'
#' @export
propTest2 <- function(
    data,
    vars,
    areCounts = FALSE,
    testValue = 0.5,
    hypothesis = "notequal",
    ci = FALSE,
    ciWidth = 95,
    bf = FALSE,
    priorA = 1,
    priorB = 1,
    ciBayes = FALSE,
    ciBayesWidth = 95,
    postPlots = FALSE) {

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

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

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

    options <- propTest2Options$new(
        vars = vars,
        areCounts = areCounts,
        testValue = testValue,
        hypothesis = hypothesis,
        ci = ci,
        ciWidth = ciWidth,
        bf = bf,
        priorA = priorA,
        priorB = priorB,
        ciBayes = ciBayes,
        ciBayesWidth = ciBayesWidth,
        postPlots = postPlots)

    analysis <- propTest2Class$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.