racusum_arloc_sim {vlad} | R Documentation |
Compute Out of Control ARLs of risk-adjusted cumulative sum control charts using simulation.
racusum_arloc_sim(r, coeff, coeff2, h, df, R0 = 1, RA = 2, RQ = 1)
r |
Integer Vector. Number of runs. |
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. |
h |
Double. Control Chart limit for detecting deterioration/improvement. |
df |
Data Frame. First column are Parsonnet Score values within a range of |
R0 |
Double. Odds ratio of death under the null hypotheses. |
RA |
Double. Odds ratio of death under the alternative hypotheses. Detecting deterioration
in performance with increased mortality risk by doubling the odds Ratio |
RQ |
Double. Defines the performance of a surgeon with the odds ratio ratio of death |
Returns a single value which is the Run Length.
Philipp Wittenberg
Steiner SH, Cook RJ, Farewell VT and Treasure T (2000). Monitoring surgical performance using risk-adjusted cumulative sum charts. Biostatistics, 1(4), pp. 441–452.
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: library("vlad"); library("ggplot2") ## Set seed for reproducibility RNGkind("L'Ecuyer-CMRG") ## 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) ## Number of simulation runs m <- 10^3 ## Deterioration RA=2: ## 1. Determine critical value for given ARL h0 <- racusum_arloc_h_sim(L0 = 370, df = df1, coeff = coeff1, coeff2 = coeff2, m = m, RA = 2, nc = 6) ## 2. Compute Out of Control ARL RQ <- seq(1, 4, 0.1) rl <- array(NA, dim = c(m, length(RQ))) RLS <- sapply(RQ, function(i) { cat("RQ: ", i, "\n" ) rl[, i] <- do.call(c, parallel::mclapply(1:m, racusum_arloc_sim, h = h0, df = df1, RA = 2, RQ = i, coeff = coeff1, coeff2 = coeff2, mc.cores = 6)) }) df3 <- data.frame(cbind(RQ, "ARL" = apply(RLS, 2, mean), "ARLSE" = apply(RLS, 2, mean)/sqrt(m))) ggplot(df3, aes(RQ, ARL)) + geom_line() + theme_classic() ## Improvement RA=1/2: ## 1. Determine critical value for given ARL h0 <- racusum_arloc_h_sim(L0 = 370, df = df1, coeff = coeff1, coeff2 = coeff2, m = m, RA = 1/2, nc = 6) ## 2. Compute Out of Control ARL RQ <- seq(1/4, 1, 1/40) rl <- array(NA, dim = c(m, length(RQ))) RLS <- sapply(RQ, function(i) { cat("RQ: ", i, "\n" ) rl[, i] <- do.call(c, parallel::mclapply(1:m, racusum_arloc_sim, h = h0, df = df1, RA = 1/2, RQ = i, coeff = coeff1, coeff2 = coeff2, mc.cores = 6)) }) df4 <- data.frame(cbind(RQ, "ARL" = apply(RLS, 2, mean), "ARLSE" = apply(RLS, 2, mean)/sqrt(m))) ggplot(df4, aes(RQ, ARL)) + geom_line() + theme_classic() ## End(Not run)