R/agreement.h.R

In sbalci/ClinicoPathJamoviModule: Analysis for Clinicopathological Research

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

agreementOptions <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
    "agreementOptions",
    inherit = jmvcore::Options,
    public = list(
        initialize = function(
            vars = NULL,
            sft = FALSE,
            heatmap = FALSE,
            heatmapDetails = FALSE,
            wght = "unweighted",
            exct = FALSE,
            kripp = FALSE,
            krippMethod = "nominal",
            bootstrap = FALSE, ...) {

            super$initialize(
                package="ClinicoPath",
                name="agreement",
                requiresData=TRUE,
                ...)

            private$..vars <- jmvcore::OptionVariables$new(
                "vars",
                vars,
                suggested=list(
                    "ordinal",
                    "nominal"),
                permitted=list(
                    "factor"))
            private$..sft <- jmvcore::OptionBool$new(
                "sft",
                sft,
                default=FALSE)
            private$..heatmap <- jmvcore::OptionBool$new(
                "heatmap",
                heatmap,
                default=FALSE)
            private$..heatmapDetails <- jmvcore::OptionBool$new(
                "heatmapDetails",
                heatmapDetails,
                default=FALSE)
            private$..wght <- jmvcore::OptionList$new(
                "wght",
                wght,
                options=list(
                    "unweighted",
                    "squared",
                    "equal"),
                default="unweighted")
            private$..exct <- jmvcore::OptionBool$new(
                "exct",
                exct,
                default=FALSE)
            private$..kripp <- jmvcore::OptionBool$new(
                "kripp",
                kripp,
                default=FALSE)
            private$..krippMethod <- jmvcore::OptionList$new(
                "krippMethod",
                krippMethod,
                options=list(
                    "nominal",
                    "ordinal",
                    "interval",
                    "ratio"),
                default="nominal")
            private$..bootstrap <- jmvcore::OptionBool$new(
                "bootstrap",
                bootstrap,
                default=FALSE)

            self$.addOption(private$..vars)
            self$.addOption(private$..sft)
            self$.addOption(private$..heatmap)
            self$.addOption(private$..heatmapDetails)
            self$.addOption(private$..wght)
            self$.addOption(private$..exct)
            self$.addOption(private$..kripp)
            self$.addOption(private$..krippMethod)
            self$.addOption(private$..bootstrap)
        }),
    active = list(
        vars = function() private$..vars$value,
        sft = function() private$..sft$value,
        heatmap = function() private$..heatmap$value,
        heatmapDetails = function() private$..heatmapDetails$value,
        wght = function() private$..wght$value,
        exct = function() private$..exct$value,
        kripp = function() private$..kripp$value,
        krippMethod = function() private$..krippMethod$value,
        bootstrap = function() private$..bootstrap$value),
    private = list(
        ..vars = NA,
        ..sft = NA,
        ..heatmap = NA,
        ..heatmapDetails = NA,
        ..wght = NA,
        ..exct = NA,
        ..kripp = NA,
        ..krippMethod = NA,
        ..bootstrap = NA)
)

