inst/doc/predictNMB.R

In predictNMB: Evaluate Clinical Prediction Models by Net Monetary Benefit

## ---- include = FALSE---------------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  fig.width = 7,
  fig.height = 5
)

## ----setup--------------------------------------------------------------------
library(predictNMB)
library(parallel)
set.seed(42)

## -----------------------------------------------------------------------------
nmb_sampler <- get_nmb_sampler(
  wtp = 28033,
  qalys_lost = function() rnorm(n = 1, mean = 0.0036, sd = 0.0005),
  high_risk_group_treatment_cost = function() rnorm(n = 1, mean = 20, sd = 3),
  high_risk_group_treatment_effect = function() rbeta(n = 1, shape1 = 40, shape2 = 60)
)

rbind(nmb_sampler(), nmb_sampler(), nmb_sampler())



## -----------------------------------------------------------------------------
nmb_sampler_training <- get_nmb_sampler(
  wtp = 28033,
  qalys_lost = function() rnorm(n = 1, mean = 0.0036, sd = 0.0007),
  high_risk_group_treatment_cost = rnorm(n = 1, mean = 20, sd = 5),
  high_risk_group_treatment_effect = function() rbeta(n = 1, shape1 = 40, shape2 = 60),
  use_expected_values = TRUE
)
rbind(nmb_sampler_training(), nmb_sampler_training(), nmb_sampler_training())


## ---- echo=FALSE--------------------------------------------------------------
nmb_simulation <- readRDS("fixtures/predictNMB-nmb_simulation.rds")

## ---- eval=FALSE--------------------------------------------------------------
#  nmb_simulation <- do_nmb_sim(
#    sample_size = 1000,
#    n_sims = 500,
#    n_valid = 10000,
#    sim_auc = 0.7,
#    event_rate = 0.1,
#    fx_nmb_training = nmb_sampler_training,
#    fx_nmb_evaluation = nmb_sampler,
#    show_progress = TRUE
#  )

## -----------------------------------------------------------------------------
nmb_simulation

## -----------------------------------------------------------------------------
hist(
  nmb_simulation$df_result$all, 
  main = "Simulation results - treat all", 
  xlab = "Net monetary benefit (NMB)"
)

summary(nmb_simulation$df_result$all)

## -----------------------------------------------------------------------------
autoplot(nmb_simulation) + theme_sim()

## -----------------------------------------------------------------------------
get_inbuilt_cutpoint_methods()

autoplot(nmb_simulation, methods_order = c("all", "none", "youden")) + theme_sim()

## -----------------------------------------------------------------------------
autoplot(nmb_simulation, what = "cutpoints") + theme_sim()

## -----------------------------------------------------------------------------
autoplot(nmb_simulation, what = "inb", inb_ref_col = "all") + theme_sim()

## -----------------------------------------------------------------------------
head(nmb_simulation$df_result)

## -----------------------------------------------------------------------------
head(nmb_simulation$df_thresholds)

## -----------------------------------------------------------------------------
ce_plot(nmb_simulation, ref_col = "all", methods_order = c("all", "none", "youden"))

## ---- echo=FALSE--------------------------------------------------------------
sim_screen_obj <- readRDS("fixtures/predictNMB-sim_screen_obj.rds")

## ---- eval=FALSE--------------------------------------------------------------
#  cl <- makeCluster(2)
#  sim_screen_obj <- screen_simulation_inputs(
#    n_sims = 500,
#    n_valid = 10000,
#    sim_auc = seq(0.7, 0.95, 0.05),
#    event_rate = c(0.1, 0.2),
#    fx_nmb_training = nmb_sampler_training,
#    fx_nmb_evaluation = nmb_sampler,
#    cutpoint_methods = c("all", "none", "youden", "value_optimising"),
#    cl = cl
#  )
#  stopCluster(cl)

## -----------------------------------------------------------------------------
autoplot(sim_screen_obj, x_axis_var = "sim_auc", constants = c(event_rate = 0.2))
autoplot(sim_screen_obj, x_axis_var = "sim_auc", constants = c(event_rate = 0.1))