| 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)