R/ttestcor.h.R

In lucasjfriesen/jamoviPsychoPDA: Psychometrics & Post-Data Analysis

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

ttestCorOptions <- if (requireNamespace('jmvcore')) R6::R6Class(
    "ttestCorOptions",
    inherit = jmvcore::Options,
    public = list(
        initialize = function(
            labelVar = NULL,
            hypTrueCor = NULL,
            observedSE = NULL,
            observedCor = NULL,
            n = NULL,
            alpha = 0.05,
            sensHyp = TRUE,
            sensN = TRUE,
            sensObs = TRUE,
            HTEViz = FALSE,
            bootSims = 10000,
            lengthOut = 1000,
            corType = NULL, ...) {

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

            private$..labelVar <- jmvcore::OptionVariable$new(
                "labelVar",
                labelVar,
                suggested=list(
                    "nominal"))
            private$..hypTrueCor <- jmvcore::OptionVariable$new(
                "hypTrueCor",
                hypTrueCor,
                suggested=list(
                    "continuous"),
                permitted=list(
                    "numeric"))
            private$..observedSE <- jmvcore::OptionVariable$new(
                "observedSE",
                observedSE,
                suggested=list(
                    "continuous"),
                permitted=list(
                    "numeric"))
            private$..observedCor <- jmvcore::OptionVariable$new(
                "observedCor",
                observedCor,
                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$..sensHyp <- jmvcore::OptionBool$new(
                "sensHyp",
                sensHyp,
                default=TRUE)
            private$..sensN <- jmvcore::OptionBool$new(
                "sensN",
                sensN,
                default=TRUE)
            private$..sensObs <- jmvcore::OptionBool$new(
                "sensObs",
                sensObs,
                default=TRUE)
            private$..HTEViz <- jmvcore::OptionBool$new(
                "HTEViz",
                HTEViz,
                default=FALSE)
            private$..bootSims <- jmvcore::OptionNumber$new(
                "bootSims",
                bootSims,
                default=10000)
            private$..lengthOut <- jmvcore::OptionNumber$new(
                "lengthOut",
                lengthOut,
                default=1000)
            private$..corType <- jmvcore::OptionList$new(
                "corType",
                corType,
                options=list(
                    "pearson",
                    "spearman"))

            self$.addOption(private$..labelVar)
            self$.addOption(private$..hypTrueCor)
            self$.addOption(private$..observedSE)
            self$.addOption(private$..observedCor)
            self$.addOption(private$..n)
            self$.addOption(private$..alpha)
            self$.addOption(private$..sensHyp)
            self$.addOption(private$..sensN)
            self$.addOption(private$..sensObs)
            self$.addOption(private$..HTEViz)
            self$.addOption(private$..bootSims)
            self$.addOption(private$..lengthOut)
            self$.addOption(private$..corType)
        }),
    active = list(
        labelVar = function() private$..labelVar$value,
        hypTrueCor = function() private$..hypTrueCor$value,
        observedSE = function() private$..observedSE$value,
        observedCor = function() private$..observedCor$value,
        n = function() private$..n$value,
        alpha = function() private$..alpha$value,
        sensHyp = function() private$..sensHyp$value,
        sensN = function() private$..sensN$value,
        sensObs = function() private$..sensObs$value,
        HTEViz = function() private$..HTEViz$value,
        bootSims = function() private$..bootSims$value,
        lengthOut = function() private$..lengthOut$value,
        corType = function() private$..corType$value),
    private = list(
        ..labelVar = NA,
        ..hypTrueCor = NA,
        ..observedSE = NA,
        ..observedCor = NA,
        ..n = NA,
        ..alpha = NA,
        ..sensHyp = NA,
        ..sensN = NA,
        ..sensObs = NA,
        ..HTEViz = NA,
        ..bootSims = NA,
        ..lengthOut = NA,
        ..corType = NA)
)

ttestCorResults <- if (requireNamespace('jmvcore')) R6::R6Class(
    inherit = jmvcore::Group,
    active = list(
        instructions = function() private$.items[["instructions"]],
        rdTTestCor = function() private$.items[["rdTTestCor"]],
        plotHTE = function() private$.items[["plotHTE"]],
        plotN = function() private$.items[["plotN"]],
        plotObs = function() private$.items[["plotObs"]],
        plotHTEViz = function() private$.items[["plotHTEViz"]]),
    private = list(),
    public=list(
        initialize=function(options) {
            super$initialize(
                options=options,
                name="",
                title="T-Test for Correlations")
            self$add(jmvcore::Html$new(
                options=options,
                name="instructions",
                title="Instructions"))
            self$add(jmvcore::Table$new(
                options=options,
                name="rdTTestCor",
                title="Retroactive Design Analysis | Correlations",
                rows=0,
                columns=list(
                    list(
                        `name`="label", 
                        `title`="Label", 
                        `type`="text"),
                    list(
                        `name`="obsCor", 
                        `title`="Obs. Correlation", 
                        `type`="number"),
                    list(
                        `name`="obsN", 
                        `title`="N", 
                        `type`="number"),
                    list(
                        `name`="hypTrueCor", 
                        `title`="Hyp. True Correlation", 
                        `type`="number"),
                    list(
                        `name`="obsSE", 
                        `title`="Obs. SE", 
                        `type`="number"),
                    list(
                        `name`="hypTrueEffSD", 
                        `title`="D", 
                        `type`="number"),
                    list(
                        `name`="typeS", 
                        `title`="Type-S", 
                        `type`="number", 
                        `format`="zto,pvalue"),
                    list(
                        `name`="typeM", 
                        `title`="Type-M", 
                        `type`="number"),
                    list(
                        `name`="power", 
                        `title`="Emp. Obs. Power", 
                        `type`="number", 
                        `format`="zto,pvalue"))))
            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="plotObs",
                title="Sensitivity - Observed Correlation",
                visible="(sensObs)",
                width=800,
                height=600,
                renderFun=".plotObs"))
            self$add(jmvcore::Array$new(
                options=options,
                name="plotHTEViz",
                title="Sensitivity - Viz",
                items=0,
                template=jmvcore::Image$new(
                    options=options,
                    width=800,
                    height=600,
                    renderFun=".plotHTEViz",
                    visible="(HTEViz)",
                    requiresData=TRUE)))}))

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