agreementResults <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
    "agreementResults",
    inherit = jmvcore::Group,
    active = list(
        irrtable = function() private$.items[["irrtable"]],
        heatmapPlot = function() private$.items[["heatmapPlot"]],
        text2 = function() private$.items[["text2"]],
        text = function() private$.items[["text"]],
        krippTable = function() private$.items[["krippTable"]]),
    private = list(),
    public=list(
        initialize=function(options) {
            super$initialize(
                options=options,
                name="",
                title="Interrater Reliability",
                refs=list(
                    "irr",
                    "PathologyKappa",
                    "ClinicoPathJamoviModule"))
            self$add(jmvcore::Table$new(
                options=options,
                name="irrtable",
                title="Interrater Reliability",
                swapRowsColumns=TRUE,
                rows=1,
                columns=list(
                    list(
                        `name`="method", 
                        `title`="Method", 
                        `type`="text"),
                    list(
                        `name`="subjects", 
                        `title`="Subjects", 
                        `type`="integer"),
                    list(
                        `name`="raters", 
                        `title`="Raters", 
                        `type`="integer"),
                    list(
                        `name`="peragree", 
                        `title`="Agreement %", 
                        `type`="integer"),
                    list(
                        `name`="kappa", 
                        `title`="Kappa", 
                        `type`="number"),
                    list(
                        `name`="z", 
                        `title`="z", 
                        `type`="number"),
                    list(
                        `name`="p", 
                        `title`="p-value", 
                        `type`="number", 
                        `format`="zto,pvalue")),
                clearWith=list(
                    "vars",
                    "wght",
                    "exct")))
            self$add(jmvcore::Image$new(
                options=options,
                name="heatmapPlot",
                title="Agreement Heatmap",
                width=700,
                height=500,
                renderFun=".heatmapPlot",
                visible="(heatmap)",
                clearWith=list(
                    "vars",
                    "wght",
                    "exct",
                    "heatmap",
                    "heatmapDetails")))
            self$add(jmvcore::Html$new(
                options=options,
                name="text2",
                title="Table",
                visible="(sft)",
                clearWith=list(
                    "vars",
                    "wght",
                    "exct")))
            self$add(jmvcore::Preformatted$new(
                options=options,
                name="text",
                title="Table",
                visible="(sft)",
                clearWith=list(
                    "vars",
                    "wght",
                    "exct")))
            self$add(jmvcore::Table$new(
                options=options,
                name="krippTable",
                title="Krippendorff's Alpha Results",
                visible="(kripp)",
                rows=1,
                columns=list(
                    list(
                        `name`="method", 
                        `title`="Method", 
                        `type`="text"),
                    list(
                        `name`="subjects", 
                        `title`="Cases", 
                        `type`="integer"),
                    list(
                        `name`="raters", 
                        `title`="Raters", 
                        `type`="integer"),
                    list(
                        `name`="alpha", 
                        `title`="Alpha", 
                        `type`="number"),
                    list(
                        `name`="ci_lower", 
                        `title`="CI Lower", 
                        `type`="number", 
                        `visible`="(bootstrap)"),
                    list(
                        `name`="ci_upper", 
                        `title`="CI Upper", 
                        `type`="number", 
                        `visible`="(bootstrap)")),
                clearWith=list(
                    "vars",
                    "krippMethod",
                    "bootstrap")))}))

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

#' Interrater Reliability
#'
#' Function for Interrater Reliability.
#'
#' @examples
#' \donttest{
#' # example will be added
#'}
#' @param data The data as a data frame. The data should be in long format,
#'   where each row is a unique observation.
#' @param vars A string naming the variable from \code{data} that contains the
#'   diagnosis given by the observer, variable can be categorical or ordinal.
#' @param sft Boolean selection whether to show frequency table. Default is
#'   'false'. If 'true', the function will show frequency table for each
#'   observer.
#' @param heatmap Boolean selection whether to show agreement heatmap. Default
#'   is 'true'.
#' @param heatmapDetails Boolean selection whether to show detailed heatmap
#'   with kappa values. Default is 'false'.
#' @param wght A list for the argument weight (wght), for weighted kappa
#'   analysis. Default is 'unweighted'. 'squared' or 'equal' should be selected
#'   only with ordinal variables. The function gives error if the variable type
#'   is not ordinal. The default is 'unweighted'.
#' @param exct Boolean selection whether to use exact kappa. Effects only more
#'   than 3 observers. Default is 'false'.
#' @param kripp Boolean selection whether to calculate Krippendorff's alpha.
#'   Default is 'false'.
#' @param krippMethod Specifies the measurement level for Krippendorff's alpha
#'   calculation.
#' @param bootstrap Calculate bootstrap confidence intervals for
#'   Krippendorff's alpha.
#' @return A results object containing:
#' \tabular{llllll}{
#'   \code{results$irrtable} \tab \tab \tab \tab \tab a table \cr
#'   \code{results$heatmapPlot} \tab \tab \tab \tab \tab an image \cr
#'   \code{results$text2} \tab \tab \tab \tab \tab a html \cr
#'   \code{results$text} \tab \tab \tab \tab \tab a preformatted \cr
#'   \code{results$krippTable} \tab \tab \tab \tab \tab a table \cr
#' }
#'
#' Tables can be converted to data frames with \code{asDF} or \code{\link{as.data.frame}}. For example:
#'
#' \code{results$irrtable$asDF}
#'
#' \code{as.data.frame(results$irrtable)}
#'
#' @export
agreement <- function(
    data,
    vars,
    sft = FALSE,
    heatmap = FALSE,
    heatmapDetails = FALSE,
    wght = "unweighted",
    exct = FALSE,
    kripp = FALSE,
    krippMethod = "nominal",
    bootstrap = FALSE) {

    if ( ! requireNamespace("jmvcore", quietly=TRUE))
        stop("agreement 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 <- agreementOptions$new(
        vars = vars,
        sft = sft,
        heatmap = heatmap,
        heatmapDetails = heatmapDetails,
        wght = wght,
        exct = exct,
        kripp = kripp,
        krippMethod = krippMethod,
        bootstrap = bootstrap)

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

    analysis$run()

    analysis$results
}