R/waterfall.h.R

Defines functions waterfall

Documented in waterfall

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

waterfallOptions <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
    "waterfallOptions",
    inherit = jmvcore::Options,
    public = list(
        initialize = function(
            patientID = NULL,
            responseVar = NULL,
            timeVar = NULL,
            inputType = "percentage",
            sortBy = "response",
            showThresholds = FALSE,
            labelOutliers = FALSE,
            showMedian = FALSE,
            showCI = FALSE,
            minResponseForLabel = 50,
            colorScheme = "jamovi",
            barAlpha = 1,
            barWidth = 0.7,
            showWaterfallPlot = FALSE,
            showSpiderPlot = FALSE, ...) {

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

            private$..patientID <- jmvcore::OptionVariable$new(
                "patientID",
                patientID,
                suggested=list(
                    "nominal"),
                permitted=list(
                    "numeric",
                    "factor",
                    "id"))
            private$..responseVar <- jmvcore::OptionVariable$new(
                "responseVar",
                responseVar,
                suggested=list(
                    "continuous"),
                permitted=list(
                    "numeric"))
            private$..timeVar <- jmvcore::OptionVariable$new(
                "timeVar",
                timeVar,
                suggested=list(
                    "continuous"),
                permitted=list(
                    "numeric"))
            private$..inputType <- jmvcore::OptionList$new(
                "inputType",
                inputType,
                options=list(
                    "raw",
                    "percentage"),
                default="percentage")
            private$..sortBy <- jmvcore::OptionList$new(
                "sortBy",
                sortBy,
                options=list(
                    "response",
                    "id"),
                default="response")
            private$..showThresholds <- jmvcore::OptionBool$new(
                "showThresholds",
                showThresholds,
                default=FALSE)
            private$..labelOutliers <- jmvcore::OptionBool$new(
                "labelOutliers",
                labelOutliers,
                default=FALSE)
            private$..showMedian <- jmvcore::OptionBool$new(
                "showMedian",
                showMedian,
                default=FALSE)
            private$..showCI <- jmvcore::OptionBool$new(
                "showCI",
                showCI,
                default=FALSE)
            private$..minResponseForLabel <- jmvcore::OptionNumber$new(
                "minResponseForLabel",
                minResponseForLabel,
                default=50,
                min=0,
                max=100)
            private$..colorScheme <- jmvcore::OptionList$new(
                "colorScheme",
                colorScheme,
                options=list(
                    "jamovi",
                    "recist",
                    "simple"),
                default="jamovi")
            private$..barAlpha <- jmvcore::OptionNumber$new(
                "barAlpha",
                barAlpha,
                default=1,
                min=0,
                max=1)
            private$..barWidth <- jmvcore::OptionNumber$new(
                "barWidth",
                barWidth,
                default=0.7,
                min=0.1,
                max=1)
            private$..showWaterfallPlot <- jmvcore::OptionBool$new(
                "showWaterfallPlot",
                showWaterfallPlot,
                default=FALSE)
            private$..showSpiderPlot <- jmvcore::OptionBool$new(
                "showSpiderPlot",
                showSpiderPlot,
                default=FALSE)
            private$..addResponseCategory <- jmvcore::OptionOutput$new(
                "addResponseCategory")

            self$.addOption(private$..patientID)
            self$.addOption(private$..responseVar)
            self$.addOption(private$..timeVar)
            self$.addOption(private$..inputType)
            self$.addOption(private$..sortBy)
            self$.addOption(private$..showThresholds)
            self$.addOption(private$..labelOutliers)
            self$.addOption(private$..showMedian)
            self$.addOption(private$..showCI)
            self$.addOption(private$..minResponseForLabel)
            self$.addOption(private$..colorScheme)
            self$.addOption(private$..barAlpha)
            self$.addOption(private$..barWidth)
            self$.addOption(private$..showWaterfallPlot)
            self$.addOption(private$..showSpiderPlot)
            self$.addOption(private$..addResponseCategory)
        }),
    active = list(
        patientID = function() private$..patientID$value,
        responseVar = function() private$..responseVar$value,
        timeVar = function() private$..timeVar$value,
        inputType = function() private$..inputType$value,
        sortBy = function() private$..sortBy$value,
        showThresholds = function() private$..showThresholds$value,
        labelOutliers = function() private$..labelOutliers$value,
        showMedian = function() private$..showMedian$value,
        showCI = function() private$..showCI$value,
        minResponseForLabel = function() private$..minResponseForLabel$value,
        colorScheme = function() private$..colorScheme$value,
        barAlpha = function() private$..barAlpha$value,
        barWidth = function() private$..barWidth$value,
        showWaterfallPlot = function() private$..showWaterfallPlot$value,
        showSpiderPlot = function() private$..showSpiderPlot$value,
        addResponseCategory = function() private$..addResponseCategory$value),
    private = list(
        ..patientID = NA,
        ..responseVar = NA,
        ..timeVar = NA,
        ..inputType = NA,
        ..sortBy = NA,
        ..showThresholds = NA,
        ..labelOutliers = NA,
        ..showMedian = NA,
        ..showCI = NA,
        ..minResponseForLabel = NA,
        ..colorScheme = NA,
        ..barAlpha = NA,
        ..barWidth = NA,
        ..showWaterfallPlot = NA,
        ..showSpiderPlot = NA,
        ..addResponseCategory = NA)
)

