silkyR: The 'jamovi' Analyses

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

contTablesPairedOptions <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
    "contTablesPairedOptions",
    inherit = jmvcore::Options,
    public = list(
        initialize = function(
            rows = NULL,
            cols = NULL,
            counts = NULL,
            chiSq = TRUE,
            chiSqCorr = FALSE,
            exact = FALSE,
            pcRow = FALSE,
            pcCol = FALSE, ...) {

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

            private$..rows <- jmvcore::OptionVariable$new(
                "rows",
                rows,
                suggested=list(
                    "nominal",
                    "ordinal"),
                permitted=list(
                    "factor"))
            private$..cols <- jmvcore::OptionVariable$new(
                "cols",
                cols,
                suggested=list(
                    "nominal",
                    "ordinal"),
                permitted=list(
                    "factor"))
            private$..counts <- jmvcore::OptionVariable$new(
                "counts",
                counts,
                suggested=list(
                    "continuous"),
                permitted=list(
                    "numeric"),
                default=NULL)
            private$..chiSq <- jmvcore::OptionBool$new(
                "chiSq",
                chiSq,
                default=TRUE)
            private$..chiSqCorr <- jmvcore::OptionBool$new(
                "chiSqCorr",
                chiSqCorr,
                default=FALSE)
            private$..exact <- jmvcore::OptionBool$new(
                "exact",
                exact,
                default=FALSE)
            private$..pcRow <- jmvcore::OptionBool$new(
                "pcRow",
                pcRow,
                default=FALSE)
            private$..pcCol <- jmvcore::OptionBool$new(
                "pcCol",
                pcCol,
                default=FALSE)

            self$.addOption(private$..rows)
            self$.addOption(private$..cols)
            self$.addOption(private$..counts)
            self$.addOption(private$..chiSq)
            self$.addOption(private$..chiSqCorr)
            self$.addOption(private$..exact)
            self$.addOption(private$..pcRow)
            self$.addOption(private$..pcCol)
        }),
    active = list(
        rows = function() private$..rows$value,
        cols = function() private$..cols$value,
        counts = function() private$..counts$value,
        chiSq = function() private$..chiSq$value,
        chiSqCorr = function() private$..chiSqCorr$value,
        exact = function() private$..exact$value,
        pcRow = function() private$..pcRow$value,
        pcCol = function() private$..pcCol$value),
    private = list(
        ..rows = NA,
        ..cols = NA,
        ..counts = NA,
        ..chiSq = NA,
        ..chiSqCorr = NA,
        ..exact = NA,
        ..pcRow = NA,
        ..pcCol = NA)
)

contTablesPairedResults <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
    "contTablesPairedResults",
    inherit = jmvcore::Group,
    active = list(
        freqs = function() private$.items[["freqs"]],
        test = function() private$.items[["test"]]),
    private = list(),
    public=list(
        initialize=function(options) {
            super$initialize(
                options=options,
                name="",
                title="Paired Samples Contingency Tables")
            self$add(jmvcore::Table$new(
                options=options,
                name="freqs",
                title="Contingency Tables",
                columns=list(),
                clearWith=list(
                    "rows",
                    "cols",
                    "counts")))
            self$add(jmvcore::Table$new(
                options=options,
                name="test",
                title="McNemar Test",
                clearWith=list(
                    "rows",
                    "cols",
                    "counts"),
                columns=list(
                    list(
                        `name`="name[mcn]", 
                        `title`="", 
                        `type`="text", 
                        `content`="\u03C7\u00B2", 
                        `visible`="(chiSq)"),
                    list(
                        `name`="value[mcn]", 
                        `title`="Value", 
                        `visible`="(chiSq)"),
                    list(
                        `name`="df[mcn]", 
                        `title`="df", 
                        `type`="integer", 
                        `visible`="(chiSq)"),
                    list(
                        `name`="p[mcn]", 
                        `title`="p", 
                        `type`="number", 
                        `format`="zto,pvalue", 
                        `visible`="(chiSq)"),
                    list(
                        `name`="name[cor]", 
                        `title`="", 
                        `type`="text", 
                        `content`="\u03C7\u00B2 continuity correction", 
                        `visible`="(chiSqCorr)"),
                    list(
                        `name`="value[cor]", 
                        `title`="Value", 
                        `visible`="(chiSqCorr)"),
                    list(
                        `name`="df[cor]", 
                        `title`="df", 
                        `type`="integer", 
                        `visible`="(chiSqCorr)"),
                    list(
                        `name`="p[cor]", 
                        `title`="p", 
                        `type`="number", 
                        `format`="zto,pvalue", 
                        `visible`="(chiSqCorr)"),
                    list(
                        `name`="name[exa]", 
                        `title`="", 
                        `type`="text", 
                        `content`="Log odds ratio exact", 
                        `visible`="(exact)", 
                        `refs`="exact2x2"),
                    list(
                        `name`="value[exa]", 
                        `title`="Value", 
                        `visible`="(exact)"),
                    list(
                        `name`="df[exa]", 
                        `title`="df", 
                        `type`="integer", 
                        `visible`="(exact)"),
                    list(
                        `name`="p[exa]", 
                        `title`="p", 
                        `type`="number", 
                        `format`="zto,pvalue", 
                        `visible`="(exact)"),
                    list(
                        `name`="name[n]", 
                        `title`="", 
                        `type`="text", 
                        `content`="N"),
                    list(
                        `name`="value[n]", 
                        `title`="Value"),
                    list(
                        `name`="df[n]", 
                        `title`="df", 
                        `content`=""),
                    list(
                        `name`="p[n]", 
                        `title`="p", 
                        `content`=""))))}))

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

