sbalci/ClinicoPathJamoviModule

View on GitHub
R/comparingsurvival.h.R

Summary

Maintainability
Test Coverage

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

comparingSurvivalOptions <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
    "comparingSurvivalOptions",
    inherit = jmvcore::Options,
    public = list(
        initialize = function(
            times = NULL,
            status = NULL,
            groups = NULL,
            ciyn = FALSE,
            loglogyn = FALSE,
            timeunits = "None", ...) {

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

            private$..times <- jmvcore::OptionVariable$new(
                "times",
                times,
                suggested=list(
                    "continuous"))
            private$..status <- jmvcore::OptionVariable$new(
                "status",
                status,
                suggested=list(
                    "continuous"))
            private$..groups <- jmvcore::OptionVariable$new(
                "groups",
                groups,
                suggested=list(
                    "nominal"))
            private$..ciyn <- jmvcore::OptionBool$new(
                "ciyn",
                ciyn,
                default=FALSE)
            private$..loglogyn <- jmvcore::OptionBool$new(
                "loglogyn",
                loglogyn,
                default=FALSE)
            private$..timeunits <- jmvcore::OptionList$new(
                "timeunits",
                timeunits,
                options=list(
                    "None",
                    "Days",
                    "Weeks",
                    "Months",
                    "Years"),
                default="None")

            self$.addOption(private$..times)
            self$.addOption(private$..status)
            self$.addOption(private$..groups)
            self$.addOption(private$..ciyn)
            self$.addOption(private$..loglogyn)
            self$.addOption(private$..timeunits)
        }),
    active = list(
        times = function() private$..times$value,
        status = function() private$..status$value,
        groups = function() private$..groups$value,
        ciyn = function() private$..ciyn$value,
        loglogyn = function() private$..loglogyn$value,
        timeunits = function() private$..timeunits$value),
    private = list(
        ..times = NA,
        ..status = NA,
        ..groups = NA,
        ..ciyn = NA,
        ..loglogyn = NA,
        ..timeunits = NA)
)

comparingSurvivalResults <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
    "comparingSurvivalResults",
    inherit = jmvcore::Group,
    active = list(
        text = function() private$.items[["text"]],
        compsurvTable1 = function() private$.items[["compsurvTable1"]],
        compsurvTable2 = function() private$.items[["compsurvTable2"]],
        compsurvTable3 = function() private$.items[["compsurvTable3"]],
        plot = function() private$.items[["plot"]],
        plot2 = function() private$.items[["plot2"]]),
    private = list(),
    public=list(
        initialize=function(options) {
            super$initialize(
                options=options,
                name="",
                title="Comparing Survival Outcomes")
            self$add(jmvcore::Preformatted$new(
                options=options,
                name="text",
                title="Comparing Survival Outcomes"))
            self$add(jmvcore::Table$new(
                options=options,
                name="compsurvTable1",
                title="Events Summary",
                clearWith=list(
                    "times",
                    "status",
                    "groups"),
                columns=list(
                    list(
                        `name`="group", 
                        `title`="", 
                        `type`="text", 
                        `content`="($key)", 
                        `visible`="(groups)"),
                    list(
                        `name`="n", 
                        `title`="Number of Subjects", 
                        `type`="integer"),
                    list(
                        `name`="obs", 
                        `title`="Observed Events (V)", 
                        `type`="integer"),
                    list(
                        `name`="exp", 
                        `title`="Expected Events (E)", 
                        `type`="number"),
                    list(
                        `name`="ovse", 
                        `title`="(O-E)^2/E", 
                        `type`="number"),
                    list(
                        `name`="ovsev", 
                        `title`="(O-E)^2/V", 
                        `type`="number"))))
            self$add(jmvcore::Table$new(
                options=options,
                name="compsurvTable2",
                title="Log-Rank Test Summary",
                rows=1,
                columns=list(
                    list(
                        `name`="var", 
                        `title`="Method", 
                        `type`="text"),
                    list(
                        `name`="chisqr", 
                        `title`="Chi-Squared", 
                        `type`="number"),
                    list(
                        `name`="df", 
                        `title`="DF", 
                        `type`="integer"),
                    list(
                        `name`="p", 
                        `title`="P-Value", 
                        `type`="number", 
                        `format`="zto,pvalue"))))
            self$add(jmvcore::Table$new(
                options=options,
                name="compsurvTable3",
                title="Median Estimates",
                clearWith=list(
                    "times",
                    "status"),
                columns=list(
                    list(
                        `name`="group", 
                        `title`="", 
                        `type`="text", 
                        `content`="($key)", 
                        `visible`="(groups)"),
                    list(
                        `name`="median", 
                        `title`="Median", 
                        `type`="number"),
                    list(
                        `name`="cilb", 
                        `title`="Lower", 
                        `type`="number"),
                    list(
                        `name`="ciub", 
                        `title`="Upper", 
                        `type`="number"))))
            self$add(jmvcore::Image$new(
                options=options,
                name="plot",
                title="Kaplan-Meier estimator of the survivor function",
                width=600,
                height=500,
                renderFun=".plot"))
            self$add(jmvcore::Image$new(
                options=options,
                name="plot2",
                title="Cumulative hazard function (log scale)",
                width=600,
                height=500,
                renderFun=".plot2"))}))

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

#' Comparing Survival Outcomes
#'
#' 
#' @param data .
#' @param times .
#' @param status .
#' @param groups .
#' @param ciyn .
#' @param loglogyn .
#' @param timeunits .
#' @return A results object containing:
#' \tabular{llllll}{
#'   \code{results$text} \tab \tab \tab \tab \tab a preformatted \cr
#'   \code{results$compsurvTable1} \tab \tab \tab \tab \tab a table \cr
#'   \code{results$compsurvTable2} \tab \tab \tab \tab \tab a table \cr
#'   \code{results$compsurvTable3} \tab \tab \tab \tab \tab a table \cr
#'   \code{results$plot} \tab \tab \tab \tab \tab an image \cr
#'   \code{results$plot2} \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$compsurvTable1$asDF}
#'
#' \code{as.data.frame(results$compsurvTable1)}
#'
#' @export
comparingSurvival <- function(
    data,
    times,
    status,
    groups,
    ciyn = FALSE,
    loglogyn = FALSE,
    timeunits = "None") {

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

    if ( ! missing(times)) times <- jmvcore::resolveQuo(jmvcore::enquo(times))
    if ( ! missing(status)) status <- jmvcore::resolveQuo(jmvcore::enquo(status))
    if ( ! missing(groups)) groups <- jmvcore::resolveQuo(jmvcore::enquo(groups))
    if (missing(data))
        data <- jmvcore::marshalData(
            parent.frame(),
            `if`( ! missing(times), times, NULL),
            `if`( ! missing(status), status, NULL),
            `if`( ! missing(groups), groups, NULL))


    options <- comparingSurvivalOptions$new(
        times = times,
        status = status,
        groups = groups,
        ciyn = ciyn,
        loglogyn = loglogyn,
        timeunits = timeunits)

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

    analysis$run()

    analysis$results
}