waterfallResults <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
    "waterfallResults",
    inherit = jmvcore::Group,
    active = list(
        todo = function() private$.items[["todo"]],
        todo2 = function() private$.items[["todo2"]],
        summaryTable = function() private$.items[["summaryTable"]],
        clinicalMetrics = function() private$.items[["clinicalMetrics"]],
        waterfallplot = function() private$.items[["waterfallplot"]],
        spiderplot = function() private$.items[["spiderplot"]],
        addResponseCategory = function() private$.items[["addResponseCategory"]]),
    private = list(),
    public=list(
        initialize=function(options) {
            super$initialize(
                options=options,
                name="",
                title="Treatment Response Analysis",
                refs=list(
                    "recist",
                    "ClinicoPathJamoviModule"))
            self$add(jmvcore::Html$new(
                options=options,
                name="todo",
                title="To Do",
                clearWith=list(
                    "patientID",
                    "responseVar",
                    "timeVar",
                    "inputType")))
            self$add(jmvcore::Html$new(
                options=options,
                name="todo2",
                title="To Do",
                clearWith=list(
                    "patientID",
                    "responseVar",
                    "timeVar",
                    "inputType")))
            self$add(jmvcore::Table$new(
                options=options,
                name="summaryTable",
                title="Response Categories Based on RECIST v1.1 Criteria",
                rows=0,
                columns=list(
                    list(
                        `name`="category", 
                        `title`="Category", 
                        `type`="text"),
                    list(
                        `name`="n", 
                        `title`="Number of Patients", 
                        `type`="integer"),
                    list(
                        `name`="percent", 
                        `title`="Percentage", 
                        `type`="number", 
                        `format`="percent")),
                clearWith=list(
                    "patientID",
                    "responseVar",
                    "timeVar",
                    "inputType")))
            self$add(jmvcore::Table$new(
                options=options,
                name="clinicalMetrics",
                title="Clinical Response Metrics",
                rows=0,
                columns=list(
                    list(
                        `name`="metric", 
                        `title`="Metric", 
                        `type`="text"),
                    list(
                        `name`="value", 
                        `title`="Value", 
                        `type`="text")),
                clearWith=list(
                    "patientID",
                    "responseVar",
                    "timeVar",
                    "inputType")))
            self$add(jmvcore::Image$new(
                options=options,
                name="waterfallplot",
                title="Waterfall Plot",
                width=800,
                height=500,
                renderFun=".waterfallplot",
                requiresData=TRUE,
                visible="(showWaterfallPlot)",
                clearWith=list(
                    "patientID",
                    "response",
                    "sortBy",
                    "showThresholds",
                    "labelOutliers",
                    "colorScheme",
                    "showMedian",
                    "showCI")))
            self$add(jmvcore::Image$new(
                options=options,
                name="spiderplot",
                title="Spider Plot - Response Over Time",
                width=800,
                height=500,
                renderFun=".spiderplot",
                requiresData=TRUE,
                visible="(showSpiderPlot)",
                clearWith=list(
                    "patientID",
                    "response",
                    "timeVar",
                    "inputType",
                    "sortBy")))
            self$add(jmvcore::Output$new(
                options=options,
                name="addResponseCategory",
                title="Add Response Category to Data",
                varTitle="RECIST",
                varDescription="Calculated response category based on RECIST criteria.",
                measureType="nominal",
                clearWith=list(
                    "patientID",
                    "responseVar",
                    "timeVar",
                    "inputType")))}))

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