#' Paired Samples Contingency Tables
#'
#' McNemar test
#'
#' @examples
#' dat <- data.frame(
#'     `1st survey` = c('Approve', 'Approve', 'Disapprove', 'Disapprove'),
#'     `2nd survey` = c('Approve', 'Disapprove', 'Approve', 'Disapprove'),
#'     `Counts` = c(794, 150, 86, 570),
#'     check.names=FALSE)
#'
#' contTablesPaired(formula = Counts ~ `1st survey`:`2nd survey`, data = dat)
#'
#' #
#' #  PAIRED SAMPLES CONTINGENCY TABLES
#' #
#' #  Contingency Tables
#' #  ------------------------------------------------
#' #    1st survey    Approve    Disapprove    Total
#' #  ------------------------------------------------
#' #    Approve           794           150      944
#' #    Disapprove         86           570      656
#' #    Total             880           720     1600
#' #  ------------------------------------------------
#' #
#' #
#' #  McNemar Test
#' #  -----------------------------------------------------
#' #                                Value    df    p
#' #  -----------------------------------------------------
#' #    X²                           17.4     1    < .001
#' #    X² continuity correction     16.8     1    < .001
#' #  -----------------------------------------------------
#' #
#'
#'
#' # Alternatively, omit the left of the formula (`Counts`) from the
#' # formula if each row represents a single observation:
#'
#' contTablesPaired(formula = ~ `1st survey`:`2nd survey`, data = dat)
#'
#' @param data the data as a data frame
#' @param rows the variable to use as the rows in the contingency table (not
#'   necessary when providing a formula, see the examples)
#' @param cols the variable to use as the columns in the contingency table
#'   (not necessary when providing a formula, see the examples)
#' @param counts the variable to use as the counts in the contingency table
#'   (not necessary when providing a formula, see the examples)
#' @param chiSq \code{TRUE} (default) or \code{FALSE}, provide X²
#' @param chiSqCorr \code{TRUE} or \code{FALSE} (default), provide X² with
#'   continuity correction
#' @param exact \code{TRUE} or \code{FALSE} (default), provide an exact log
#'   odds ratio (requires exact2x2 to be installed)
#' @param pcRow \code{TRUE} or \code{FALSE} (default), provide row percentages
#' @param pcCol \code{TRUE} or \code{FALSE} (default), provide column
#'   percentages
#' @param formula (optional) the formula to use, see the examples
#' @return A results object containing:
#' \tabular{llllll}{
#'   \code{results$freqs} \tab \tab \tab \tab \tab a proportions table \cr
#'   \code{results$test} \tab \tab \tab \tab \tab a table of test results \cr
#' }
#'
#' Tables can be converted to data frames with \code{asDF} or \code{\link{as.data.frame}}. For example:
#'
#' \code{results$freqs$asDF}
#'
#' \code{as.data.frame(results$freqs)}
#'
#' @export
contTablesPaired <- function(
    data,
    rows,
    cols,
    counts = NULL,
    chiSq = TRUE,
    chiSqCorr = FALSE,
    exact = FALSE,
    pcRow = FALSE,
    pcCol = FALSE,
    formula) {

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

    if ( ! missing(formula)) {
        if (missing(counts))
            counts <- jmvcore::marshalFormula(
                formula=formula,
                data=`if`( ! missing(data), data, NULL),
                from="lhs",
                type="vars",
                subset="1")
        if (missing(rows))
            rows <- jmvcore::marshalFormula(
                formula=formula,
                data=`if`( ! missing(data), data, NULL),
                from="rhs",
                type="vars",
                subset="1")
        if (missing(cols))
            cols <- jmvcore::marshalFormula(
                formula=formula,
                data=`if`( ! missing(data), data, NULL),
                from="rhs",
                type="vars",
                subset="2")
    }

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

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

    options <- contTablesPairedOptions$new(
        rows = rows,
        cols = cols,
        counts = counts,
        chiSq = chiSq,
        chiSqCorr = chiSqCorr,
        exact = exact,
        pcRow = pcRow,
        pcCol = pcCol)

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

    analysis$run()

    analysis$results
}