vlad (version 0.2.0)

calceo: Compute Expected minus Observed value

Description

Compute Expected minus Observed value.

Usage

calceo(df, coeff, yemp = TRUE)

Arguments

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.

yemp

Logical. If TRUE use observed outcome value, if FALSE use estimated binary logistc regression model.

Value

Returns a single value which is the difference between expected risk and observed outcome.

References

Lovegrove J, Valencia O, Treasure T, Sherlaw-Johnson C and Gallivan S (1997). Monitoring the results of cardiac surgery by variable life-adjusted display. The Lancet, 350(9085), pp. 1128--1130.

Poloniecki J, Valencia O and Littlejohns P (1998). Cumulative risk adjusted mortality chart for detecting changes in death rate: observational study of heart surgery. BMJ, 316(7146), pp. 1697--1700.

Steiner S (2014). Risk-Adjusted Monitoring of Outcomes in Health Care. In Lawless JF (ed.), Statistics in Action, pp. 225--242. Informa UK Limited.

Examples

# NOT RUN {
library("vlad")
# see Steiner (2014) p. 234
coeff <- c("(Intercept)"=-3.68, "Parsonnet"=0.077)
# penalty reward for death (E-O scores multiplied with -1 to get O-E scores)
calceo(df=data.frame(as.integer(0), 1), coeff=coeff)*-1
calceo(df=data.frame(as.integer(50), 1), coeff=coeff)*-1
# penalty reward for survival
calceo(df=data.frame(as.integer(0), 0), coeff=coeff)*-1
calceo(df=data.frame(as.integer(50), 0), coeff=coeff)*-1

# Plot a VLAD/CRAM chart
data("cardiacsurgery", package="spcadjust")
cardiacsurgery <- dplyr::mutate(cardiacsurgery, phase=factor(ifelse(date < 2*365, "I", "II")))
S2 <- subset(cardiacsurgery, c(surgeon==2), c("phase", "Parsonnet", "status"))
S2I <- subset(S2, c(phase=="I"))
S2II <- subset(S2, c(phase=="II"))
coeff <- coef(glm(status ~ Parsonnet, data=S2I, family="binomial"))
EO <- sapply(1:nrow(S2), function(i) calceo(df=S2[i, c("Parsonnet", "status")], coeff=coeff))
df1 <- data.frame(cbind(subset(S2, select=c("phase")), "n"=1:nrow(S2), "cEO"=cumsum(EO)))
df2 <- tidyr::gather(df1, "variable", value, c(-n, -phase))

ggplot2::qplot(data=df2, n, value, colour=phase, geom=c("line", "point"),
               xlab="Patient number", ylab="CUSUM E-O") +
  ggplot2::geom_hline(yintercept=0, linetype="dashed") +
  ggplot2::theme_classic()
  
# }