eocusum_arloc_sim {vlad} | R Documentation |
Compute Out of Control ARLs of EO-CUSUM control charts using simulation.
eocusum_arloc_sim(r, k, h, df, coeff, coeff2, QS = 1, side = "low")
r |
Integer. Number of of simulation runs. |
k |
Double. Reference value of the CUSUM control chart. Either |
h |
Double. Decision interval (alarm limit, threshold) of the CUSUM control chart. |
df |
Data Frame. First column Parsonnet Score and second column outcome of each operation. |
coeff |
Numeric Vector. Estimated coefficients alpha and beta from the binary logistic regression model. |
coeff2 |
Numeric Vector. Estimated coefficients alpha and beta from the binary logistic regression model of a resampled dataset. |
QS |
Double. Defines the performance of a surgeon with the odds ratio ratio of death
|
side |
Character. Default is |
Returns a single value which is the Run Length.
Philipp Wittenberg
Wittenberg P, Gan FF, Knoth S (2018). A simple signaling rule for variable life-adjusted display derived from an equivalent risk-adjusted CUSUM chart. Statistics in Medicine, 37(16), pp 2455–2473.
## Not run: ## Datasets data("cardiacsurgery", package = "spcadjust") s5000 <- dplyr::sample_n(cardiacsurgery, size = 5000, replace = TRUE) df1 <- subset(cardiacsurgery, select=c(Parsonnet, status)) df2 <- subset(s5000, select=c(Parsonnet, status)) ## estimate coefficients from logit model coeff1 <- round(coef(glm(status~Parsonnet, data=df1, family="binomial")), 3) coeff2 <- round(coef(glm(status~Parsonnet, data=df2, family="binomial")), 3) ## Serial simulation ## set seed for reproducibility RNGkind("L'Ecuyer-CMRG") m <- 10^3 RLS <- do.call(c, lapply(1:m, eocusum_arloc_sim, h=4.498, k=0, df=df1, side="low", coeff=coeff1, coeff2=coeff2)) data.frame(cbind("ARL"=mean(RLS), "ARLSE"=sd(RLS)/sqrt(m))) ## ARL=366.697; ARLSE=9.457748 ## Parallel simulation (FORK) ## set seed for reproducibility RNGkind("L'Ecuyer-CMRG") RLS <- simplify2array(parallel::mclapply(1:m, eocusum_arloc_sim, h=4.498, k=0, df=df1, side="low", coeff=coeff1, coeff2=coeff2, mc.cores=parallel::detectCores())) data.frame(cbind("ARL"=mean(RLS), "ARLSE"=sd(RLS)/sqrt(m))) ## Parallel simulation (PSOCK) ## set seed for reproducibility RNGkind("L'Ecuyer-CMRG") no_cores <- parallel::detectCores() cl <- parallel::makeCluster(no_cores) side <- 1 h_vec <- 4.498 QS_vec <- 1 m <- 10^3 k <- 0 parallel::clusterExport(cl, c("h_vec", "eocusum_arloc_sim", "df1", "coeff1", "coeff2", "QS_vec", "side", "k")) time <- system.time( { RLS <- array(NA, dim=c( length(QS_vec), length(h_vec), m)) for (h in h_vec) { for (QS in QS_vec) { cat(h, " ", QS, "\n") RLS[which(QS_vec==QS), which(h==h_vec), ] <- parallel::parSapply(cl, 1:m, eocusum_arloc_sim, side=side, QS=QS, h=h, k=k, df=df1, coeff=coeff1, coeff2=coeff2, USE.NAMES=FALSE) } } } ) ARL <- apply(RLS, c(1, 2), mean) ARLSE <- sqrt(apply(RLS, c(1, 2), var)/m) print(list(ARL, ARLSE, time)) parallel::stopCluster(cl) ## End(Not run)