#' T-Test for Correlations
#'
#' 
#' @param data .
#' @param labelVar .
#' @param hypTrueCor .
#' @param observedSE .
#' @param observedCor .
#' @param n .
#' @param alpha .
#' @param sensHyp .
#' @param sensN .
#' @param sensObs .
#' @param HTEViz .
#' @param bootSims .
#' @param lengthOut .
#' @param corType .
#' @return A results object containing:
#' \tabular{llllll}{
#'   \code{results$instructions} \tab \tab \tab \tab \tab a html \cr
#'   \code{results$rdTTestCor} \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$plotObs} \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$rdTTestCor$asDF}
#'
#' \code{as.data.frame(results$rdTTestCor)}
#'
#' @export
ttestCor <- function(
    data,
    labelVar,
    hypTrueCor,
    observedSE,
    observedCor,
    n,
    alpha = 0.05,
    sensHyp = TRUE,
    sensN = TRUE,
    sensObs = TRUE,
    HTEViz = FALSE,
    bootSims = 10000,
    lengthOut = 1000,
    corType) {

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

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


    options <- ttestCorOptions$new(
        labelVar = labelVar,
        hypTrueCor = hypTrueCor,
        observedSE = observedSE,
        observedCor = observedCor,
        n = n,
        alpha = alpha,
        sensHyp = sensHyp,
        sensN = sensN,
        sensObs = sensObs,
        HTEViz = HTEViz,
        bootSims = bootSims,
        lengthOut = lengthOut,
        corType = corType)

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

    analysis$run()

    analysis$results
}