R/jmvagreemulti.h.R

In SimplyAgree: Flexible and Robust Agreement and Reliability Analyses

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

jmvagreemultiOptions <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
    "jmvagreemultiOptions",
    inherit = jmvcore::Options,
    public = list(
        initialize = function(
            method1 = NULL,
            method2 = NULL,
            id = NULL,
            ciWidth = 95,
            agreeWidth = 95,
            testValue = 2,
            CCC = TRUE,
            valEq = FALSE,
            plotbland = FALSE,
            plotcon = FALSE,
            prop_bias = FALSE,
            xlabel = "Average of Both Methods",
            ylabel = "Difference between Methods", ...) {

            super$initialize(
                package="SimplyAgree",
                name="jmvagreemulti",
                requiresData=TRUE,
                ...)

            private$..method1 <- jmvcore::OptionVariable$new(
                "method1",
                method1,
                suggested=list(
                    "continuous"),
                permitted=list(
                    "numeric"),
                rejectInf=FALSE)
            private$..method2 <- jmvcore::OptionVariable$new(
                "method2",
                method2,
                suggested=list(
                    "continuous"),
                permitted=list(
                    "numeric"),
                rejectInf=FALSE)
            private$..id <- jmvcore::OptionVariable$new(
                "id",
                id)
            private$..ciWidth <- jmvcore::OptionNumber$new(
                "ciWidth",
                ciWidth,
                min=50,
                max=99.9,
                default=95)
            private$..agreeWidth <- jmvcore::OptionNumber$new(
                "agreeWidth",
                agreeWidth,
                min=50,
                max=99.9,
                default=95)
            private$..testValue <- jmvcore::OptionNumber$new(
                "testValue",
                testValue,
                default=2)
            private$..CCC <- jmvcore::OptionBool$new(
                "CCC",
                CCC,
                default=TRUE)
            private$..valEq <- jmvcore::OptionBool$new(
                "valEq",
                valEq,
                default=FALSE)
            private$..plotbland <- jmvcore::OptionBool$new(
                "plotbland",
                plotbland,
                default=FALSE)
            private$..plotcon <- jmvcore::OptionBool$new(
                "plotcon",
                plotcon,
                default=FALSE)
            private$..prop_bias <- jmvcore::OptionBool$new(
                "prop_bias",
                prop_bias,
                default=FALSE)
            private$..xlabel <- jmvcore::OptionString$new(
                "xlabel",
                xlabel,
                default="Average of Both Methods")
            private$..ylabel <- jmvcore::OptionString$new(
                "ylabel",
                ylabel,
                default="Difference between Methods")

            self$.addOption(private$..method1)
            self$.addOption(private$..method2)
            self$.addOption(private$..id)
            self$.addOption(private$..ciWidth)
            self$.addOption(private$..agreeWidth)
            self$.addOption(private$..testValue)
            self$.addOption(private$..CCC)
            self$.addOption(private$..valEq)
            self$.addOption(private$..plotbland)
            self$.addOption(private$..plotcon)
            self$.addOption(private$..prop_bias)
            self$.addOption(private$..xlabel)
            self$.addOption(private$..ylabel)
        }),
    active = list(
        method1 = function() private$..method1$value,
        method2 = function() private$..method2$value,
        id = function() private$..id$value,
        ciWidth = function() private$..ciWidth$value,
        agreeWidth = function() private$..agreeWidth$value,
        testValue = function() private$..testValue$value,
        CCC = function() private$..CCC$value,
        valEq = function() private$..valEq$value,
        plotbland = function() private$..plotbland$value,
        plotcon = function() private$..plotcon$value,
        prop_bias = function() private$..prop_bias$value,
        xlabel = function() private$..xlabel$value,
        ylabel = function() private$..ylabel$value),
    private = list(
        ..method1 = NA,
        ..method2 = NA,
        ..id = NA,
        ..ciWidth = NA,
        ..agreeWidth = NA,
        ..testValue = NA,
        ..CCC = NA,
        ..valEq = NA,
        ..plotbland = NA,
        ..plotcon = NA,
        ..prop_bias = NA,
        ..xlabel = NA,
        ..ylabel = NA)
)

