R/rater.h.R

Defines functions rater

Documented in rater

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

raterOptions <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
    "raterOptions",
    inherit = jmvcore::Options,
    public = list(
        initialize = function(
            vars = NULL,
            model = "oneway",
            type = "agreement",
            unit = "single",
            interrater = FALSE,
            icc = FALSE,
            bicc = FALSE,
            ic = FALSE,
            ftest = FALSE,
            fk = FALSE,
            cw = FALSE,
            ek = FALSE,
            krip = FALSE,
            method = "nominal",
            t = "col",
            pa = FALSE,
            boot = 1000,
            bt = FALSE,
            boot1 = 1000,
            kend = FALSE, ...) {

            super$initialize(
                package="seolmatrix",
                name="rater",
                requiresData=TRUE,
                ...)

            private$..vars <- jmvcore::OptionVariables$new(
                "vars",
                vars)
            private$..model <- jmvcore::OptionList$new(
                "model",
                model,
                options=list(
                    "oneway",
                    "twoway"),
                default="oneway")
            private$..type <- jmvcore::OptionList$new(
                "type",
                type,
                options=list(
                    "agreement",
                    "consistency"),
                default="agreement")
            private$..unit <- jmvcore::OptionList$new(
                "unit",
                unit,
                options=list(
                    "single",
                    "average"),
                default="single")
            private$..interrater <- jmvcore::OptionBool$new(
                "interrater",
                interrater,
                default=FALSE)
            private$..icc <- jmvcore::OptionBool$new(
                "icc",
                icc,
                default=FALSE)
            private$..bicc <- jmvcore::OptionBool$new(
                "bicc",
                bicc,
                default=FALSE)
            private$..ic <- jmvcore::OptionBool$new(
                "ic",
                ic,
                default=FALSE)
            private$..ftest <- jmvcore::OptionBool$new(
                "ftest",
                ftest,
                default=FALSE)
            private$..fk <- jmvcore::OptionBool$new(
                "fk",
                fk,
                default=FALSE)
            private$..cw <- jmvcore::OptionBool$new(
                "cw",
                cw,
                default=FALSE)
            private$..ek <- jmvcore::OptionBool$new(
                "ek",
                ek,
                default=FALSE)
            private$..krip <- jmvcore::OptionBool$new(
                "krip",
                krip,
                default=FALSE)
            private$..method <- jmvcore::OptionList$new(
                "method",
                method,
                options=list(
                    "nominal",
                    "ordinal",
                    "interval",
                    "ratio"),
                default="nominal")
            private$..t <- jmvcore::OptionList$new(
                "t",
                t,
                options=list(
                    "col",
                    "row"),
                default="col")
            private$..pa <- jmvcore::OptionBool$new(
                "pa",
                pa,
                default=FALSE)
            private$..boot <- jmvcore::OptionInteger$new(
                "boot",
                boot,
                min=100,
                default=1000)
            private$..bt <- jmvcore::OptionBool$new(
                "bt",
                bt,
                default=FALSE)
            private$..boot1 <- jmvcore::OptionInteger$new(
                "boot1",
                boot1,
                min=100,
                default=1000)
            private$..kend <- jmvcore::OptionBool$new(
                "kend",
                kend,
                default=FALSE)

            self$.addOption(private$..vars)
            self$.addOption(private$..model)
            self$.addOption(private$..type)
            self$.addOption(private$..unit)
            self$.addOption(private$..interrater)
            self$.addOption(private$..icc)
            self$.addOption(private$..bicc)
            self$.addOption(private$..ic)
            self$.addOption(private$..ftest)
            self$.addOption(private$..fk)
            self$.addOption(private$..cw)
            self$.addOption(private$..ek)
            self$.addOption(private$..krip)
            self$.addOption(private$..method)
            self$.addOption(private$..t)
            self$.addOption(private$..pa)
            self$.addOption(private$..boot)
            self$.addOption(private$..bt)
            self$.addOption(private$..boot1)
            self$.addOption(private$..kend)
        }),
    active = list(
        vars = function() private$..vars$value,
        model = function() private$..model$value,
        type = function() private$..type$value,
        unit = function() private$..unit$value,
        interrater = function() private$..interrater$value,
        icc = function() private$..icc$value,
        bicc = function() private$..bicc$value,
        ic = function() private$..ic$value,
        ftest = function() private$..ftest$value,
        fk = function() private$..fk$value,
        cw = function() private$..cw$value,
        ek = function() private$..ek$value,
        krip = function() private$..krip$value,
        method = function() private$..method$value,
        t = function() private$..t$value,
        pa = function() private$..pa$value,
        boot = function() private$..boot$value,
        bt = function() private$..bt$value,
        boot1 = function() private$..boot1$value,
        kend = function() private$..kend$value),
    private = list(
        ..vars = NA,
        ..model = NA,
        ..type = NA,
        ..unit = NA,
        ..interrater = NA,
        ..icc = NA,
        ..bicc = NA,
        ..ic = NA,
        ..ftest = NA,
        ..fk = NA,
        ..cw = NA,
        ..ek = NA,
        ..krip = NA,
        ..method = NA,
        ..t = NA,
        ..pa = NA,
        ..boot = NA,
        ..bt = NA,
        ..boot1 = NA,
        ..kend = NA)
)

