R/testroc.h.R
# This file is automatically generated, you probably don't want to edit this
TestROCOptions <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
"TestROCOptions",
inherit = jmvcore::Options,
public = list(
initialize = function(
dependentVars = NULL,
classVar = NULL,
subGroup = NULL,
method = "maximize_metric",
allObserved = NULL,
specifyCutScore = "",
metric = NULL,
boot_runs = NULL,
break_ties = NULL,
tol_metric = 0.05,
direction = NULL,
plotROC = TRUE,
combinePlots = TRUE,
displaySE = FALSE,
smoothing = FALSE,
sensSpecTable = FALSE,
delongTest = FALSE,
positiveClass = "", ...) {
super$initialize(
package="ClinicoPath",
name="TestROC",
requiresData=TRUE,
...)
private$..dependentVars <- jmvcore::OptionVariables$new(
"dependentVars",
dependentVars,
suggested=list(
"continuous"),
permitted=list(
"numeric"))
private$..classVar <- jmvcore::OptionVariable$new(
"classVar",
classVar,
suggested=list(
"nominal"),
permitted=list(
"factor"))
private$..subGroup <- jmvcore::OptionVariable$new(
"subGroup",
subGroup,
suggested=list(
"nominal"),
permitted=list(
"factor"))
private$..method <- jmvcore::OptionList$new(
"method",
method,
options=list(
"oc_manual",
"maximize_metric",
"minimize_metric",
"maximize_loess_metric",
"minimize_loess_metric",
"maximize_spline_metric",
"minimize_spline_metric",
"maximize_boot_metric",
"minimize_boot_metric",
"oc_youden_kernel",
"oc_youden_normal"),
default="maximize_metric")
private$..allObserved <- jmvcore::OptionBool$new(
"allObserved",
allObserved)
private$..specifyCutScore <- jmvcore::OptionString$new(
"specifyCutScore",
specifyCutScore,
default="")
private$..metric <- jmvcore::OptionList$new(
"metric",
metric,
options=list(
"sum_sens_spec",
"accuracy",
"youden",
"sum_ppv_npv",
"prod_sens_spec",
"prod_ppv_npv",
"cohens_kappa",
"abs_d_sens_spec",
"roc01",
"abs_d_ppv_npv",
"p_chisquared",
"odds_ratio",
"risk_ratio",
"misclassification_cost",
"total_utility",
"F1_score"))
private$..boot_runs <- jmvcore::OptionNumber$new(
"boot_runs",
boot_runs)
private$..break_ties <- jmvcore::OptionList$new(
"break_ties",
break_ties,
options=list(
"c",
"mean",
"median"))
private$..tol_metric <- jmvcore::OptionNumber$new(
"tol_metric",
tol_metric,
default=0.05)
private$..direction <- jmvcore::OptionList$new(
"direction",
direction,
options=list(
">=",
"<="))
private$..plotROC <- jmvcore::OptionBool$new(
"plotROC",
plotROC,
default=TRUE)
private$..combinePlots <- jmvcore::OptionBool$new(
"combinePlots",
combinePlots,
default=TRUE)
private$..displaySE <- jmvcore::OptionBool$new(
"displaySE",
displaySE,
default=FALSE)
private$..smoothing <- jmvcore::OptionBool$new(
"smoothing",
smoothing,
default=FALSE)
private$..sensSpecTable <- jmvcore::OptionBool$new(
"sensSpecTable",
sensSpecTable,
default=FALSE)
private$..delongTest <- jmvcore::OptionBool$new(
"delongTest",
delongTest,
default=FALSE)
private$..positiveClass <- jmvcore::OptionString$new(
"positiveClass",
positiveClass,
default="")
self$.addOption(private$..dependentVars)
self$.addOption(private$..classVar)
self$.addOption(private$..subGroup)
self$.addOption(private$..method)
self$.addOption(private$..allObserved)
self$.addOption(private$..specifyCutScore)
self$.addOption(private$..metric)
self$.addOption(private$..boot_runs)
self$.addOption(private$..break_ties)
self$.addOption(private$..tol_metric)
self$.addOption(private$..direction)
self$.addOption(private$..plotROC)
self$.addOption(private$..combinePlots)
self$.addOption(private$..displaySE)
self$.addOption(private$..smoothing)
self$.addOption(private$..sensSpecTable)
self$.addOption(private$..delongTest)
self$.addOption(private$..positiveClass)
}),
active = list(
dependentVars = function() private$..dependentVars$value,
classVar = function() private$..classVar$value,
subGroup = function() private$..subGroup$value,
method = function() private$..method$value,
allObserved = function() private$..allObserved$value,
specifyCutScore = function() private$..specifyCutScore$value,
metric = function() private$..metric$value,
boot_runs = function() private$..boot_runs$value,
break_ties = function() private$..break_ties$value,
tol_metric = function() private$..tol_metric$value,
direction = function() private$..direction$value,
plotROC = function() private$..plotROC$value,
combinePlots = function() private$..combinePlots$value,
displaySE = function() private$..displaySE$value,
smoothing = function() private$..smoothing$value,
sensSpecTable = function() private$..sensSpecTable$value,
delongTest = function() private$..delongTest$value,
positiveClass = function() private$..positiveClass$value),
private = list(
..dependentVars = NA,
..classVar = NA,
..subGroup = NA,
..method = NA,
..allObserved = NA,
..specifyCutScore = NA,
..metric = NA,
..boot_runs = NA,
..break_ties = NA,
..tol_metric = NA,
..direction = NA,
..plotROC = NA,
..combinePlots = NA,
..displaySE = NA,
..smoothing = NA,
..sensSpecTable = NA,
..delongTest = NA,
..positiveClass = NA)
)
TestROCResults <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
"TestROCResults",
inherit = jmvcore::Group,
active = list(
instructions = function() private$.items[["instructions"]],
procedureNotes = function() private$.items[["procedureNotes"]],
resultsTable = function() private$.items[["resultsTable"]],
delongTest = function() private$.items[["delongTest"]],
plotROC = function() private$.items[["plotROC"]],
sensSpecTable = function() private$.items[["sensSpecTable"]]),
private = list(),
public=list(
initialize=function(options) {
super$initialize(
options=options,
name="",
title="TestROC")
self$add(jmvcore::Html$new(
options=options,
name="instructions",
visible=TRUE))
self$add(jmvcore::Html$new(
options=options,
name="procedureNotes"))
self$add(jmvcore::Array$new(
options=options,
name="resultsTable",
refs=list(
"cutpointr",
"testROC"),
title="Results Table",
visible=TRUE,
clearWith=list(
"dependentVars",
"classVar",
"subGroup",
"method",
"allObserved",
"specifyCutScore",
"metric",
"boot_runs",
"break_ties",
"tol_metric",
"direction",
"positiveClass"),
template=jmvcore::Table$new(
options=options,
rows=0,
columns=list(
list(
`name`="cutpoint",
`title`="Cutpoint",
`type`="text"),
list(
`name`="sensitivity",
`title`="Sensitivity (%)",
`type`="text"),
list(
`name`="specificity",
`title`="Specificity (%)",
`type`="text"),
list(
`name`="ppv",
`title`="PPV (%)",
`type`="text"),
list(
`name`="npv",
`title`="NPV (%)",
`type`="text"),
list(
`name`="youden",
`title`="Youden's index",
`type`="number"),
list(
`name`="AUC",
`title`="AUC",
`type`="number"),
list(
`name`="metricValue",
`title`="Metric Score",
`type`="number")))))
self$add(jmvcore::Preformatted$new(
options=options,
name="delongTest",
title="DeLong Test of Difference between AUCs",
visible=FALSE,
clearWith=list(
"dependentVars",
"classVar",
"subGroup",
"method",
"allObserved",
"specifyCutScore",
"metric",
"boot_runs",
"break_ties",
"tol_metric",
"direction",
"positiveClass")))
self$add(jmvcore::Array$new(
options=options,
name="plotROC",
title="ROC Curves",
template=jmvcore::Image$new(
options=options,
width=550,
height=450,
renderFun=".plotROC",
visible="(plotROC)")))
self$add(jmvcore::Array$new(
options=options,
name="sensSpecTable",
title="Sensitivity & Specificity",
visible=FALSE,
clearWith=list(
"dependentVars",
"classVar",
"subGroup",
"method",
"allObserved",
"specifyCutScore",
"metric",
"boot_runs",
"break_ties",
"tol_metric",
"direction",
"positiveClass"),
template=jmvcore::Html$new(
options=options)))}))
TestROCBase <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
"TestROCBase",
inherit = jmvcore::Analysis,
public = list(
initialize = function(options, data=NULL, datasetId="", analysisId="", revision=0) {
super$initialize(
package = "ClinicoPath",
name = "TestROC",
version = c(1,0,0),
options = options,
results = TestROCResults$new(options=options),
data = data,
datasetId = datasetId,
analysisId = analysisId,
revision = revision,
pause = NULL,
completeWhenFilled = FALSE,
requiresMissings = FALSE,
weightsSupport = 'auto')
}))
#' Test ROC
#'
#'
#' @param data .
#' @param dependentVars .
#' @param classVar .
#' @param subGroup .
#' @param method .
#' @param allObserved .
#' @param specifyCutScore .
#' @param metric .
#' @param boot_runs .
#' @param break_ties .
#' @param tol_metric .
#' @param direction .
#' @param plotROC .
#' @param combinePlots .
#' @param displaySE .
#' @param smoothing .
#' @param sensSpecTable .
#' @param delongTest .
#' @param positiveClass .
#' @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 an array of tables \cr
#' \code{results$delongTest} \tab \tab \tab \tab \tab a preformatted \cr
#' \code{results$plotROC} \tab \tab \tab \tab \tab an array of images \cr
#' \code{results$sensSpecTable} \tab \tab \tab \tab \tab an array of htmls \cr
#' }
#'
#' @export
TestROC <- function(
data,
dependentVars,
classVar,
subGroup,
method = "maximize_metric",
allObserved,
specifyCutScore = "",
metric,
boot_runs,
break_ties,
tol_metric = 0.05,
direction,
plotROC = TRUE,
combinePlots = TRUE,
displaySE = FALSE,
smoothing = FALSE,
sensSpecTable = FALSE,
delongTest = FALSE,
positiveClass = "") {
if ( ! requireNamespace("jmvcore", quietly=TRUE))
stop("TestROC requires jmvcore to be installed (restart may be required)")
if ( ! missing(dependentVars)) dependentVars <- jmvcore::resolveQuo(jmvcore::enquo(dependentVars))
if ( ! missing(classVar)) classVar <- jmvcore::resolveQuo(jmvcore::enquo(classVar))
if ( ! missing(subGroup)) subGroup <- jmvcore::resolveQuo(jmvcore::enquo(subGroup))
if (missing(data))
data <- jmvcore::marshalData(
parent.frame(),
`if`( ! missing(dependentVars), dependentVars, NULL),
`if`( ! missing(classVar), classVar, NULL),
`if`( ! missing(subGroup), subGroup, NULL))
for (v in classVar) if (v %in% names(data)) data[[v]] <- as.factor(data[[v]])
for (v in subGroup) if (v %in% names(data)) data[[v]] <- as.factor(data[[v]])
options <- TestROCOptions$new(
dependentVars = dependentVars,
classVar = classVar,
subGroup = subGroup,
method = method,
allObserved = allObserved,
specifyCutScore = specifyCutScore,
metric = metric,
boot_runs = boot_runs,
break_ties = break_ties,
tol_metric = tol_metric,
direction = direction,
plotROC = plotROC,
combinePlots = combinePlots,
displaySE = displaySE,
smoothing = smoothing,
sensSpecTable = sensSpecTable,
delongTest = delongTest,
positiveClass = positiveClass)
analysis <- TestROCClass$new(
options = options,
data = data)
analysis$run()
analysis$results
}