#' Treatment Response Analysis
#'
#' Creates a waterfall plot to visualize tumor response data following RECIST 
#' criteria.
#'
#' @examples
#' \donttest{
#' # data <- data.frame(
#' #     PatientID = paste0("PT", 1:10),
#' #     Response = c(-100, -45, -30, -20, -10, 0, 10, 20, 30, 40)
#' # )
#' # ClinicoPathDescriptives::waterfall(
#' #     data = data,
#' #     patientID = "PatientID",
#' #     responseVar = "Response"
#' # )
#'}
#' @param data The data as a data frame.
#' @param patientID Variable containing patient identifiers.
#' @param responseVar Percentage change in tumor size.
#' @param timeVar Time point of measurement for spider plot (e.g., months from
#'   baseline)
#' @param inputType Specify data format: 'raw' for actual measurements (will
#'   calculate percent change) or 'percentage' for pre-calculated percentage
#'   changes
#' @param sortBy Sort the waterfall plot by best response or patient ID.
#' @param showThresholds Show +20 percent and -30 percent RECIST thresholds.
#' @param labelOutliers Label responses exceeding ±50 percent.
#' @param showMedian Show median response as a horizontal line.
#' @param showCI Show confidence interval around median response.
#' @param minResponseForLabel Minimum response value for labels to be
#'   displayed.
#' @param colorScheme Color scheme for waterfall plot.
#' @param barAlpha Transparency of bars in waterfall plot.
#' @param barWidth Width of bars in waterfall plot.
#' @param showWaterfallPlot .
#' @param showSpiderPlot Create an additional spider plot showing response
#'   over time if longitudinal data available
#' @return A results object containing:
#' \tabular{llllll}{
#'   \code{results$todo} \tab \tab \tab \tab \tab a html \cr
#'   \code{results$todo2} \tab \tab \tab \tab \tab a html \cr
#'   \code{results$summaryTable} \tab \tab \tab \tab \tab a table \cr
#'   \code{results$clinicalMetrics} \tab \tab \tab \tab \tab a table \cr
#'   \code{results$waterfallplot} \tab \tab \tab \tab \tab an image \cr
#'   \code{results$spiderplot} \tab \tab \tab \tab \tab an image \cr
#'   \code{results$addResponseCategory} \tab \tab \tab \tab \tab an output \cr
#' }
#'
#' Tables can be converted to data frames with \code{asDF} or \code{\link{as.data.frame}}. For example:
#'
#' \code{results$summaryTable$asDF}
#'
#' \code{as.data.frame(results$summaryTable)}
#'
#' @export
waterfall <- function(
    data,
    patientID,
    responseVar,
    timeVar,
    inputType = "percentage",
    sortBy = "response",
    showThresholds = FALSE,
    labelOutliers = FALSE,
    showMedian = FALSE,
    showCI = FALSE,
    minResponseForLabel = 50,
    colorScheme = "jamovi",
    barAlpha = 1,
    barWidth = 0.7,
    showWaterfallPlot = FALSE,
    showSpiderPlot = FALSE) {

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

    if ( ! missing(patientID)) patientID <- jmvcore::resolveQuo(jmvcore::enquo(patientID))
    if ( ! missing(responseVar)) responseVar <- jmvcore::resolveQuo(jmvcore::enquo(responseVar))
    if ( ! missing(timeVar)) timeVar <- jmvcore::resolveQuo(jmvcore::enquo(timeVar))
    if (missing(data))
        data <- jmvcore::marshalData(
            parent.frame(),
            `if`( ! missing(patientID), patientID, NULL),
            `if`( ! missing(responseVar), responseVar, NULL),
            `if`( ! missing(timeVar), timeVar, NULL))


    options <- waterfallOptions$new(
        patientID = patientID,
        responseVar = responseVar,
        timeVar = timeVar,
        inputType = inputType,
        sortBy = sortBy,
        showThresholds = showThresholds,
        labelOutliers = labelOutliers,
        showMedian = showMedian,
        showCI = showCI,
        minResponseForLabel = minResponseForLabel,
        colorScheme = colorScheme,
        barAlpha = barAlpha,
        barWidth = barWidth,
        showWaterfallPlot = showWaterfallPlot,
        showSpiderPlot = showSpiderPlot)

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

    analysis$run()

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