jmvagreemultiResults <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
    "jmvagreemultiResults",
    inherit = jmvcore::Group,
    active = list(
        text = function() private$.items[["text"]],
        blandtab = function() private$.items[["blandtab"]],
        ccctab = function() private$.items[["ccctab"]],
        plotba = function() private$.items[["plotba"]],
        plotcon = function() private$.items[["plotcon"]]),
    private = list(),
    public=list(
        initialize=function(options) {
            super$initialize(
                options=options,
                name="",
                title="Nested/Replicate Data Agreement Analysis")
            self$add(jmvcore::Preformatted$new(
                options=options,
                name="text",
                refs=list(
                    "SimplyAgree")))
            self$add(jmvcore::Table$new(
                options=options,
                name="blandtab",
                title="Zou's MOVER Limits of Agreement",
                rows=3,
                columns=list(
                    list(
                        `name`="var", 
                        `title`="", 
                        `type`="text"),
                    list(
                        `name`="estimate", 
                        `title`="Estimate", 
                        `type`="number"),
                    list(
                        `name`="lowerci", 
                        `title`="Lower C.I.", 
                        `type`="number"),
                    list(
                        `name`="upperci", 
                        `title`="Upper C.I", 
                        `type`="number"))))
            self$add(jmvcore::Table$new(
                options=options,
                name="ccctab",
                title="Concordance Correlation Coefficient",
                visible="(CCC)",
                rows=1,
                columns=list(
                    list(
                        `name`="var", 
                        `title`="", 
                        `type`="text"),
                    list(
                        `name`="estimate", 
                        `title`="Estimate", 
                        `type`="number"),
                    list(
                        `name`="lowerci", 
                        `title`="Lower C.I.", 
                        `type`="number"),
                    list(
                        `name`="upperci", 
                        `title`="Upper C.I", 
                        `type`="number"))))
            self$add(jmvcore::Image$new(
                options=options,
                name="plotba",
                title="Bland-Altman Plot",
                visible="(plotbland)",
                renderFun=".plotba",
                width=450,
                height=400))
            self$add(jmvcore::Image$new(
                options=options,
                name="plotcon",
                title="Line-of-Identity Plot",
                visible="(plotcon)",
                renderFun=".plotcon",
                width=450,
                height=400))}))

jmvagreemultiBase <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
    "jmvagreemultiBase",
    inherit = jmvcore::Analysis,
    public = list(
        initialize = function(options, data=NULL, datasetId="", analysisId="", revision=0) {
            super$initialize(
                package = "SimplyAgree",
                name = "jmvagreemulti",
                version = c(1,0,0),
                options = options,
                results = jmvagreemultiResults$new(options=options),
                data = data,
                datasetId = datasetId,
                analysisId = analysisId,
                revision = revision,
                pause = NULL,
                completeWhenFilled = FALSE,
                requiresMissings = FALSE)
        }))

#' Nested/Replicate Data Agreement Analysis
#'
#' 
#' @param data Data
#' @param method1 Name of column containing 1st Vector of data
#' @param method2 Name of column containing Vector of data
#' @param id Name of column containing subject identifier
#' @param ciWidth a number between 50 and 99.9 (default: 95), the width of
#'   confidence intervals
#' @param agreeWidth a number between 50 and 99.9 (default: 95), the width of
#'   agreement limits
#' @param testValue a number specifying the limit of agreement
#' @param CCC \code{TRUE} or \code{FALSE} (default), produce CCC table
#' @param valEq .
#' @param plotbland \code{TRUE} or \code{FALSE} (default), for Bland-Altman
#'   plot
#' @param plotcon \code{TRUE} or \code{FALSE} (default), for Line of identity
#'   plot
#' @param prop_bias \code{TRUE} or \code{FALSE}
#' @param xlabel The label for the x-axis on the BA plot
#' @param ylabel The label for the y-axis on the BA plot
#' @return A results object containing:
#' \tabular{llllll}{
#'   \code{results$text} \tab \tab \tab \tab \tab a preformatted \cr
#'   \code{results$blandtab} \tab \tab \tab \tab \tab a table \cr
#'   \code{results$ccctab} \tab \tab \tab \tab \tab a table \cr
#'   \code{results$plotba} \tab \tab \tab \tab \tab an image \cr
#'   \code{results$plotcon} \tab \tab \tab \tab \tab an image \cr
#' }
#'
#' Tables can be converted to data frames with \code{asDF} or \code{\link{as.data.frame}}. For example:
#'
#' \code{results$blandtab$asDF}
#'
#' \code{as.data.frame(results$blandtab)}
#'
#' @export
jmvagreemulti <- function(
    data,
    method1,
    method2,
    id,
    ciWidth = 95,
    agreeWidth = 95,
    testValue = 2,
    CCC = TRUE,
    valEq = FALSE,
    plotbland = FALSE,
    plotcon = FALSE,
    prop_bias = FALSE,
    xlabel = "Average of Both Methods",
    ylabel = "Difference between Methods") {

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

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


    options <- jmvagreemultiOptions$new(
        method1 = method1,
        method2 = method2,
        id = id,
        ciWidth = ciWidth,
        agreeWidth = agreeWidth,
        testValue = testValue,
        CCC = CCC,
        valEq = valEq,
        plotbland = plotbland,
        plotcon = plotcon,
        prop_bias = prop_bias,
        xlabel = xlabel,
        ylabel = ylabel)

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

    analysis$run()

    analysis$results
}