kappa_vs_agreement.R

# compare Cohen's kappa and % agreement
# for two raters making a binary (yes/no) decision
# assuming the same prevalence for both raters

library(viridisLite)

k <- function (Po, prevalence) {
  Pe <- (prevalence^2) + ((1-prevalence)^2)
  (Po - Pe) / (1 - Pe)
}

observed <- 0:10/10
prevsa <- 1:19/20
prevs <- prevsa[prevsa <= 0.5]

res <- lapply(prevs, function (p) {
  sapply(observed, function (o) k(Po = o, prevalence = p))
})

cols <- viridis(length(prevs))
labs <- paste0(prevs * 100, '/', rev(prevsa[prevsa >= 0.5]) * 100)
labs[length(labs)] <- '50'

png('kappa_vs_agreement.png', height = 6, width = 9, units = 'in', res = 300)

par(mar = c(5, 5, 1, 12), xpd = F)
plot(1, type = 'n', xlim = c(0, 1), ylim = c(-1, 1), xlab = 'Agreement', ylab = "Cohen's kappa", axes = F)
mapply(lines,
       x = list(observed),
       y = res,
       col = cols,
       lwd = 2)
axis(1, 0:10/10, paste0(0:10 * 10, '%'))
axis(2, -5:5/5, las = 2)
box()
abline(h = -5:5/5, col = 'grey85')
abline(v = 0:10/10, col = 'grey85')
abline(h = 0)
abline(v = 0.5)
ys <- seq(-0.3, 0.85, length.out = length(prevs))
par(xpd = NA)
segments(1.1, ys, x1 = 1.2, col = cols, lwd = 2)
text(1.25, ys, labels = labs, adj = 0)
text(1.1, 1, 'Prevalence (%)', adj = 0)

dev.off()