R/rdttest.h.R

In lucasjfriesen/jamoviPsychoPDA: Psychometrics & Post-Data Analysis

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

rdTTestOptions <- if (requireNamespace('jmvcore')) R6::R6Class(
    "rdTTestOptions",
    inherit = jmvcore::Options,
    public = list(
        initialize = function(
            labelVar = NULL,
            hypTrueEff = NULL,
            observedSE = NULL,
            observedP = NULL,
            n = NULL,
            alpha = 0.05,
            nSims = 10000,
            sensHyp = TRUE,
            sensN = TRUE,
            sensSE = TRUE,
            HTEViz = FALSE, ...) {

            super$initialize(
                package='psychoPDA',
                name='rdTTest',
                requiresData=TRUE,
                ...)

            private$..labelVar <- jmvcore::OptionVariable$new(
                "labelVar",
                labelVar)
            private$..hypTrueEff <- jmvcore::OptionVariable$new(
                "hypTrueEff",
                hypTrueEff,
                suggested=list(
                    "continuous"),
                permitted=list(
                    "numeric"))
            private$..observedSE <- jmvcore::OptionVariable$new(
                "observedSE",
                observedSE,
                suggested=list(
                    "continuous"),
                permitted=list(
                    "numeric"))
            private$..observedP <- jmvcore::OptionVariable$new(
                "observedP",
                observedP,
                suggested=list(
                    "continuous"),
                permitted=list(
                    "numeric"))
            private$..n <- jmvcore::OptionVariable$new(
                "n",
                n,
                suggested=list(
                    "continuous"),
                permitted=list(
                    "numeric"))
            private$..alpha <- jmvcore::OptionNumber$new(
                "alpha",
                alpha,
                default=0.05)
            private$..nSims <- jmvcore::OptionNumber$new(
                "nSims",
                nSims,
                default=10000)
            private$..sensHyp <- jmvcore::OptionBool$new(
                "sensHyp",
                sensHyp,
                default=TRUE)
            private$..sensN <- jmvcore::OptionBool$new(
                "sensN",
                sensN,
                default=TRUE)
            private$..sensSE <- jmvcore::OptionBool$new(
                "sensSE",
                sensSE,
                default=TRUE)
            private$..HTEViz <- jmvcore::OptionBool$new(
                "HTEViz",
                HTEViz,
                default=FALSE)

            self$.addOption(private$..labelVar)
            self$.addOption(private$..hypTrueEff)
            self$.addOption(private$..observedSE)
            self$.addOption(private$..observedP)
            self$.addOption(private$..n)
            self$.addOption(private$..alpha)
            self$.addOption(private$..nSims)
            self$.addOption(private$..sensHyp)
            self$.addOption(private$..sensN)
            self$.addOption(private$..sensSE)
            self$.addOption(private$..HTEViz)
        }),
    active = list(
        labelVar = function() private$..labelVar$value,
        hypTrueEff = function() private$..hypTrueEff$value,
        observedSE = function() private$..observedSE$value,
        observedP = function() private$..observedP$value,
        n = function() private$..n$value,
        alpha = function() private$..alpha$value,
        nSims = function() private$..nSims$value,
        sensHyp = function() private$..sensHyp$value,
        sensN = function() private$..sensN$value,
        sensSE = function() private$..sensSE$value,
        HTEViz = function() private$..HTEViz$value),
    private = list(
        ..labelVar = NA,
        ..hypTrueEff = NA,
        ..observedSE = NA,
        ..observedP = NA,
        ..n = NA,
        ..alpha = NA,
        ..nSims = NA,
        ..sensHyp = NA,
        ..sensN = NA,
        ..sensSE = NA,
        ..HTEViz = NA)
)

