inst/doc/ccostrSimulation.R

In ccostr: Estimation of Mean Costs in Censored Data

## ----setup, include = FALSE----------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)

## ----echo=TRUE, message=FALSE, warning=FALSE-----------------------------
library(ccostr)
library(ggplot2)
library(knitr)
library(parallel)
library(msm)

## ------------------------------------------------------------------------
set.seed(123)
sim <- simCostData(n = 1000, dist = "unif", censor = "light", cdist = "exp", L = 10)
est <- ccmean(sim$censoredCostHistory)
est

## ----fig.height=3, fig.width=7-------------------------------------------
plot(est) + geom_hline(yintercept = 40000, linetype = "dotted", size = 1)

## ---- eval = FALSE-------------------------------------------------------
#  
#  nSim   <- 1000
#  nYears <- 10
#  indv   <- 1000 # increating individuals increases computing time exponential
#  ## true mean for unif is 40000 and exp is 35956
#  unif_light <- lapply(1:nSim, function(x) simCostData(n = indv, dist = "unif", censor = "light", cdist = "exp", L = nYears))
#  unif_heavy <- lapply(1:nSim, function(x) simCostData(n = indv, dist = "unif", censor = "heavy", cdist = "exp", L = nYears))
#  exp_light  <- lapply(1:nSim, function(x) simCostData(n = indv, dist = "exp",  censor = "light", cdist = "exp", L = nYears))
#  exp_heavy  <- lapply(1:nSim, function(x) simCostData(n = indv, dist = "exp",  censor = "heavy", cdist = "exp", L = nYears))

## ---- eval = FALSE-------------------------------------------------------
#  nCores <- parallel::detectCores() - 1
#  cl <- makeCluster(nCores)
#  clusterExport(cl = cl, c("unif_light", "unif_heavy", "exp_light", "exp_heavy"))
#  invisible(clusterEvalQ(cl = cl, {library(dplyr)
#                                   library(ccostr)
#                                   library(data.table)
#                                   library(survival)}))
#  est_unif_light <- parLapply(cl, unif_light, function(x) ccmean(x$censoredCostHistory, L = 10))
#  est_unif_heavy <- parLapply(cl, unif_heavy, function(x) ccmean(x$censoredCostHistory, L = 10))
#  est_exp_light  <- parLapply(cl, exp_light,  function(x) ccmean(x$censoredCostHistory, L = 10))
#  est_exp_heavy  <- parLapply(cl, exp_heavy,  function(x) ccmean(x$censoredCostHistory, L = 10))
#  stopCluster(cl)

## ---- eval = FALSE-------------------------------------------------------
#  results_unif_light <- do.call(rbind, lapply(est_unif_light, function(x) x[[3]]))
#  results_unif_heavy <- do.call(rbind, lapply(est_unif_heavy, function(x) x[[3]]))
#  results_exp_light  <- do.call(rbind, lapply(est_exp_light,  function(x) x[[3]]))
#  results_exp_heavy  <- do.call(rbind, lapply(est_exp_heavy,  function(x) x[[3]]))
#  results_true <- data.frame("unif_light" = 40000,
#                             "unif_heavy" = 40000,
#                             "exp_light"  = 35956,
#                             "exp_heavy"  = 35956)
#  results_bias <- data.frame("unif_light" = (colMeans(results_unif_light)),
#                             "unif_heavy" = (colMeans(results_unif_heavy)),
#                             "exp_light"  = (colMeans(results_exp_light)),
#                             "exp_heavy"  = (colMeans(results_exp_heavy)))
#  results <- rbind(results_true, results_bias)
#  row.names(results) <- c("true_mean", colnames(results_unif_light))
#  
#  results_bias <- cbind(round(results[,c(1,2)] - 40000,2),
#                        round(results[,c(3,4)] - 35956,2))
#  
#  cov_unif_light <- do.call(rbind, lapply(est_unif_light, function(x) ifelse(x[[4]][5,] >= 40000 & x[[4]][4,] <= 40000, 1, 0)))
#  cov_unif_heavy <- do.call(rbind, lapply(est_unif_heavy, function(x) ifelse(x[[4]][5,] >= 40000 & x[[4]][4,] <= 40000, 1, 0)))
#  cov_exp_light  <- do.call(rbind, lapply(est_exp_light,  function(x) ifelse(x[[4]][5,] >= 35956 & x[[4]][4,] <= 35956, 1, 0)))
#  cov_exp_heavy  <- do.call(rbind, lapply(est_exp_heavy,  function(x) ifelse(x[[4]][5,] >= 35956 & x[[4]][4,] <= 35956, 1, 0)))
#  results_coverage <- data.frame("unif_light" = (colMeans(cov_unif_light, na.rm = T)),
#                                 "unif_heavy" = (colMeans(cov_unif_heavy, na.rm = T)),
#                                 "exp_light"  = (colMeans(cov_exp_light,  na.rm = T)),
#                                 "exp_heavy"  = (colMeans(cov_exp_heavy,  na.rm = T)))

## ------------------------------------------------------------------------
load(system.file("extdata", "results.Rdata", package = "ccostr"))
kable(results)

## ------------------------------------------------------------------------
kable(results_bias)

## ------------------------------------------------------------------------
kable(results_coverage, digits = 3)