raterResults <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
    "raterResults",
    inherit = jmvcore::Group,
    active = list(
        instructions = function() private$.items[["instructions"]],
        interrater = function() private$.items[["interrater"]],
        fk = function() private$.items[["fk"]],
        bt = function() private$.items[["bt"]],
        ek = function() private$.items[["ek"]],
        cw = function() private$.items[["cw"]],
        pa = function() private$.items[["pa"]],
        icc = function() private$.items[["icc"]],
        bicc = function() private$.items[["bicc"]],
        kend = function() private$.items[["kend"]],
        ic = function() private$.items[["ic"]],
        ftest = function() private$.items[["ftest"]],
        krip = function() private$.items[["krip"]]),
    private = list(),
    public=list(
        initialize=function(options) {
            super$initialize(
                options=options,
                name="",
                title="Rater Reliability",
                refs="seolmatrix")
            self$add(jmvcore::Html$new(
                options=options,
                name="instructions",
                title="Instructions",
                visible=TRUE))
            self$add(jmvcore::Table$new(
                options=options,
                name="interrater",
                title="Interrater reliability",
                rows=1,
                clearWith=list(
                    "vars",
                    "t"),
                refs="irr",
                columns=list(
                    list(
                        `name`="name", 
                        `title`="", 
                        `type`="text", 
                        `content`="Light's Kappa"),
                    list(
                        `name`="N", 
                        `type`="number"),
                    list(
                        `name`="Raters", 
                        `type`="number"),
                    list(
                        `name`="Kappa", 
                        `type`="number"),
                    list(
                        `name`="Z", 
                        `type`="number"),
                    list(
                        `name`="p", 
                        `type`="number", 
                        `format`="zto,pvalue"))))
            self$add(jmvcore::Table$new(
                options=options,
                name="fk",
                title="Fleiss Kappa",
                rows=1,
                visible="(fk)",
                clearWith=list(
                    "vars",
                    "t"),
                refs="irr",
                columns=list(
                    list(
                        `name`="name", 
                        `title`="", 
                        `type`="text", 
                        `content`="Value"),
                    list(
                        `name`="N", 
                        `type`="number"),
                    list(
                        `name`="Raters", 
                        `type`="number"),
                    list(
                        `name`="Kappa", 
                        `type`="number"),
                    list(
                        `name`="Z", 
                        `type`="number"),
                    list(
                        `name`="p", 
                        `type`="number", 
                        `format`="zto,pvalue"))))
            self$add(jmvcore::Table$new(
                options=options,
                name="bt",
                title="Bootstrap confidence intervals of Fleiss Kappa",
                visible="(bt)",
                rows=1,
                clearWith=list(
                    "vars",
                    "t",
                    "boot1"),
                columns=list(
                    list(
                        `name`="name", 
                        `title`="", 
                        `type`="text", 
                        `content`="Value"),
                    list(
                        `name`="lower", 
                        `title`="Lower", 
                        `type`="number", 
                        `superTitle`="95% CI"),
                    list(
                        `name`="upper", 
                        `title`="Upper", 
                        `type`="number", 
                        `superTitle`="95% CI"))))
            self$add(jmvcore::Table$new(
                options=options,
                name="ek",
                title="Exact Kappa",
                rows=1,
                visible="(ek)",
                clearWith=list(
                    "vars",
                    "t"),
                refs="irr",
                columns=list(
                    list(
                        `name`="name", 
                        `title`="", 
                        `type`="text", 
                        `content`="Value"),
                    list(
                        `name`="N", 
                        `type`="number"),
                    list(
                        `name`="Raters", 
                        `type`="number"),
                    list(
                        `name`="Kappa", 
                        `type`="number"))))
            self$add(jmvcore::Table$new(
                options=options,
                name="cw",
                title="Category-wise kappas",
                visible="(cw)",
                refs="irr",
                clearWith=list(
                    "vars",
                    "t"),
                columns=list(
                    list(
                        `name`="name", 
                        `title`="Category", 
                        `type`="text", 
                        `content`="($key)"),
                    list(
                        `name`="k", 
                        `title`="Kappa", 
                        `type`="number"),
                    list(
                        `name`="z", 
                        `title`="Z", 
                        `type`="number"),
                    list(
                        `name`="p", 
                        `title`="p", 
                        `type`="number", 
                        `format`="zto,pvalue"))))
            self$add(jmvcore::Table$new(
                options=options,
                name="pa",
                title="Simple percentage agreement",
                rows=1,
                visible="(pa)",
                clearWith=list(
                    "vars",
                    "t"),
                refs="irr",
                columns=list(
                    list(
                        `name`="name", 
                        `title`="", 
                        `type`="text", 
                        `content`="Value"),
                    list(
                        `name`="Subjects", 
                        `type`="number"),
                    list(
                        `name`="Raters", 
                        `type`="number"),
                    list(
                        `name`="Agreement(%)", 
                        `type`="number"))))
            self$add(jmvcore::Table$new(
                options=options,
                name="icc",
                title="Intraclass correlation coefficient",
                visible="(icc)",
                rows=1,
                clearWith=list(
                    "vars",
                    "t"),
                refs="psy",
                columns=list(
                    list(
                        `name`="name", 
                        `title`="", 
                        `type`="text", 
                        `content`="Value"),
                    list(
                        `name`="Subjects", 
                        `type`="number"),
                    list(
                        `name`="Raters", 
                        `type`="number"),
                    list(
                        `name`="Subject variance", 
                        `type`="number"),
                    list(
                        `name`="Rater variance", 
                        `type`="number"),
                    list(
                        `name`="Residual variance", 
                        `type`="number"),
                    list(
                        `name`="Consistency", 
                        `type`="number"),
                    list(
                        `name`="Agreement", 
                        `type`="number"))))
            self$add(jmvcore::Table$new(
                options=options,
                name="bicc",
                title="Bootstrap confidence intervals of ICC agreement",
                visible="(bicc)",
                rows=1,
                clearWith=list(
                    "vars",
                    "t",
                    "boot"),
                columns=list(
                    list(
                        `name`="name", 
                        `title`="", 
                        `type`="text", 
                        `content`="Value"),
                    list(
                        `name`="lower", 
                        `title`="Lower", 
                        `type`="number", 
                        `superTitle`="95% CI"),
                    list(
                        `name`="upper", 
                        `title`="Upper", 
                        `type`="number", 
                        `superTitle`="95% CI"))))
            self$add(jmvcore::Table$new(
                options=options,
                name="kend",
                title="Kendall\u2019s coefficient of concordance W",
                rows=1,
                visible="(kend)",
                clearWith=list(
                    "vars",
                    "t"),
                refs="irr",
                columns=list(
                    list(
                        `name`="name", 
                        `title`="", 
                        `type`="text", 
                        `content`="Value"),
                    list(
                        `name`="n", 
                        `title`="Subjects", 
                        `type`="number"),
                    list(
                        `name`="rater", 
                        `title`="Raters", 
                        `type`="number"),
                    list(
                        `name`="w", 
                        `title`="W", 
                        `type`="number"),
                    list(
                        `name`="chi", 
                        `title`="Chi-square", 
                        `type`="number"),
                    list(
                        `name`="p", 
                        `title`="p", 
                        `type`="number", 
                        `format`="zto,pvalue"))))
            self$add(jmvcore::Table$new(
                options=options,
                name="ic",
                title="Intraclass Correlation Coefficient(ICC)",
                rows=1,
                visible="(ic)",
                clearWith=list(
                    "vars",
                    "model",
                    "type",
                    "unit",
                    "t"),
                refs="irr",
                columns=list(
                    list(
                        `name`="model", 
                        `title`="Model", 
                        `type`="text"),
                    list(
                        `name`="type", 
                        `title`="Type", 
                        `type`="text"),
                    list(
                        `name`="unit", 
                        `title`="Unit", 
                        `type`="text"),
                    list(
                        `name`="sub", 
                        `title`="Subjects", 
                        `type`="integer"),
                    list(
                        `name`="raters", 
                        `title`="Raters", 
                        `type`="integer"),
                    list(
                        `name`="icc", 
                        `title`="ICC", 
                        `type`="number"))))
            self$add(jmvcore::Table$new(
                options=options,
                name="ftest",
                title="F test for ICC",
                rows=1,
                visible="(ftest)",
                clearWith=list(
                    "vars",
                    "model",
                    "type",
                    "unit",
                    "t"),
                refs="irr",
                columns=list(
                    list(
                        `name`="icc", 
                        `title`="ICC", 
                        `type`="number"),
                    list(
                        `name`="f", 
                        `title`="F", 
                        `type`="number"),
                    list(
                        `name`="df1", 
                        `title`="df1", 
                        `type`="number"),
                    list(
                        `name`="df2", 
                        `title`="df2", 
                        `type`="number"),
                    list(
                        `name`="p1", 
                        `title`="p", 
                        `type`="number", 
                        `format`="zto, number"),
                    list(
                        `name`="lower", 
                        `title`="Lower", 
                        `type`="number", 
                        `superTitle`="95% CI"),
                    list(
                        `name`="upper", 
                        `title`="Upper", 
                        `type`="number", 
                        `superTitle`="95% CI"))))
            self$add(jmvcore::Table$new(
                options=options,
                name="krip",
                title="`Krippendorff alpha - ${method}`",
                rows=1,
                visible="(krip)",
                refs="irr",
                clearWith=list(
                    "vars",
                    "method",
                    "t"),
                columns=list(
                    list(
                        `name`="name", 
                        `title`="", 
                        `type`="text", 
                        `content`="Value"),
                    list(
                        `name`="Subjects", 
                        `type`="number"),
                    list(
                        `name`="Raters", 
                        `type`="number"),
                    list(
                        `name`="alpha", 
                        `type`="number"))))}))

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

