R/decision.h.R
# This file is automatically generated, you probably don't want to edit this
decisionOptions <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
"decisionOptions",
inherit = jmvcore::Options,
public = list(
initialize = function(
gold = NULL,
goldPositive = NULL,
newtest = NULL,
testPositive = NULL,
pp = FALSE,
pprob = 0.3,
od = FALSE,
fnote = FALSE,
ci = FALSE,
fagan = FALSE, ...) {
super$initialize(
package="ClinicoPath",
name="decision",
requiresData=TRUE,
...)
private$..gold <- jmvcore::OptionVariable$new(
"gold",
gold,
suggested=list(
"nominal"),
permitted=list(
"factor"))
private$..goldPositive <- jmvcore::OptionLevel$new(
"goldPositive",
goldPositive,
variable="(gold)")
private$..newtest <- jmvcore::OptionVariable$new(
"newtest",
newtest,
suggested=list(
"nominal"),
permitted=list(
"factor"))
private$..testPositive <- jmvcore::OptionLevel$new(
"testPositive",
testPositive,
variable="(newtest)")
private$..pp <- jmvcore::OptionBool$new(
"pp",
pp,
default=FALSE)
private$..pprob <- jmvcore::OptionNumber$new(
"pprob",
pprob,
default=0.3,
min=0.001,
max=0.999)
private$..od <- jmvcore::OptionBool$new(
"od",
od,
default=FALSE)
private$..fnote <- jmvcore::OptionBool$new(
"fnote",
fnote,
default=FALSE)
private$..ci <- jmvcore::OptionBool$new(
"ci",
ci,
default=FALSE)
private$..fagan <- jmvcore::OptionBool$new(
"fagan",
fagan,
default=FALSE)
self$.addOption(private$..gold)
self$.addOption(private$..goldPositive)
self$.addOption(private$..newtest)
self$.addOption(private$..testPositive)
self$.addOption(private$..pp)
self$.addOption(private$..pprob)
self$.addOption(private$..od)
self$.addOption(private$..fnote)
self$.addOption(private$..ci)
self$.addOption(private$..fagan)
}),
active = list(
gold = function() private$..gold$value,
goldPositive = function() private$..goldPositive$value,
newtest = function() private$..newtest$value,
testPositive = function() private$..testPositive$value,
pp = function() private$..pp$value,
pprob = function() private$..pprob$value,
od = function() private$..od$value,
fnote = function() private$..fnote$value,
ci = function() private$..ci$value,
fagan = function() private$..fagan$value),
private = list(
..gold = NA,
..goldPositive = NA,
..newtest = NA,
..testPositive = NA,
..pp = NA,
..pprob = NA,
..od = NA,
..fnote = NA,
..ci = NA,
..fagan = NA)
)
decisionResults <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
"decisionResults",
inherit = jmvcore::Group,
active = list(
text1 = function() private$.items[["text1"]],
text2 = function() private$.items[["text2"]],
cTable = function() private$.items[["cTable"]],
nTable = function() private$.items[["nTable"]],
ratioTable = function() private$.items[["ratioTable"]],
epirTable_ratio = function() private$.items[["epirTable_ratio"]],
epirTable_number = function() private$.items[["epirTable_number"]],
plot1 = function() private$.items[["plot1"]]),
private = list(),
public=list(
initialize=function(options) {
super$initialize(
options=options,
name="",
title="Medical Decision",
refs=list(
"DiagnosticTests",
"ClinicoPathJamoviModule"))
self$add(jmvcore::Preformatted$new(
options=options,
name="text1",
title="Original Data",
visible="(od)"))
self$add(jmvcore::Html$new(
options=options,
name="text2",
title="Original Data",
visible="(od)"))
self$add(jmvcore::Table$new(
options=options,
name="cTable",
title="Recoded Data for Decision Test Statistics",
rows=0,
columns=list(
list(
`name`="newtest",
`title`="",
`type`="text"),
list(
`name`="GP",
`title`="Gold Positive",
`type`="number"),
list(
`name`="GN",
`title`="Gold Negative",
`type`="number"),
list(
`name`="Total",
`title`="Total",
`type`="number"))))
self$add(jmvcore::Table$new(
options=options,
name="nTable",
title="",
swapRowsColumns=TRUE,
rows=1,
columns=list(
list(
`name`="tablename",
`title`="",
`type`="text"),
list(
`name`="TotalPop",
`title`="Total",
`type`="number"),
list(
`name`="DiseaseP",
`title`="Diseased",
`type`="number"),
list(
`name`="DiseaseN",
`title`="Healthy",
`type`="number"),
list(
`name`="TestP",
`title`="Positive Tests",
`type`="number"),
list(
`name`="TestN",
`title`="Negative Tests",
`type`="number"),
list(
`name`="TestT",
`title`="True Test",
`type`="number"),
list(
`name`="TestW",
`title`="Wrong Test",
`type`="number")),
clearWith=list(
"pp",
"pprob")))
self$add(jmvcore::Table$new(
options=options,
name="ratioTable",
title="",
swapRowsColumns=TRUE,
rows=1,
columns=list(
list(
`name`="tablename",
`title`="",
`type`="text"),
list(
`name`="Sens",
`title`="Sensitivity",
`type`="number",
`format`="pc"),
list(
`name`="Spec",
`title`="Specificity",
`type`="number",
`format`="pc"),
list(
`name`="AccurT",
`title`="Accuracy",
`type`="number",
`format`="pc"),
list(
`name`="PrevalenceD",
`title`="Prevalence",
`type`="number",
`format`="pc"),
list(
`name`="PPV",
`title`="Positive Predictive Value",
`type`="number",
`format`="pc"),
list(
`name`="NPV",
`title`="Negative Predictive Value",
`type`="number",
`format`="pc"),
list(
`name`="PostTestProbDisease",
`title`="Post-test Disease Probability",
`type`="number",
`format`="pc"),
list(
`name`="PostTestProbHealthy",
`title`="Post-test Health Probability",
`type`="number",
`format`="pc"),
list(
`name`="LRP",
`title`="Positive Likelihood Ratio",
`type`="number"),
list(
`name`="LRN",
`title`="Negative Likelihood Ratio",
`type`="number")),
clearWith=list(
"pp",
"pprob")))
self$add(jmvcore::Table$new(
options=options,
name="epirTable_ratio",
title="",
visible="(ci)",
rows=0,
columns=list(
list(
`name`="statsnames",
`title`="Decision Statistics",
`type`="text"),
list(
`name`="est",
`title`="Estimate",
`type`="number",
`format`="pc"),
list(
`name`="lower",
`title`="Lower",
`superTitle`="95% Confidence Interval",
`type`="number",
`format`="pc"),
list(
`name`="upper",
`title`="Upper",
`superTitle`="95% Confidence Interval",
`type`="number",
`format`="pc")),
clearWith=list(
"pp",
"pprob"),
refs="epiR"))
self$add(jmvcore::Table$new(
options=options,
name="epirTable_number",
title="",
visible="(ci)",
rows=0,
columns=list(
list(
`name`="statsnames",
`title`="Decision Statistics",
`type`="text"),
list(
`name`="est",
`title`="Estimate",
`type`="number"),
list(
`name`="lower",
`title`="Lower",
`superTitle`="95% Confidence Interval",
`type`="number"),
list(
`name`="upper",
`title`="Upper",
`superTitle`="95% Confidence Interval",
`type`="number")),
clearWith=list(
"pp",
"pprob"),
refs="epiR"))
self$add(jmvcore::Image$new(
options=options,
name="plot1",
title="Fagan nomogram",
width=600,
height=450,
renderFun=".plot1",
requiresData=TRUE,
visible="(fagan)",
clearWith=list(
"pp",
"pprob",
"fagan"),
refs=list(
"Fagan",
"Fagan2")))}))
decisionBase <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
"decisionBase",
inherit = jmvcore::Analysis,
public = list(
initialize = function(options, data=NULL, datasetId="", analysisId="", revision=0) {
super$initialize(
package = "ClinicoPath",
name = "decision",
version = c(1,0,0),
options = options,
results = decisionResults$new(options=options),
data = data,
datasetId = datasetId,
analysisId = analysisId,
revision = revision,
pause = NULL,
completeWhenFilled = FALSE,
requiresMissings = FALSE,
weightsSupport = 'auto')
}))
#' Medical Decision
#'
#' Function for Medical Decision Analysis. Sensitivity, specificity, positive
#' predictive value, negative predictive value.
#'
#'
#' @examples
#' \dontrun{
#' # example will be added
#'}
#' @param data The data as a data frame.
#' @param gold .
#' @param goldPositive .
#' @param newtest .
#' @param testPositive .
#' @param pp .
#' @param pprob Prior probability (disease prevalence in the community).
#' Requires a value between 0.001 and 0.999, default 0.300.
#' @param od Boolean selection whether to show frequency table. Default is
#' 'false'.
#' @param fnote .
#' @param ci .
#' @param fagan .
#' @return A results object containing:
#' \tabular{llllll}{
#' \code{results$text1} \tab \tab \tab \tab \tab a preformatted \cr
#' \code{results$text2} \tab \tab \tab \tab \tab a html \cr
#' \code{results$cTable} \tab \tab \tab \tab \tab a table \cr
#' \code{results$nTable} \tab \tab \tab \tab \tab a table \cr
#' \code{results$ratioTable} \tab \tab \tab \tab \tab a table \cr
#' \code{results$epirTable_ratio} \tab \tab \tab \tab \tab a table \cr
#' \code{results$epirTable_number} \tab \tab \tab \tab \tab a table \cr
#' \code{results$plot1} \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$cTable$asDF}
#'
#' \code{as.data.frame(results$cTable)}
#'
#' @export
decision <- function(
data,
gold,
goldPositive,
newtest,
testPositive,
pp = FALSE,
pprob = 0.3,
od = FALSE,
fnote = FALSE,
ci = FALSE,
fagan = FALSE) {
if ( ! requireNamespace("jmvcore", quietly=TRUE))
stop("decision requires jmvcore to be installed (restart may be required)")
if ( ! missing(gold)) gold <- jmvcore::resolveQuo(jmvcore::enquo(gold))
if ( ! missing(newtest)) newtest <- jmvcore::resolveQuo(jmvcore::enquo(newtest))
if (missing(data))
data <- jmvcore::marshalData(
parent.frame(),
`if`( ! missing(gold), gold, NULL),
`if`( ! missing(newtest), newtest, NULL))
for (v in gold) if (v %in% names(data)) data[[v]] <- as.factor(data[[v]])
for (v in newtest) if (v %in% names(data)) data[[v]] <- as.factor(data[[v]])
options <- decisionOptions$new(
gold = gold,
goldPositive = goldPositive,
newtest = newtest,
testPositive = testPositive,
pp = pp,
pprob = pprob,
od = od,
fnote = fnote,
ci = ci,
fagan = fagan)
analysis <- decisionClass$new(
options = options,
data = data)
analysis$run()
analysis$results
}