R/nogoldstandard.h.R

Defines functions nogoldstandard

Documented in nogoldstandard

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

nogoldstandardOptions <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
    "nogoldstandardOptions",
    inherit = jmvcore::Options,
    public = list(
        initialize = function(
            test1 = NULL,
            test1Positive = NULL,
            test2 = NULL,
            test2Positive = NULL,
            test3 = NULL,
            test3Positive = NULL,
            test4 = NULL,
            test4Positive = NULL,
            test5 = NULL,
            test5Positive = NULL,
            method = "latent_class",
            bootstrap = FALSE,
            nboot = 1000,
            alpha = 0.05, ...) {

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

            private$..test1 <- jmvcore::OptionVariable$new(
                "test1",
                test1,
                suggested=list(
                    "nominal"),
                permitted=list(
                    "factor"))
            private$..test1Positive <- jmvcore::OptionLevel$new(
                "test1Positive",
                test1Positive,
                variable="(test1)")
            private$..test2 <- jmvcore::OptionVariable$new(
                "test2",
                test2,
                suggested=list(
                    "nominal"),
                permitted=list(
                    "factor"))
            private$..test2Positive <- jmvcore::OptionLevel$new(
                "test2Positive",
                test2Positive,
                variable="(test2)")
            private$..test3 <- jmvcore::OptionVariable$new(
                "test3",
                test3,
                suggested=list(
                    "nominal"),
                permitted=list(
                    "factor"))
            private$..test3Positive <- jmvcore::OptionLevel$new(
                "test3Positive",
                test3Positive,
                variable="(test3)")
            private$..test4 <- jmvcore::OptionVariable$new(
                "test4",
                test4,
                suggested=list(
                    "nominal"),
                permitted=list(
                    "factor"))
            private$..test4Positive <- jmvcore::OptionLevel$new(
                "test4Positive",
                test4Positive,
                variable="(test4)")
            private$..test5 <- jmvcore::OptionVariable$new(
                "test5",
                test5,
                suggested=list(
                    "nominal"),
                permitted=list(
                    "factor"))
            private$..test5Positive <- jmvcore::OptionLevel$new(
                "test5Positive",
                test5Positive,
                variable="(test5)")
            private$..method <- jmvcore::OptionList$new(
                "method",
                method,
                options=list(
                    "latent_class",
                    "composite",
                    "bayesian"),
                default="latent_class")
            private$..bootstrap <- jmvcore::OptionBool$new(
                "bootstrap",
                bootstrap,
                default=FALSE)
            private$..nboot <- jmvcore::OptionNumber$new(
                "nboot",
                nboot,
                default=1000,
                min=100,
                max=10000)
            private$..alpha <- jmvcore::OptionNumber$new(
                "alpha",
                alpha,
                default=0.05,
                min=0.01,
                max=0.2)

            self$.addOption(private$..test1)
            self$.addOption(private$..test1Positive)
            self$.addOption(private$..test2)
            self$.addOption(private$..test2Positive)
            self$.addOption(private$..test3)
            self$.addOption(private$..test3Positive)
            self$.addOption(private$..test4)
            self$.addOption(private$..test4Positive)
            self$.addOption(private$..test5)
            self$.addOption(private$..test5Positive)
            self$.addOption(private$..method)
            self$.addOption(private$..bootstrap)
            self$.addOption(private$..nboot)
            self$.addOption(private$..alpha)
        }),
    active = list(
        test1 = function() private$..test1$value,
        test1Positive = function() private$..test1Positive$value,
        test2 = function() private$..test2$value,
        test2Positive = function() private$..test2Positive$value,
        test3 = function() private$..test3$value,
        test3Positive = function() private$..test3Positive$value,
        test4 = function() private$..test4$value,
        test4Positive = function() private$..test4Positive$value,
        test5 = function() private$..test5$value,
        test5Positive = function() private$..test5Positive$value,
        method = function() private$..method$value,
        bootstrap = function() private$..bootstrap$value,
        nboot = function() private$..nboot$value,
        alpha = function() private$..alpha$value),
    private = list(
        ..test1 = NA,
        ..test1Positive = NA,
        ..test2 = NA,
        ..test2Positive = NA,
        ..test3 = NA,
        ..test3Positive = NA,
        ..test4 = NA,
        ..test4Positive = NA,
        ..test5 = NA,
        ..test5Positive = NA,
        ..method = NA,
        ..bootstrap = NA,
        ..nboot = NA,
        ..alpha = NA)
)