#' Rater Reliability
#'
#' 
#' @param data The data as a data frame.
#' @param vars .
#' @param model .
#' @param type .
#' @param unit .
#' @param interrater .
#' @param icc .
#' @param bicc .
#' @param ic .
#' @param ftest .
#' @param fk .
#' @param cw .
#' @param ek .
#' @param krip .
#' @param method .
#' @param t .
#' @param pa .
#' @param boot .
#' @param bt .
#' @param boot1 .
#' @param kend .
#' @return A results object containing:
#' \tabular{llllll}{
#'   \code{results$instructions} \tab \tab \tab \tab \tab a html \cr
#'   \code{results$interrater} \tab \tab \tab \tab \tab a table \cr
#'   \code{results$fk} \tab \tab \tab \tab \tab a table \cr
#'   \code{results$bt} \tab \tab \tab \tab \tab a table \cr
#'   \code{results$ek} \tab \tab \tab \tab \tab a table \cr
#'   \code{results$cw} \tab \tab \tab \tab \tab a table \cr
#'   \code{results$pa} \tab \tab \tab \tab \tab a table \cr
#'   \code{results$icc} \tab \tab \tab \tab \tab a table \cr
#'   \code{results$bicc} \tab \tab \tab \tab \tab a table \cr
#'   \code{results$kend} \tab \tab \tab \tab \tab a table \cr
#'   \code{results$ic} \tab \tab \tab \tab \tab a table \cr
#'   \code{results$ftest} \tab \tab \tab \tab \tab a table \cr
#'   \code{results$krip} \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$interrater$asDF}
#'
#' \code{as.data.frame(results$interrater)}
#'
#' @export
rater <- function(
    data,
    vars,
    model = "oneway",
    type = "agreement",
    unit = "single",
    interrater = FALSE,
    icc = FALSE,
    bicc = FALSE,
    ic = FALSE,
    ftest = FALSE,
    fk = FALSE,
    cw = FALSE,
    ek = FALSE,
    krip = FALSE,
    method = "nominal",
    t = "col",
    pa = FALSE,
    boot = 1000,
    bt = FALSE,
    boot1 = 1000,
    kend = FALSE) {

    if ( ! requireNamespace("jmvcore", quietly=TRUE))
        stop("rater 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))


    options <- raterOptions$new(
        vars = vars,
        model = model,
        type = type,
        unit = unit,
        interrater = interrater,
        icc = icc,
        bicc = bicc,
        ic = ic,
        ftest = ftest,
        fk = fk,
        cw = cw,
        ek = ek,
        krip = krip,
        method = method,
        t = t,
        pa = pa,
        boot = boot,
        bt = bt,
        boot1 = boot1,
        kend = kend)

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

    analysis$run()

    analysis$results
}
hyunsooseol/seolmatrix documentation built on July 25, 2024, 4:42 a.m.