R/decisioncurve.h.R
In sbalci/ClinicoPathJamoviModule: Analysis for Clinicopathological Research
Defines functions
decisioncurve
Documented in
decisioncurve
# This file is automatically generated, you probably don't want to edit this
decisioncurveOptions <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
"decisioncurveOptions",
inherit = jmvcore::Options,
public = list(
initialize = function(
outcome = NULL,
outcomePositive = NULL,
models = NULL,
modelNames = "",
thresholdRange = "clinical",
thresholdMin = 0.05,
thresholdMax = 0.5,
thresholdStep = 0.01,
showTable = TRUE,
selectedThresholds = "0.05, 0.10, 0.15, 0.20, 0.25, 0.30",
showPlot = TRUE,
plotStyle = "standard",
showReferenceLinesLabels = TRUE,
highlightRange = FALSE,
highlightMin = 0.1,
highlightMax = 0.3,
calculateClinicalImpact = FALSE,
populationSize = 1000,
showInterventionAvoided = FALSE,
confidenceIntervals = FALSE,
bootReps = 1000,
ciLevel = 0.95,
showOptimalThreshold = TRUE,
compareModels = FALSE,
weightedAUC = FALSE, ...) {
super$initialize(
package="ClinicoPath",
name="decisioncurve",
requiresData=TRUE,
...)
private$..outcome <- jmvcore::OptionVariable$new(
"outcome",
outcome,
suggested=list(
"nominal"),
permitted=list(
"factor"))
private$..outcomePositive <- jmvcore::OptionLevel$new(
"outcomePositive",
outcomePositive,
variable="(outcome)")
private$..models <- jmvcore::OptionVariables$new(
"models",
models,
suggested=list(
"continuous"),
permitted=list(
"numeric",
"factor"))
private$..modelNames <- jmvcore::OptionString$new(
"modelNames",
modelNames,
default="")
private$..thresholdRange <- jmvcore::OptionList$new(
"thresholdRange",
thresholdRange,
options=list(
"auto",
"clinical",
"custom"),
default="clinical")
private$..thresholdMin <- jmvcore::OptionNumber$new(
"thresholdMin",
thresholdMin,
default=0.05,
min=0.001,
max=0.999)
private$..thresholdMax <- jmvcore::OptionNumber$new(
"thresholdMax",
thresholdMax,
default=0.5,
min=0.001,
max=0.999)
private$..thresholdStep <- jmvcore::OptionNumber$new(
"thresholdStep",
thresholdStep,
default=0.01,
min=0.001,
max=0.1)
private$..showTable <- jmvcore::OptionBool$new(
"showTable",
showTable,
default=TRUE)
private$..selectedThresholds <- jmvcore::OptionString$new(
"selectedThresholds",
selectedThresholds,
default="0.05, 0.10, 0.15, 0.20, 0.25, 0.30")
private$..showPlot <- jmvcore::OptionBool$new(
"showPlot",
showPlot,
default=TRUE)
private$..plotStyle <- jmvcore::OptionList$new(
"plotStyle",
plotStyle,
options=list(
"standard",
"clean",
"detailed"),
default="standard")
private$..showReferenceLinesLabels <- jmvcore::OptionBool$new(
"showReferenceLinesLabels",
showReferenceLinesLabels,
default=TRUE)
private$..highlightRange <- jmvcore::OptionBool$new(
"highlightRange",
highlightRange,
default=FALSE)
private$..highlightMin <- jmvcore::OptionNumber$new(
"highlightMin",
highlightMin,
default=0.1,
min=0.001,
max=0.999)
private$..highlightMax <- jmvcore::OptionNumber$new(
"highlightMax",
highlightMax,
default=0.3,
min=0.001,
max=0.999)
private$..calculateClinicalImpact <- jmvcore::OptionBool$new(
"calculateClinicalImpact",
calculateClinicalImpact,
default=FALSE)
private$..populationSize <- jmvcore::OptionNumber$new(
"populationSize",
populationSize,
default=1000,
min=100,
max=1000000)
private$..showInterventionAvoided <- jmvcore::OptionBool$new(
"showInterventionAvoided",
showInterventionAvoided,
default=FALSE)
private$..confidenceIntervals <- jmvcore::OptionBool$new(
"confidenceIntervals",
confidenceIntervals,
default=FALSE)
private$..bootReps <- jmvcore::OptionNumber$new(
"bootReps",
bootReps,
default=1000,
min=100,
max=10000)
private$..ciLevel <- jmvcore::OptionNumber$new(
"ciLevel",
ciLevel,
default=0.95,
min=0.8,
max=0.99)
private$..showOptimalThreshold <- jmvcore::OptionBool$new(
"showOptimalThreshold",
showOptimalThreshold,
default=TRUE)
private$..compareModels <- jmvcore::OptionBool$new(
"compareModels",
compareModels,
default=FALSE)
private$..weightedAUC <- jmvcore::OptionBool$new(
"weightedAUC",
weightedAUC,
default=FALSE)
self$.addOption(private$..outcome)
self$.addOption(private$..outcomePositive)
self$.addOption(private$..models)
self$.addOption(private$..modelNames)
self$.addOption(private$..thresholdRange)
self$.addOption(private$..thresholdMin)
self$.addOption(private$..thresholdMax)
self$.addOption(private$..thresholdStep)
self$.addOption(private$..showTable)
self$.addOption(private$..selectedThresholds)
self$.addOption(private$..showPlot)
self$.addOption(private$..plotStyle)
self$.addOption(private$..showReferenceLinesLabels)
self$.addOption(private$..highlightRange)
self$.addOption(private$..highlightMin)
self$.addOption(private$..highlightMax)
self$.addOption(private$..calculateClinicalImpact)
self$.addOption(private$..populationSize)
self$.addOption(private$..showInterventionAvoided)
self$.addOption(private$..confidenceIntervals)
self$.addOption(private$..bootReps)
self$.addOption(private$..ciLevel)
self$.addOption(private$..showOptimalThreshold)
self$.addOption(private$..compareModels)
self$.addOption(private$..weightedAUC)
}),
active = list(
outcome = function() private$..outcome$value,
outcomePositive = function() private$..outcomePositive$value,
models = function() private$..models$value,
modelNames = function() private$..modelNames$value,
thresholdRange = function() private$..thresholdRange$value,
thresholdMin = function() private$..thresholdMin$value,
thresholdMax = function() private$..thresholdMax$value,
thresholdStep = function() private$..thresholdStep$value,
showTable = function() private$..showTable$value,
selectedThresholds = function() private$..selectedThresholds$value,
showPlot = function() private$..showPlot$value,
plotStyle = function() private$..plotStyle$value,
showReferenceLinesLabels = function() private$..showReferenceLinesLabels$value,
highlightRange = function() private$..highlightRange$value,
highlightMin = function() private$..highlightMin$value,
highlightMax = function() private$..highlightMax$value,
calculateClinicalImpact = function() private$..calculateClinicalImpact$value,
populationSize = function() private$..populationSize$value,
showInterventionAvoided = function() private$..showInterventionAvoided$value,
confidenceIntervals = function() private$..confidenceIntervals$value,
bootReps = function() private$..bootReps$value,
ciLevel = function() private$..ciLevel$value,
showOptimalThreshold = function() private$..showOptimalThreshold$value,
compareModels = function() private$..compareModels$value,
weightedAUC = function() private$..weightedAUC$value),
private = list(
..outcome = NA,
..outcomePositive = NA,
..models = NA,
..modelNames = NA,
..thresholdRange = NA,
..thresholdMin = NA,
..thresholdMax = NA,
..thresholdStep = NA,
..showTable = NA,
..selectedThresholds = NA,
..showPlot = NA,
..plotStyle = NA,
..showReferenceLinesLabels = NA,
..highlightRange = NA,
..highlightMin = NA,
..highlightMax = NA,
..calculateClinicalImpact = NA,
..populationSize = NA,
..showInterventionAvoided = NA,
..confidenceIntervals = NA,
..bootReps = NA,
..ciLevel = NA,
..showOptimalThreshold = NA,
..compareModels = NA,
..weightedAUC = NA)
)
decisioncurveResults <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
"decisioncurveResults",
inherit = jmvcore::Group,
active = list(
instructions = function() private$.items[["instructions"]],
procedureNotes = function() private$.items[["procedureNotes"]],
resultsTable = function() private$.items[["resultsTable"]],
optimalTable = function() private$.items[["optimalTable"]],
clinicalImpactTable = function() private$.items[["clinicalImpactTable"]],
comparisonTable = function() private$.items[["comparisonTable"]],
weightedAUCTable = function() private$.items[["weightedAUCTable"]],
dcaPlot = function() private$.items[["dcaPlot"]],
clinicalImpactPlot = function() private$.items[["clinicalImpactPlot"]],
interventionsAvoidedPlot = function() private$.items[["interventionsAvoidedPlot"]],
summaryText = function() private$.items[["summaryText"]]),
private = list(),
public=list(
initialize=function(options) {
super$initialize(
options=options,
name="",
title="Decision Curve Analysis",
refs=list(
"DecisionCurve",
"rmda",
"ggplot2",
"dplyr",
"ClinicoPathJamoviModule"))
self$add(jmvcore::Html$new(
options=options,
name="instructions",
title="Instructions",
visible=TRUE))
self$add(jmvcore::Html$new(
options=options,
name="procedureNotes",
title="Analysis Summary",
visible=TRUE))
self$add(jmvcore::Table$new(
options=options,
name="resultsTable",
title="Net Benefit at Selected Thresholds",
visible="(showTable)",
rows=0,
columns=list(
list(
`name`="threshold",
`title`="Threshold Probability",
`type`="number",
`format`="pc"),
list(
`name`="treat_all",
`title`="Treat All",
`type`="number",
`format`="zto"),
list(
`name`="treat_none",
`title`="Treat None",
`type`="number",
`format`="zto")),
clearWith=list(
"outcome",
"outcomePositive",
"models",
"thresholdRange",
"thresholdMin",
"thresholdMax",
"selectedThresholds")))
self$add(jmvcore::Table$new(
options=options,
name="optimalTable",
title="Optimal Thresholds",
visible="(showOptimalThreshold)",
rows=0,
columns=list(
list(
`name`="model",
`title`="Model",
`type`="text"),
list(
`name`="optimal_threshold",
`title`="Optimal Threshold",
`type`="number",
`format`="pc"),
list(
`name`="max_net_benefit",
`title`="Maximum Net Benefit",
`type`="number",
`format`="zto"),
list(
`name`="threshold_range_start",
`title`="Beneficial Range Start",
`type`="number",
`format`="pc"),
list(
`name`="threshold_range_end",
`title`="Beneficial Range End",
`type`="number",
`format`="pc")),
clearWith=list(
"outcome",
"outcomePositive",
"models",
"thresholdRange",
"thresholdMin",
"thresholdMax")))
self$add(jmvcore::Table$new(
options=options,
name="clinicalImpactTable",
title="Clinical Impact Analysis",
visible="(calculateClinicalImpact)",
rows=0,
columns=list(
list(
`name`="model",
`title`="Model",
`type`="text"),
list(
`name`="threshold",
`title`="Threshold",
`type`="number",
`format`="pc"),
list(
`name`="interventions_per_100",
`title`="Interventions per 100",
`type`="number",
`format`="zto"),
list(
`name`="true_positives_per_100",
`title`="True Positives per 100",
`type`="number",
`format`="zto"),
list(
`name`="false_positives_per_100",
`title`="False Positives per 100",
`type`="number",
`format`="zto"),
list(
`name`="interventions_avoided",
`title`="Interventions Avoided vs Treat All",
`type`="number",
`format`="zto"),
list(
`name`="number_needed_to_screen",
`title`="Number Needed to Screen",
`type`="number",
`format`="zto")),
clearWith=list(
"outcome",
"outcomePositive",
"models",
"populationSize",
"selectedThresholds")))
self$add(jmvcore::Table$new(
options=options,
name="comparisonTable",
title="Model Comparison",
visible="(compareModels)",
rows=0,
columns=list(
list(
`name`="comparison",
`title`="Comparison",
`type`="text"),
list(
`name`="weighted_auc_diff",
`title`="Weighted AUC Difference",
`type`="number",
`format`="zto"),
list(
`name`="ci_lower",
`title`="95% CI Lower",
`type`="number",
`format`="zto"),
list(
`name`="ci_upper",
`title`="95% CI Upper",
`type`="number",
`format`="zto"),
list(
`name`="p_value",
`title`="P-value",
`type`="number",
`format`="zto,pvalue")),
clearWith=list(
"outcome",
"outcomePositive",
"models",
"compareModels")))
self$add(jmvcore::Table$new(
options=options,
name="weightedAUCTable",
title="Weighted Area Under Decision Curve",
visible="(weightedAUC)",
rows=0,
columns=list(
list(
`name`="model",
`title`="Model",
`type`="text"),
list(
`name`="weighted_auc",
`title`="Weighted AUC",
`type`="number",
`format`="zto"),
list(
`name`="auc_range",
`title`="Threshold Range",
`type`="text"),
list(
`name`="relative_benefit",
`title`="Relative Benefit vs Treat All",
`type`="number",
`format`="pc")),
clearWith=list(
"outcome",
"outcomePositive",
"models",
"thresholdRange",
"thresholdMin",
"thresholdMax")))
self$add(jmvcore::Image$new(
options=options,
name="dcaPlot",
title="Decision Curve Analysis",
width=700,
height=500,
renderFun=".plotDCA",
visible="(showPlot)",
clearWith=list(
"outcome",
"outcomePositive",
"models",
"thresholdRange",
"thresholdMin",
"thresholdMax",
"thresholdStep",
"plotStyle",
"showReferenceLinesLabels",
"highlightRange",
"confidenceIntervals")))
self$add(jmvcore::Image$new(
options=options,
name="clinicalImpactPlot",
title="Clinical Impact",
width=700,
height=500,
renderFun=".plotClinicalImpact",
visible="(calculateClinicalImpact && showPlot)",
clearWith=list(
"outcome",
"outcomePositive",
"models",
"populationSize",
"thresholdRange",
"thresholdMin",
"thresholdMax")))
self$add(jmvcore::Image$new(
options=options,
name="interventionsAvoidedPlot",
title="Interventions Avoided",
width=700,
height=500,
renderFun=".plotInterventionsAvoided",
visible="(showInterventionAvoided && showPlot)",
clearWith=list(
"outcome",
"outcomePositive",
"models",
"thresholdRange",
"thresholdMin",
"thresholdMax")))
self$add(jmvcore::Html$new(
options=options,
name="summaryText",
title="Clinical Interpretation",
visible=TRUE,
clearWith=list(
"outcome",
"outcomePositive",
"models",
"thresholdRange",
"thresholdMin",
"thresholdMax")))}))
decisioncurveBase <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
"decisioncurveBase",
inherit = jmvcore::Analysis,
public = list(
initialize = function(options, data=NULL, datasetId="", analysisId="", revision=0) {
super$initialize(
package = "ClinicoPath",
name = "decisioncurve",
version = c(0,0,3),
options = options,
results = decisioncurveResults$new(options=options),
data = data,
datasetId = datasetId,
analysisId = analysisId,
revision = revision,
pause = NULL,
completeWhenFilled = FALSE,
requiresMissings = FALSE,
weightsSupport = 'auto')
}))
#' Decision Curve Analysis
#'
#' Decision Curve Analysis for evaluating the clinical utility of prediction
#' models and diagnostic tests. Calculates net benefit across threshold
#' probabilities to determine if using a model provides more benefit than
#' default strategies.
#'
#'
#' @examples
#' \donttest{
#' # example will be added
#'}
#' @param data The data as a data frame.
#' @param outcome Binary outcome variable (0/1 or FALSE/TRUE). This represents
#' the condition or event you want to predict.
#' @param outcomePositive Which level of the outcome variable represents the
#' positive case (presence of condition/event).
#' @param models Variables representing predicted probabilities or risk scores
#' from different models. Can include multiple models for comparison.
#' @param modelNames Optional comma-separated list of names for the models. If
#' not provided, variable names will be used.
#' @param thresholdRange Range of threshold probabilities to evaluate.
#' @param thresholdMin Minimum threshold probability when using custom range.
#' @param thresholdMax Maximum threshold probability when using custom range.
#' @param thresholdStep Step size between threshold probabilities.
#' @param showTable Display table with net benefit values at selected
#' thresholds.
#' @param selectedThresholds Comma-separated list of threshold probabilities
#' to display in table.
#' @param showPlot Display the decision curve plot.
#' @param plotStyle Style of the decision curve plot.
#' @param showReferenceLinesLabels Show labels for "Treat All" and "Treat
#' None" reference lines.
#' @param highlightRange Highlight a clinically relevant threshold range on
#' the plot.
#' @param highlightMin Minimum threshold for highlighted range.
#' @param highlightMax Maximum threshold for highlighted range.
#' @param calculateClinicalImpact Calculate clinical impact metrics (number
#' needed to screen, etc.).
#' @param populationSize Population size for calculating clinical impact
#' metrics.
#' @param showInterventionAvoided Show how many unnecessary interventions are
#' avoided compared to treat-all.
#' @param confidenceIntervals Calculate bootstrap confidence intervals for net
#' benefit curves.
#' @param bootReps Number of bootstrap replications for confidence intervals.
#' @param ciLevel Confidence level for bootstrap confidence intervals.
#' @param showOptimalThreshold Identify and display optimal threshold
#' probabilities for each model.
#' @param compareModels Calculate statistical tests for comparing model
#' performance.
#' @param weightedAUC Calculate weighted area under the decision curve.
#' @return A results object containing:
#' \tabular{llllll}{
#' \code{results$instructions} \tab \tab \tab \tab \tab a html \cr
#' \code{results$procedureNotes} \tab \tab \tab \tab \tab a html \cr
#' \code{results$resultsTable} \tab \tab \tab \tab \tab a table \cr
#' \code{results$optimalTable} \tab \tab \tab \tab \tab a table \cr
#' \code{results$clinicalImpactTable} \tab \tab \tab \tab \tab a table \cr
#' \code{results$comparisonTable} \tab \tab \tab \tab \tab a table \cr
#' \code{results$weightedAUCTable} \tab \tab \tab \tab \tab a table \cr
#' \code{results$dcaPlot} \tab \tab \tab \tab \tab an image \cr
#' \code{results$clinicalImpactPlot} \tab \tab \tab \tab \tab an image \cr
#' \code{results$interventionsAvoidedPlot} \tab \tab \tab \tab \tab an image \cr
#' \code{results$summaryText} \tab \tab \tab \tab \tab a html \cr
#' }
#'
#' Tables can be converted to data frames with \code{asDF} or \code{\link{as.data.frame}}. For example:
#'
#' \code{results$resultsTable$asDF}
#'
#' \code{as.data.frame(results$resultsTable)}
#'
#' @export
decisioncurve <- function(
data,
outcome,
outcomePositive,
models,
modelNames = "",
thresholdRange = "clinical",
thresholdMin = 0.05,
thresholdMax = 0.5,
thresholdStep = 0.01,
showTable = TRUE,
selectedThresholds = "0.05, 0.10, 0.15, 0.20, 0.25, 0.30",
showPlot = TRUE,
plotStyle = "standard",
showReferenceLinesLabels = TRUE,
highlightRange = FALSE,
highlightMin = 0.1,
highlightMax = 0.3,
calculateClinicalImpact = FALSE,
populationSize = 1000,
showInterventionAvoided = FALSE,
confidenceIntervals = FALSE,
bootReps = 1000,
ciLevel = 0.95,
showOptimalThreshold = TRUE,
compareModels = FALSE,
weightedAUC = FALSE) {
if ( ! requireNamespace("jmvcore", quietly=TRUE))
stop("decisioncurve requires jmvcore to be installed (restart may be required)")
if ( ! missing(outcome)) outcome <- jmvcore::resolveQuo(jmvcore::enquo(outcome))
if ( ! missing(models)) models <- jmvcore::resolveQuo(jmvcore::enquo(models))
if (missing(data))
data <- jmvcore::marshalData(
parent.frame(),
`if`( ! missing(outcome), outcome, NULL),
`if`( ! missing(models), models, NULL))
for (v in outcome) if (v %in% names(data)) data[[v]] <- as.factor(data[[v]])
options <- decisioncurveOptions$new(
outcome = outcome,
outcomePositive = outcomePositive,
models = models,
modelNames = modelNames,
thresholdRange = thresholdRange,
thresholdMin = thresholdMin,
thresholdMax = thresholdMax,
thresholdStep = thresholdStep,
showTable = showTable,
selectedThresholds = selectedThresholds,
showPlot = showPlot,
plotStyle = plotStyle,
showReferenceLinesLabels = showReferenceLinesLabels,
highlightRange = highlightRange,
highlightMin = highlightMin,
highlightMax = highlightMax,
calculateClinicalImpact = calculateClinicalImpact,
populationSize = populationSize,
showInterventionAvoided = showInterventionAvoided,
confidenceIntervals = confidenceIntervals,
bootReps = bootReps,
ciLevel = ciLevel,
showOptimalThreshold = showOptimalThreshold,
compareModels = compareModels,
weightedAUC = weightedAUC)
analysis <- decisioncurveClass$new(
options = options,
data = data)
analysis$run()
analysis$results
}
sbalci/ClinicoPathJamoviModule documentation built on June 13, 2025, 9:34 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions decisioncurve
Documented in decisioncurve
# This file is automatically generated, you probably don't want to edit this
decisioncurveOptions <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
"decisioncurveOptions",
inherit = jmvcore::Options,
public = list(
initialize = function(
outcome = NULL,
outcomePositive = NULL,
models = NULL,
modelNames = "",
thresholdRange = "clinical",
thresholdMin = 0.05,
thresholdMax = 0.5,
thresholdStep = 0.01,
showTable = TRUE,
selectedThresholds = "0.05, 0.10, 0.15, 0.20, 0.25, 0.30",
showPlot = TRUE,
plotStyle = "standard",
showReferenceLinesLabels = TRUE,
highlightRange = FALSE,
highlightMin = 0.1,
highlightMax = 0.3,
calculateClinicalImpact = FALSE,
populationSize = 1000,
showInterventionAvoided = FALSE,
confidenceIntervals = FALSE,
bootReps = 1000,
ciLevel = 0.95,
showOptimalThreshold = TRUE,
compareModels = FALSE,
weightedAUC = FALSE, ...) {
super$initialize(
package="ClinicoPath",
name="decisioncurve",
requiresData=TRUE,
...)
private$..outcome <- jmvcore::OptionVariable$new(
"outcome",
outcome,
suggested=list(
"nominal"),
permitted=list(
"factor"))
private$..outcomePositive <- jmvcore::OptionLevel$new(
"outcomePositive",
outcomePositive,
variable="(outcome)")
private$..models <- jmvcore::OptionVariables$new(
"models",
models,
suggested=list(
"continuous"),
permitted=list(
"numeric",
"factor"))
private$..modelNames <- jmvcore::OptionString$new(
"modelNames",
modelNames,
default="")
private$..thresholdRange <- jmvcore::OptionList$new(
"thresholdRange",
thresholdRange,
options=list(
"auto",
"clinical",
"custom"),
default="clinical")
private$..thresholdMin <- jmvcore::OptionNumber$new(
"thresholdMin",
thresholdMin,
default=0.05,
min=0.001,
max=0.999)
private$..thresholdMax <- jmvcore::OptionNumber$new(
"thresholdMax",
thresholdMax,
default=0.5,
min=0.001,
max=0.999)
private$..thresholdStep <- jmvcore::OptionNumber$new(
"thresholdStep",
thresholdStep,
default=0.01,
min=0.001,
max=0.1)
private$..showTable <- jmvcore::OptionBool$new(
"showTable",
showTable,
default=TRUE)
private$..selectedThresholds <- jmvcore::OptionString$new(
"selectedThresholds",
selectedThresholds,
default="0.05, 0.10, 0.15, 0.20, 0.25, 0.30")
private$..showPlot <- jmvcore::OptionBool$new(
"showPlot",
showPlot,
default=TRUE)
private$..plotStyle <- jmvcore::OptionList$new(
"plotStyle",
plotStyle,
options=list(
"standard",
"clean",
"detailed"),
default="standard")
private$..showReferenceLinesLabels <- jmvcore::OptionBool$new(
"showReferenceLinesLabels",
showReferenceLinesLabels,
default=TRUE)
private$..highlightRange <- jmvcore::OptionBool$new(
"highlightRange",
highlightRange,
default=FALSE)
private$..highlightMin <- jmvcore::OptionNumber$new(
"highlightMin",
highlightMin,
default=0.1,
min=0.001,
max=0.999)
private$..highlightMax <- jmvcore::OptionNumber$new(
"highlightMax",
highlightMax,
default=0.3,
min=0.001,
max=0.999)
private$..calculateClinicalImpact <- jmvcore::OptionBool$new(
"calculateClinicalImpact",
calculateClinicalImpact,
default=FALSE)
private$..populationSize <- jmvcore::OptionNumber$new(
"populationSize",
populationSize,
default=1000,
min=100,
max=1000000)
private$..showInterventionAvoided <- jmvcore::OptionBool$new(
"showInterventionAvoided",
showInterventionAvoided,
default=FALSE)
private$..confidenceIntervals <- jmvcore::OptionBool$new(
"confidenceIntervals",
confidenceIntervals,
default=FALSE)
private$..bootReps <- jmvcore::OptionNumber$new(
"bootReps",
bootReps,
default=1000,
min=100,
max=10000)
private$..ciLevel <- jmvcore::OptionNumber$new(
"ciLevel",
ciLevel,
default=0.95,
min=0.8,
max=0.99)
private$..showOptimalThreshold <- jmvcore::OptionBool$new(
"showOptimalThreshold",
showOptimalThreshold,
default=TRUE)
private$..compareModels <- jmvcore::OptionBool$new(
"compareModels",
compareModels,
default=FALSE)
private$..weightedAUC <- jmvcore::OptionBool$new(
"weightedAUC",
weightedAUC,
default=FALSE)
self$.addOption(private$..outcome)
self$.addOption(private$..outcomePositive)
self$.addOption(private$..models)
self$.addOption(private$..modelNames)
self$.addOption(private$..thresholdRange)
self$.addOption(private$..thresholdMin)
self$.addOption(private$..thresholdMax)
self$.addOption(private$..thresholdStep)
self$.addOption(private$..showTable)
self$.addOption(private$..selectedThresholds)
self$.addOption(private$..showPlot)
self$.addOption(private$..plotStyle)
self$.addOption(private$..showReferenceLinesLabels)
self$.addOption(private$..highlightRange)
self$.addOption(private$..highlightMin)
self$.addOption(private$..highlightMax)
self$.addOption(private$..calculateClinicalImpact)
self$.addOption(private$..populationSize)
self$.addOption(private$..showInterventionAvoided)
self$.addOption(private$..confidenceIntervals)
self$.addOption(private$..bootReps)
self$.addOption(private$..ciLevel)
self$.addOption(private$..showOptimalThreshold)
self$.addOption(private$..compareModels)
self$.addOption(private$..weightedAUC)
}),
active = list(
outcome = function() private$..outcome$value,
outcomePositive = function() private$..outcomePositive$value,
models = function() private$..models$value,
modelNames = function() private$..modelNames$value,
thresholdRange = function() private$..thresholdRange$value,
thresholdMin = function() private$..thresholdMin$value,
thresholdMax = function() private$..thresholdMax$value,
thresholdStep = function() private$..thresholdStep$value,
showTable = function() private$..showTable$value,
selectedThresholds = function() private$..selectedThresholds$value,
showPlot = function() private$..showPlot$value,
plotStyle = function() private$..plotStyle$value,
showReferenceLinesLabels = function() private$..showReferenceLinesLabels$value,
highlightRange = function() private$..highlightRange$value,
highlightMin = function() private$..highlightMin$value,
highlightMax = function() private$..highlightMax$value,
calculateClinicalImpact = function() private$..calculateClinicalImpact$value,
populationSize = function() private$..populationSize$value,
showInterventionAvoided = function() private$..showInterventionAvoided$value,
confidenceIntervals = function() private$..confidenceIntervals$value,
bootReps = function() private$..bootReps$value,
ciLevel = function() private$..ciLevel$value,
showOptimalThreshold = function() private$..showOptimalThreshold$value,
compareModels = function() private$..compareModels$value,
weightedAUC = function() private$..weightedAUC$value),
private = list(
..outcome = NA,
..outcomePositive = NA,
..models = NA,
..modelNames = NA,
..thresholdRange = NA,
..thresholdMin = NA,
..thresholdMax = NA,
..thresholdStep = NA,
..showTable = NA,
..selectedThresholds = NA,
..showPlot = NA,
..plotStyle = NA,
..showReferenceLinesLabels = NA,
..highlightRange = NA,
..highlightMin = NA,
..highlightMax = NA,
..calculateClinicalImpact = NA,
..populationSize = NA,
..showInterventionAvoided = NA,
..confidenceIntervals = NA,
..bootReps = NA,
..ciLevel = NA,
..showOptimalThreshold = NA,
..compareModels = NA,
..weightedAUC = NA)
)
decisioncurveResults <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
"decisioncurveResults",
inherit = jmvcore::Group,
active = list(
instructions = function() private$.items[["instructions"]],
procedureNotes = function() private$.items[["procedureNotes"]],
resultsTable = function() private$.items[["resultsTable"]],
optimalTable = function() private$.items[["optimalTable"]],
clinicalImpactTable = function() private$.items[["clinicalImpactTable"]],
comparisonTable = function() private$.items[["comparisonTable"]],
weightedAUCTable = function() private$.items[["weightedAUCTable"]],
dcaPlot = function() private$.items[["dcaPlot"]],
clinicalImpactPlot = function() private$.items[["clinicalImpactPlot"]],
interventionsAvoidedPlot = function() private$.items[["interventionsAvoidedPlot"]],
summaryText = function() private$.items[["summaryText"]]),
private = list(),
public=list(
initialize=function(options) {
super$initialize(
options=options,
name="",
title="Decision Curve Analysis",
refs=list(
"DecisionCurve",
"rmda",
"ggplot2",
"dplyr",
"ClinicoPathJamoviModule"))
self$add(jmvcore::Html$new(
options=options,
name="instructions",
title="Instructions",
visible=TRUE))
self$add(jmvcore::Html$new(
options=options,
name="procedureNotes",
title="Analysis Summary",
visible=TRUE))
self$add(jmvcore::Table$new(
options=options,
name="resultsTable",
title="Net Benefit at Selected Thresholds",
visible="(showTable)",
rows=0,
columns=list(
list(
`name`="threshold",
`title`="Threshold Probability",
`type`="number",
`format`="pc"),
list(
`name`="treat_all",
`title`="Treat All",
`type`="number",
`format`="zto"),
list(
`name`="treat_none",
`title`="Treat None",
`type`="number",
`format`="zto")),
clearWith=list(
"outcome",
"outcomePositive",
"models",
"thresholdRange",
"thresholdMin",
"thresholdMax",
"selectedThresholds")))
self$add(jmvcore::Table$new(
options=options,
name="optimalTable",
title="Optimal Thresholds",
visible="(showOptimalThreshold)",
rows=0,
columns=list(
list(
`name`="model",
`title`="Model",
`type`="text"),
list(
`name`="optimal_threshold",
`title`="Optimal Threshold",
`type`="number",
`format`="pc"),
list(
`name`="max_net_benefit",
`title`="Maximum Net Benefit",
`type`="number",
`format`="zto"),
list(
`name`="threshold_range_start",
`title`="Beneficial Range Start",
`type`="number",
`format`="pc"),
list(
`name`="threshold_range_end",
`title`="Beneficial Range End",
`type`="number",
`format`="pc")),
clearWith=list(
"outcome",
"outcomePositive",
"models",
"thresholdRange",
"thresholdMin",
"thresholdMax")))
self$add(jmvcore::Table$new(
options=options,
name="clinicalImpactTable",
title="Clinical Impact Analysis",
visible="(calculateClinicalImpact)",
rows=0,
columns=list(
list(
`name`="model",
`title`="Model",
`type`="text"),
list(
`name`="threshold",
`title`="Threshold",
`type`="number",
`format`="pc"),
list(
`name`="interventions_per_100",
`title`="Interventions per 100",
`type`="number",
`format`="zto"),
list(
`name`="true_positives_per_100",
`title`="True Positives per 100",
`type`="number",
`format`="zto"),
list(
`name`="false_positives_per_100",
`title`="False Positives per 100",
`type`="number",
`format`="zto"),
list(
`name`="interventions_avoided",
`title`="Interventions Avoided vs Treat All",
`type`="number",
`format`="zto"),
list(
`name`="number_needed_to_screen",
`title`="Number Needed to Screen",
`type`="number",
`format`="zto")),
clearWith=list(
"outcome",
"outcomePositive",
"models",
"populationSize",
"selectedThresholds")))
self$add(jmvcore::Table$new(
options=options,
name="comparisonTable",
title="Model Comparison",
visible="(compareModels)",
rows=0,
columns=list(
list(
`name`="comparison",
`title`="Comparison",
`type`="text"),
list(
`name`="weighted_auc_diff",
`title`="Weighted AUC Difference",
`type`="number",
`format`="zto"),
list(
`name`="ci_lower",
`title`="95% CI Lower",
`type`="number",
`format`="zto"),
list(
`name`="ci_upper",
`title`="95% CI Upper",
`type`="number",
`format`="zto"),
list(
`name`="p_value",
`title`="P-value",
`type`="number",
`format`="zto,pvalue")),
clearWith=list(
"outcome",
"outcomePositive",
"models",
"compareModels")))
self$add(jmvcore::Table$new(
options=options,
name="weightedAUCTable",
title="Weighted Area Under Decision Curve",
visible="(weightedAUC)",
rows=0,
columns=list(
list(
`name`="model",
`title`="Model",
`type`="text"),
list(
`name`="weighted_auc",
`title`="Weighted AUC",
`type`="number",
`format`="zto"),
list(
`name`="auc_range",
`title`="Threshold Range",
`type`="text"),
list(
`name`="relative_benefit",
`title`="Relative Benefit vs Treat All",
`type`="number",
`format`="pc")),
clearWith=list(
"outcome",
"outcomePositive",
"models",
"thresholdRange",
"thresholdMin",
"thresholdMax")))
self$add(jmvcore::Image$new(
options=options,
name="dcaPlot",
title="Decision Curve Analysis",
width=700,
height=500,
renderFun=".plotDCA",
visible="(showPlot)",
clearWith=list(
"outcome",
"outcomePositive",
"models",
"thresholdRange",
"thresholdMin",
"thresholdMax",
"thresholdStep",
"plotStyle",
"showReferenceLinesLabels",
"highlightRange",
"confidenceIntervals")))
self$add(jmvcore::Image$new(
options=options,
name="clinicalImpactPlot",
title="Clinical Impact",
width=700,
height=500,
renderFun=".plotClinicalImpact",
visible="(calculateClinicalImpact && showPlot)",
clearWith=list(
"outcome",
"outcomePositive",
"models",
"populationSize",
"thresholdRange",
"thresholdMin",
"thresholdMax")))
self$add(jmvcore::Image$new(
options=options,
name="interventionsAvoidedPlot",
title="Interventions Avoided",
width=700,
height=500,
renderFun=".plotInterventionsAvoided",
visible="(showInterventionAvoided && showPlot)",
clearWith=list(
"outcome",
"outcomePositive",
"models",
"thresholdRange",
"thresholdMin",
"thresholdMax")))
self$add(jmvcore::Html$new(
options=options,
name="summaryText",
title="Clinical Interpretation",
visible=TRUE,
clearWith=list(
"outcome",
"outcomePositive",
"models",
"thresholdRange",
"thresholdMin",
"thresholdMax")))}))
decisioncurveBase <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
"decisioncurveBase",
inherit = jmvcore::Analysis,
public = list(
initialize = function(options, data=NULL, datasetId="", analysisId="", revision=0) {
super$initialize(
package = "ClinicoPath",
name = "decisioncurve",
version = c(0,0,3),
options = options,
results = decisioncurveResults$new(options=options),
data = data,
datasetId = datasetId,
analysisId = analysisId,
revision = revision,
pause = NULL,
completeWhenFilled = FALSE,
requiresMissings = FALSE,
weightsSupport = 'auto')
}))
#' Decision Curve Analysis
#'
#' Decision Curve Analysis for evaluating the clinical utility of prediction
#' models and diagnostic tests. Calculates net benefit across threshold
#' probabilities to determine if using a model provides more benefit than
#' default strategies.
#'
#'
#' @examples
#' \donttest{
#' # example will be added
#'}
#' @param data The data as a data frame.
#' @param outcome Binary outcome variable (0/1 or FALSE/TRUE). This represents
#' the condition or event you want to predict.
#' @param outcomePositive Which level of the outcome variable represents the
#' positive case (presence of condition/event).
#' @param models Variables representing predicted probabilities or risk scores
#' from different models. Can include multiple models for comparison.
#' @param modelNames Optional comma-separated list of names for the models. If
#' not provided, variable names will be used.
#' @param thresholdRange Range of threshold probabilities to evaluate.
#' @param thresholdMin Minimum threshold probability when using custom range.
#' @param thresholdMax Maximum threshold probability when using custom range.
#' @param thresholdStep Step size between threshold probabilities.
#' @param showTable Display table with net benefit values at selected
#' thresholds.
#' @param selectedThresholds Comma-separated list of threshold probabilities
#' to display in table.
#' @param showPlot Display the decision curve plot.
#' @param plotStyle Style of the decision curve plot.
#' @param showReferenceLinesLabels Show labels for "Treat All" and "Treat
#' None" reference lines.
#' @param highlightRange Highlight a clinically relevant threshold range on
#' the plot.
#' @param highlightMin Minimum threshold for highlighted range.
#' @param highlightMax Maximum threshold for highlighted range.
#' @param calculateClinicalImpact Calculate clinical impact metrics (number
#' needed to screen, etc.).
#' @param populationSize Population size for calculating clinical impact
#' metrics.
#' @param showInterventionAvoided Show how many unnecessary interventions are
#' avoided compared to treat-all.
#' @param confidenceIntervals Calculate bootstrap confidence intervals for net
#' benefit curves.
#' @param bootReps Number of bootstrap replications for confidence intervals.
#' @param ciLevel Confidence level for bootstrap confidence intervals.
#' @param showOptimalThreshold Identify and display optimal threshold
#' probabilities for each model.
#' @param compareModels Calculate statistical tests for comparing model
#' performance.
#' @param weightedAUC Calculate weighted area under the decision curve.
#' @return A results object containing:
#' \tabular{llllll}{
#' \code{results$instructions} \tab \tab \tab \tab \tab a html \cr
#' \code{results$procedureNotes} \tab \tab \tab \tab \tab a html \cr
#' \code{results$resultsTable} \tab \tab \tab \tab \tab a table \cr
#' \code{results$optimalTable} \tab \tab \tab \tab \tab a table \cr
#' \code{results$clinicalImpactTable} \tab \tab \tab \tab \tab a table \cr
#' \code{results$comparisonTable} \tab \tab \tab \tab \tab a table \cr
#' \code{results$weightedAUCTable} \tab \tab \tab \tab \tab a table \cr
#' \code{results$dcaPlot} \tab \tab \tab \tab \tab an image \cr
#' \code{results$clinicalImpactPlot} \tab \tab \tab \tab \tab an image \cr
#' \code{results$interventionsAvoidedPlot} \tab \tab \tab \tab \tab an image \cr
#' \code{results$summaryText} \tab \tab \tab \tab \tab a html \cr
#' }
#'
#' Tables can be converted to data frames with \code{asDF} or \code{\link{as.data.frame}}. For example:
#'
#' \code{results$resultsTable$asDF}
#'
#' \code{as.data.frame(results$resultsTable)}
#'
#' @export
decisioncurve <- function(
data,
outcome,
outcomePositive,
models,
modelNames = "",
thresholdRange = "clinical",
thresholdMin = 0.05,
thresholdMax = 0.5,
thresholdStep = 0.01,
showTable = TRUE,
selectedThresholds = "0.05, 0.10, 0.15, 0.20, 0.25, 0.30",
showPlot = TRUE,
plotStyle = "standard",
showReferenceLinesLabels = TRUE,
highlightRange = FALSE,
highlightMin = 0.1,
highlightMax = 0.3,
calculateClinicalImpact = FALSE,
populationSize = 1000,
showInterventionAvoided = FALSE,
confidenceIntervals = FALSE,
bootReps = 1000,
ciLevel = 0.95,
showOptimalThreshold = TRUE,
compareModels = FALSE,
weightedAUC = FALSE) {
if ( ! requireNamespace("jmvcore", quietly=TRUE))
stop("decisioncurve requires jmvcore to be installed (restart may be required)")
if ( ! missing(outcome)) outcome <- jmvcore::resolveQuo(jmvcore::enquo(outcome))
if ( ! missing(models)) models <- jmvcore::resolveQuo(jmvcore::enquo(models))
if (missing(data))
data <- jmvcore::marshalData(
parent.frame(),
`if`( ! missing(outcome), outcome, NULL),
`if`( ! missing(models), models, NULL))
for (v in outcome) if (v %in% names(data)) data[[v]] <- as.factor(data[[v]])
options <- decisioncurveOptions$new(
outcome = outcome,
outcomePositive = outcomePositive,
models = models,
modelNames = modelNames,
thresholdRange = thresholdRange,
thresholdMin = thresholdMin,
thresholdMax = thresholdMax,
thresholdStep = thresholdStep,
showTable = showTable,
selectedThresholds = selectedThresholds,
showPlot = showPlot,
plotStyle = plotStyle,
showReferenceLinesLabels = showReferenceLinesLabels,
highlightRange = highlightRange,
highlightMin = highlightMin,
highlightMax = highlightMax,
calculateClinicalImpact = calculateClinicalImpact,
populationSize = populationSize,
showInterventionAvoided = showInterventionAvoided,
confidenceIntervals = confidenceIntervals,
bootReps = bootReps,
ciLevel = ciLevel,
showOptimalThreshold = showOptimalThreshold,
compareModels = compareModels,
weightedAUC = weightedAUC)
analysis <- decisioncurveClass$new(
options = options,
data = data)
analysis$run()
analysis$results
}
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.