Bayes’ Theorem
The formula
\[P(H \mid D) = \frac{P(D \mid H) \cdot P(H)}{P(D)}\]
In words:
\[\text{Posterior} = \frac{\text{Likelihood} \times \text{Prior}}{\text{Evidence}}\]
That looks abstract. Let’s make it concrete.
The medical test example
Imagine a disease that affects 1 in 1,000 people. A test for it is 99% accurate — if you have the disease it says positive 99% of the time, and if you don’t have it, it says negative 99% of the time.
You test positive. What’s the probability you actually have the disease?
Most people say 99%. The real answer is about 9%. This is not a trick — it’s Bayes’ theorem. The disease is so rare that even a good test produces more false positives than true positives.
The simulator below lets you adjust the base rate and test accuracy and watch how the posterior probability changes.
#| '!! shinylive warning !!': |
#| shinylive does not work in self-contained HTML documents.
#| Please set `embed-resources: false` in your metadata.
#| standalone: true
#| viewerHeight: 580
library(shiny)
ui <- fluidPage(
tags$head(tags$style(HTML("
.result-box {
background: #f0f4f8; border-radius: 6px; padding: 16px;
margin-top: 14px; font-size: 15px; line-height: 2;
text-align: center;
}
.result-box .big {
font-size: 32px; color: #e74c3c; font-weight: bold;
}
"))),
sidebarLayout(
sidebarPanel(
width = 3,
sliderInput("prev", "Base rate (prevalence):",
min = 0.001, max = 0.20, value = 0.001, step = 0.001),
sliderInput("sens", "Sensitivity (true positive rate):",
min = 0.50, max = 1.00, value = 0.99, step = 0.01),
sliderInput("spec", "Specificity (true negative rate):",
min = 0.50, max = 1.00, value = 0.99, step = 0.01),
uiOutput("result_box")
),
mainPanel(
width = 9,
fluidRow(
column(6, plotOutput("tree_plot", height = "420px")),
column(6, plotOutput("icon_plot", height = "420px"))
)
)
)
)
server <- function(input, output, session) {
vals <- reactive({
prev <- input$prev
sens <- input$sens
spec <- input$spec
# Out of 10,000 people
N <- 10000
sick <- round(N * prev)
healthy <- N - sick
true_pos <- round(sick * sens)
false_neg <- sick - true_pos
false_pos <- round(healthy * (1 - spec))
true_neg <- healthy - false_pos
total_pos <- true_pos + false_pos
ppv <- if (total_pos > 0) true_pos / total_pos else 0
list(N = N, sick = sick, healthy = healthy,
true_pos = true_pos, false_neg = false_neg,
false_pos = false_pos, true_neg = true_neg,
total_pos = total_pos, ppv = ppv)
})
output$tree_plot <- renderPlot({
v <- vals()
par(mar = c(1, 1, 3, 1))
plot(NULL, xlim = c(0, 10), ylim = c(0, 10), axes = FALSE,
xlab = "", ylab = "", main = "What happens to 10,000 people?")
# Population
text(5, 9.5, paste0("Population: ", v$N), cex = 1.2, font = 2)
# Sick vs Healthy
text(2.5, 7.5, paste0("Sick: ", v$sick), cex = 1.1, col = "#e74c3c")
text(7.5, 7.5, paste0("Healthy: ", v$healthy), cex = 1.1, col = "#3498db")
segments(5, 9, 2.5, 8, lwd = 2)
segments(5, 9, 7.5, 8, lwd = 2)
# Test results for sick
text(1.2, 5.2, paste0("Test +\n", v$true_pos), cex = 1, col = "#27ae60", font = 2)
text(3.8, 5.2, paste0("Test -\n", v$false_neg), cex = 1, col = "#7f8c8d")
segments(2.5, 7, 1.2, 5.8, lwd = 1.5)
segments(2.5, 7, 3.8, 5.8, lwd = 1.5)
# Test results for healthy
text(6.2, 5.2, paste0("Test +\n", v$false_pos), cex = 1, col = "#e74c3c", font = 2)
text(8.8, 5.2, paste0("Test -\n", v$true_neg), cex = 1, col = "#7f8c8d")
segments(7.5, 7, 6.2, 5.8, lwd = 1.5)
segments(7.5, 7, 8.8, 5.8, lwd = 1.5)
# Total positives
text(3.7, 3, paste0("Total positive tests: ", v$total_pos), cex = 1.1, font = 2)
text(3.7, 2, paste0("Of these, truly sick: ", v$true_pos), cex = 1.1,
col = "#27ae60", font = 2)
text(3.7, 1, paste0("P(sick | test+) = ",
v$true_pos, "/", v$total_pos, " = ",
round(v$ppv * 100, 1), "%"), cex = 1.2, font = 2, col = "#e74c3c")
})
output$icon_plot <- renderPlot({
v <- vals()
par(mar = c(1, 1, 3, 1))
# Show total positive tests as dots
n_show <- min(v$total_pos, 200)
n_true <- round(n_show * v$ppv)
n_false <- n_show - n_true
cols <- c(rep("#27ae60", n_true), rep("#e74c3c", n_false))
cols <- sample(cols)
ncol <- ceiling(sqrt(n_show))
nrow <- ceiling(n_show / ncol)
plot(NULL, xlim = c(0, ncol + 1), ylim = c(0, nrow + 1),
axes = FALSE, xlab = "", ylab = "",
main = paste0("All ", v$total_pos, " positive tests"))
if (n_show > 0) {
x <- rep(seq_len(ncol), times = nrow)[seq_len(n_show)]
y <- rep(seq(nrow, 1), each = ncol)[seq_len(n_show)]
points(x, y, pch = 15, cex = max(0.5, 3 - n_show / 50), col = cols)
}
legend("bottom", bty = "n", horiz = TRUE, cex = 0.95,
legend = c(paste0("Truly sick (", n_true, ")"),
paste0("False alarm (", n_false, ")")),
col = c("#27ae60", "#e74c3c"), pch = 15, pt.cex = 1.5)
})
output$result_box <- renderUI({
v <- vals()
tags$div(class = "result-box",
HTML(paste0(
"If you test positive,<br>",
"the probability you're sick is:<br>",
"<span class='big'>", round(v$ppv * 100, 1), "%</span><br>",
"<small>not ", round(input$sens * 100), "%!</small>"
))
)
})
}
shinyApp(ui, server)Things to try
- Default settings (prevalence 0.1%, test 99% accurate): only ~9% of positive tests are truly sick. The base rate dominates.
- Slide prevalence up to 5%: now ~84% of positives are real. The prior matters!
- Slide prevalence to 50%: the posterior is ~99%. When the disease is common, a positive test is very informative.
- Lower specificity to 90%: false positives explode. Watch the right plot fill with red dots.
The lesson
Bayes’ theorem tells you: don’t just look at the test accuracy — look at how common the thing is. A 99% accurate test is nearly useless for a 1-in-1,000 disease because most positives are false alarms. This is the base rate fallacy, and Bayes’ theorem is the cure.