rdTTestResults <- if (requireNamespace('jmvcore')) R6::R6Class(
    inherit = jmvcore::Group,
    active = list(
        instructions = function() private$.items[["instructions"]],
        rdTTest = function() private$.items[["rdTTest"]],
        plotHTE = function() private$.items[["plotHTE"]],
        plotN = function() private$.items[["plotN"]],
        plotSE = function() private$.items[["plotSE"]],
        plotHTEViz = function() private$.items[["plotHTEViz"]]),
    private = list(),
    public=list(
        initialize=function(options) {
            super$initialize(
                options=options,
                name="",
                title="T-Test")
            self$add(jmvcore::Html$new(
                options=options,
                name="instructions",
                title="Instructions"))
            self$add(jmvcore::Table$new(
                options=options,
                name="rdTTest",
                title="Retroactive Design Analysis | Mean Differences",
                rows=0,
                columns=list(
                    list(
                        `name`="label", 
                        `title`="Label", 
                        `type`="number"),
                    list(
                        `name`="D", 
                        `title`="Hyp. True Difference", 
                        `type`="text"),
                    list(
                        `name`="typeS", 
                        `title`="Type-S", 
                        `type`="number"),
                    list(
                        `name`="typeM", 
                        `title`="Type-M", 
                        `type`="number"),
                    list(
                        `name`="power", 
                        `title`="Observed Power", 
                        `type`="number"))))
            self$add(jmvcore::Image$new(
                options=options,
                name="plotHTE",
                title="Sensitivity - Hypothesized True Effect",
                visible="(sensHyp)",
                width=800,
                height=600,
                renderFun=".plotHTE"))
            self$add(jmvcore::Image$new(
                options=options,
                name="plotN",
                title="Sensitivity - Sample Size",
                visible="(sensN)",
                width=800,
                height=600,
                renderFun=".plotN"))
            self$add(jmvcore::Image$new(
                options=options,
                name="plotSE",
                title="Sensitivity - Standard Error",
                visible="(sensSE)",
                width=800,
                height=600,
                renderFun=".plotSE"))
            self$add(jmvcore::Array$new(
                options=options,
                name="plotHTEViz",
                title="Sensitivity - Viz",
                items="(hypTrueEff)",
                template=jmvcore::Image$new(
                    options=options,
                    width=800,
                    height=600,
                    renderFun=".plotHTEViz",
                    visible="(HTEViz)",
                    requiresData=TRUE)))}))

rdTTestBase <- if (requireNamespace('jmvcore')) R6::R6Class(
    "rdTTestBase",
    inherit = jmvcore::Analysis,
    public = list(
        initialize = function(options, data=NULL, datasetId="", analysisId="", revision=0) {
            super$initialize(
                package = 'psychoPDA',
                name = 'rdTTest',
                version = c(1,0,0),
                options = options,
                results = rdTTestResults$new(options=options),
                data = data,
                datasetId = datasetId,
                analysisId = analysisId,
                revision = revision,
                pause = NULL,
                completeWhenFilled = FALSE,
                requiresMissings = FALSE)
        }))

#' T-Test for Mean Differences
#'
#' 
#' @param data .
#' @param labelVar .
#' @param hypTrueEff .
#' @param observedSE .
#' @param observedP .
#' @param n .
#' @param alpha .
#' @param nSims .
#' @param sensHyp .
#' @param sensN .
#' @param sensSE .
#' @param HTEViz .
#' @return A results object containing:
#' \tabular{llllll}{
#'   \code{results$instructions} \tab \tab \tab \tab \tab a html \cr
#'   \code{results$rdTTest} \tab \tab \tab \tab \tab a table \cr
#'   \code{results$plotHTE} \tab \tab \tab \tab \tab an image \cr
#'   \code{results$plotN} \tab \tab \tab \tab \tab an image \cr
#'   \code{results$plotSE} \tab \tab \tab \tab \tab an image \cr
#'   \code{results$plotHTEViz} \tab \tab \tab \tab \tab an array of images \cr
#' }
#'
#' Tables can be converted to data frames with \code{asDF} or \code{\link{as.data.frame}}. For example:
#'
#' \code{results$rdTTest$asDF}
#'
#' \code{as.data.frame(results$rdTTest)}
#'
#' @export
rdTTest <- function(
    data,
    labelVar,
    hypTrueEff,
    observedSE,
    observedP,
    n,
    alpha = 0.05,
    nSims = 10000,
    sensHyp = TRUE,
    sensN = TRUE,
    sensSE = TRUE,
    HTEViz = FALSE) {

    if ( ! requireNamespace('jmvcore'))
        stop('rdTTest requires jmvcore to be installed (restart may be required)')

    if ( ! missing(labelVar)) labelVar <- jmvcore::resolveQuo(jmvcore::enquo(labelVar))
    if ( ! missing(hypTrueEff)) hypTrueEff <- jmvcore::resolveQuo(jmvcore::enquo(hypTrueEff))
    if ( ! missing(observedSE)) observedSE <- jmvcore::resolveQuo(jmvcore::enquo(observedSE))
    if ( ! missing(observedP)) observedP <- jmvcore::resolveQuo(jmvcore::enquo(observedP))
    if ( ! missing(n)) n <- jmvcore::resolveQuo(jmvcore::enquo(n))
    if (missing(data))
        data <- jmvcore::marshalData(
            parent.frame(),
            `if`( ! missing(labelVar), labelVar, NULL),
            `if`( ! missing(hypTrueEff), hypTrueEff, NULL),
            `if`( ! missing(observedSE), observedSE, NULL),
            `if`( ! missing(observedP), observedP, NULL),
            `if`( ! missing(n), n, NULL))


    options <- rdTTestOptions$new(
        labelVar = labelVar,
        hypTrueEff = hypTrueEff,
        observedSE = observedSE,
        observedP = observedP,
        n = n,
        alpha = alpha,
        nSims = nSims,
        sensHyp = sensHyp,
        sensN = sensN,
        sensSE = sensSE,
        HTEViz = HTEViz)

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

    analysis$run()

    analysis$results
}