# 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
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.