nogoldstandardResults <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
    "nogoldstandardResults",
    inherit = jmvcore::Group,
    active = list(
        prevalence = function() private$.items[["prevalence"]],
        test_metrics = function() private$.items[["test_metrics"]],
        model_fit = function() private$.items[["model_fit"]],
        agreement_plot = function() private$.items[["agreement_plot"]]),
    private = list(),
    public=list(
        initialize=function(options) {
            super$initialize(
                options=options,
                name="",
                title="Analysis Without Gold Standard",
                refs=list(
                    "NoGoldDiagnostic",
                    "ClinicoPathJamoviModule"))
            self$add(jmvcore::Table$new(
                options=options,
                name="prevalence",
                title="Disease Prevalence",
                rows=1,
                columns=list(
                    list(
                        `name`="estimate", 
                        `title`="Estimate", 
                        `type`="number", 
                        `format`="pc"),
                    list(
                        `name`="ci_lower", 
                        `title`="Lower CI", 
                        `type`="number", 
                        `format`="pc"),
                    list(
                        `name`="ci_upper", 
                        `title`="Upper CI", 
                        `type`="number", 
                        `format`="pc"))))
            self$add(jmvcore::Table$new(
                options=options,
                name="test_metrics",
                title="Test Performance Metrics",
                columns=list(
                    list(
                        `name`="test", 
                        `title`="Test", 
                        `type`="text"),
                    list(
                        `name`="sensitivity", 
                        `title`="Sensitivity", 
                        `type`="number", 
                        `format`="pc"),
                    list(
                        `name`="sens_ci_lower", 
                        `title`="Lower CI", 
                        `superTitle`="Sensitivity", 
                        `type`="number", 
                        `format`="pc"),
                    list(
                        `name`="sens_ci_upper", 
                        `title`="Upper CI", 
                        `superTitle`="Sensitivity", 
                        `type`="number", 
                        `format`="pc"),
                    list(
                        `name`="specificity", 
                        `title`="Specificity", 
                        `type`="number", 
                        `format`="pc"),
                    list(
                        `name`="spec_ci_lower", 
                        `title`="Lower CI", 
                        `superTitle`="Specificity", 
                        `type`="number", 
                        `format`="pc"),
                    list(
                        `name`="spec_ci_upper", 
                        `title`="Upper CI", 
                        `superTitle`="Specificity", 
                        `type`="number", 
                        `format`="pc"))))
            self$add(jmvcore::Table$new(
                options=options,
                name="model_fit",
                title="Model Fit Statistics",
                visible="(method==\"latent_class\")",
                rows=1,
                columns=list(
                    list(
                        `name`="statistic", 
                        `title`="Statistic", 
                        `type`="text"),
                    list(
                        `name`="value", 
                        `title`="Value", 
                        `type`="number"))))
            self$add(jmvcore::Image$new(
                options=options,
                name="agreement_plot",
                title="Test Agreement Plot",
                renderFun=".plot",
                width=500,
                height=400))}))

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

#' Analysis Without Gold Standard
#'
#' Analysis of diagnostic tests without a gold standard reference
#'
#' @examples
#' \donttest{
#' # example will be added
#'}
#' @param data The data as a data frame.
#' @param test1 First diagnostic test variable.
#' @param test1Positive The positive level for Test 1.
#' @param test2 Second diagnostic test variable.
#' @param test2Positive The positive level for Test 2.
#' @param test3 Third diagnostic test variable (optional).
#' @param test3Positive The positive level for Test 3.
#' @param test4 Fourth diagnostic test variable (optional).
#' @param test4Positive The positive level for Test 4.
#' @param test5 Fifth diagnostic test variable (optional).
#' @param test5Positive The positive level for Test 5.
#' @param method Method for analyzing tests without gold standard.
#' @param bootstrap Calculate bootstrap confidence intervals.
#' @param nboot Number of bootstrap samples for confidence intervals.
#' @param alpha Alpha level for confidence intervals.
#' @return A results object containing:
#' \tabular{llllll}{
#'   \code{results$prevalence} \tab \tab \tab \tab \tab a table \cr
#'   \code{results$test_metrics} \tab \tab \tab \tab \tab a table \cr
#'   \code{results$model_fit} \tab \tab \tab \tab \tab a table \cr
#'   \code{results$agreement_plot} \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$prevalence$asDF}
#'
#' \code{as.data.frame(results$prevalence)}
#'
#' @export
nogoldstandard <- function(
    data,
    test1,
    test1Positive,
    test2,
    test2Positive,
    test3,
    test3Positive,
    test4,
    test4Positive,
    test5,
    test5Positive,
    method = "latent_class",
    bootstrap = FALSE,
    nboot = 1000,
    alpha = 0.05) {

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

    if ( ! missing(test1)) test1 <- jmvcore::resolveQuo(jmvcore::enquo(test1))
    if ( ! missing(test2)) test2 <- jmvcore::resolveQuo(jmvcore::enquo(test2))
    if ( ! missing(test3)) test3 <- jmvcore::resolveQuo(jmvcore::enquo(test3))
    if ( ! missing(test4)) test4 <- jmvcore::resolveQuo(jmvcore::enquo(test4))
    if ( ! missing(test5)) test5 <- jmvcore::resolveQuo(jmvcore::enquo(test5))
    if (missing(data))
        data <- jmvcore::marshalData(
            parent.frame(),
            `if`( ! missing(test1), test1, NULL),
            `if`( ! missing(test2), test2, NULL),
            `if`( ! missing(test3), test3, NULL),
            `if`( ! missing(test4), test4, NULL),
            `if`( ! missing(test5), test5, NULL))

    for (v in test1) if (v %in% names(data)) data[[v]] <- as.factor(data[[v]])
    for (v in test2) if (v %in% names(data)) data[[v]] <- as.factor(data[[v]])
    for (v in test3) if (v %in% names(data)) data[[v]] <- as.factor(data[[v]])
    for (v in test4) if (v %in% names(data)) data[[v]] <- as.factor(data[[v]])
    for (v in test5) if (v %in% names(data)) data[[v]] <- as.factor(data[[v]])

    options <- nogoldstandardOptions$new(
        test1 = test1,
        test1Positive = test1Positive,
        test2 = test2,
        test2Positive = test2Positive,
        test3 = test3,
        test3Positive = test3Positive,
        test4 = test4,
        test4Positive = test4Positive,
        test5 = test5,
        test5Positive = test5Positive,
        method = method,
        bootstrap = bootstrap,
        nboot = nboot,
        alpha = alpha)

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

    analysis$run()

    analysis$results
}
sbalci/ClinicoPathJamoviModule documentation built on Feb. 25, 2025, 6:34 a.m.