Potential Outcomes & ATE

The fundamental problem of causal inference

For every person, there are two potential outcomes:

• \(Y_i(1)\): what happens if they get the treatment
• \(Y_i(0)\): what happens if they don’t

The individual treatment effect is \(\tau_i = Y_i(1) - Y_i(0)\). The problem? We only ever observe one of these. A person is either treated or not — never both. The unobserved outcome is the counterfactual.

The Average Treatment Effect (ATE) is:

\[\text{ATE} = E[Y(1) - Y(0)]\]

Since we can’t observe both for anyone, we need assumptions (like random assignment) to estimate it.

Why randomization works

If treatment is assigned randomly, the treated and control groups are comparable on average. The difference in group means is an unbiased estimator of the ATE. But if treatment isn’t random — if sicker people seek treatment — the naive comparison is biased. That’s selection bias.

The simulation below lets you see both potential outcomes (which you never get in real life), watch selection bias appear, and see how randomization fixes it.

#| '!! shinylive warning !!': |
#|   shinylive does not work in self-contained HTML documents.
#|   Please set `embed-resources: false` in your metadata.
#| standalone: true
#| viewerHeight: 620

library(shiny)

ui <- fluidPage(
  tags$head(tags$style(HTML("
    .stats-box {
      background: #f0f4f8; border-radius: 6px; padding: 14px;
      margin-top: 12px; font-size: 14px; line-height: 1.9;
    }
    .stats-box b { color: #2c3e50; }
    .good { color: #27ae60; font-weight: bold; }
    .bad  { color: #e74c3c; font-weight: bold; }
  "))),

  sidebarLayout(
    sidebarPanel(
      width = 3,

      sliderInput("n", "Population size:",
                  min = 100, max = 2000, value = 500, step = 100),

      sliderInput("ate", "True ATE:",
                  min = -2, max = 5, value = 2, step = 0.5),

      selectInput("assign", "Treatment assignment:",
                  choices = c("Random (coin flip)",
                              "Self-selection (high Y0 seek treatment)",
                              "Self-selection (low Y0 seek treatment)")),

      actionButton("go", "New draw", class = "btn-primary", width = "100%"),

      uiOutput("results")
    ),

    mainPanel(
      width = 9,
      fluidRow(
        column(6, plotOutput("po_plot", height = "400px")),
        column(6, plotOutput("obs_plot", height = "400px"))
      )
    )
  )
)

server <- function(input, output, session) {

  dat <- reactive({
    input$go
    n   <- input$n
    ate <- input$ate

    # Potential outcomes
    y0 <- rnorm(n, mean = 5, sd = 2)
    y1 <- y0 + ate + rnorm(n, sd = 0.5)

    # Assignment
    if (input$assign == "Random (coin flip)") {
      treat <- rbinom(n, 1, 0.5)
    } else if (input$assign == "Self-selection (high Y0 seek treatment)") {
      prob <- pnorm(y0, mean = mean(y0), sd = sd(y0))
      treat <- rbinom(n, 1, prob)
    } else {
      prob <- 1 - pnorm(y0, mean = mean(y0), sd = sd(y0))
      treat <- rbinom(n, 1, prob)
    }

    # Observed outcome
    y_obs <- ifelse(treat == 1, y1, y0)

    # Estimates
    naive <- mean(y_obs[treat == 1]) - mean(y_obs[treat == 0])
    true_ate <- mean(y1 - y0)

    list(y0 = y0, y1 = y1, treat = treat, y_obs = y_obs,
         naive = naive, true_ate = true_ate, ate = ate)
  })

  output$po_plot <- renderPlot({
    d <- dat()
    par(mar = c(4.5, 4.5, 3, 1))
    plot(d$y0, d$y1, pch = 16, cex = 0.6,
         col = ifelse(d$treat == 1, "#3498db80", "#e74c3c80"),
         xlab = "Y(0) — outcome without treatment",
         ylab = "Y(1) — outcome with treatment",
         main = "Both Potential Outcomes (God's view)")
    abline(0, 1, lty = 2, col = "gray40", lwd = 1.5)
    legend("topleft", bty = "n", cex = 0.85,
           legend = c("Treated", "Control", "45° line (no effect)"),
           col = c("#3498db", "#e74c3c", "gray40"),
           pch = c(16, 16, NA), lty = c(NA, NA, 2), lwd = c(NA, NA, 1.5))
  })

  output$obs_plot <- renderPlot({
    d <- dat()
    par(mar = c(4.5, 4.5, 3, 1))

    grp <- factor(d$treat, labels = c("Control", "Treated"))
    boxplot(d$y_obs ~ grp,
            col = c("#e74c3c40", "#3498db40"),
            border = c("#e74c3c", "#3498db"),
            main = "What we actually observe",
            ylab = "Observed Y", xlab = "")

    m0 <- mean(d$y_obs[d$treat == 0])
    m1 <- mean(d$y_obs[d$treat == 1])
    points(1:2, c(m0, m1), pch = 18, cex = 2.5, col = c("#e74c3c", "#3498db"))
  })

  output$results <- renderUI({
    d <- dat()
    bias <- d$naive - d$true_ate
    biased <- abs(bias) > 0.3

    tags$div(class = "stats-box",
      HTML(paste0(
        "<b>True ATE:</b> ", round(d$true_ate, 3), "<br>",
        "<b>Naive estimate:</b> ", round(d$naive, 3), "<br>",
        "<b>Bias:</b> <span class='", ifelse(biased, "bad", "good"), "'>",
        round(bias, 3), "</span><br>",
        if (biased) "<br><small>Selection bias: treated & control groups aren't comparable.</small>"
        else "<br><small>Random assignment makes groups comparable.</small>"
      ))
    )
  })
}

shinyApp(ui, server)

Things to try

• Start with random assignment: the naive estimate is close to the true ATE.
• Switch to self-selection (high Y₀ seek treatment): people who would have done well anyway are the ones getting treated. The naive estimate is too high — that’s positive selection bias.
• Switch to self-selection (low Y₀ seek treatment): now the opposite. Sicker people seek treatment, making it look less effective than it is.
• The left plot shows both potential outcomes — something you never see in real data. That’s the fundamental problem.