Figure 1: Sensitivity analysis for Republican Vote Share
Left panel: bounds on \(\beta_{long}\) as a function of \(\bar r_X\), \(\bar c = 1\)
The paper’s left panel carries three things: solid bounds with \(\bar r_Y = \infty\), dashed bounds under the common-maximal-impact restriction \(\bar r_Y = \bar r_X\), and tick marks on the horizontal axis showing the Table 4 calibration values. All three are reproduced below.
rx_grid <- seq(0, 1.4, length.out = 300)
solid <- regsen_bounds(form, bfg2020, compare = w1, cbar = 1,
rxbar = rx_grid)
dashed <- regsen_bounds(form, bfg2020, compare = w1, cbar = 1,
rxbar = rx_grid,
rybar_expr = function(rx) rx)
sd <- as.data.frame(solid); sd$spec <- "rybar = Inf"
dd <- as.data.frame(dashed); dd$spec <- "rybar = rxbar"
df <- rbind(sd[, c("rxbar", "bmin", "bmax", "spec")],
dd[, c("rxbar", "bmin", "bmax", "spec")])
# Blank infinite bounds so coord_cartesian() does not paint them on
# the panel edge.
df$bmin[!is.finite(df$bmin)] <- NA
df$bmax[!is.finite(df$bmax)] <- NA
ticks <- data.frame(x = calibrate_rho(form, bfg2020, compare = w1)$rho / 100)
ggplot(df, aes(x = rxbar, linetype = spec)) +
geom_hline(yintercept = 0, colour = "grey40", linewidth = 0.3,
linetype = "dotted") +
geom_line(aes(y = bmin), linewidth = 0.55, na.rm = TRUE) +
geom_line(aes(y = bmax), linewidth = 0.55, na.rm = TRUE) +
# The paper draws the calibration marks on the zero line itself, not
# along the panel foot, so they read against the crossing points.
annotate("segment", x = ticks$x, xend = ticks$x, y = -0.25, yend = 0.25,
linewidth = 0.35, colour = "black") +
scale_linetype_manual(values = c("rybar = Inf" = "solid",
"rybar = rxbar" = "dashed")) +
# Axis breaks chosen to match the published figure, so the two can be
# laid side by side without mentally rescaling.
scale_x_continuous(breaks = seq(0, 1.4, 0.2)) +
scale_y_continuous(breaks = seq(-2, 6, 2)) +
coord_cartesian(xlim = c(0, 1.5), ylim = c(-3.2, 7.2)) +
labs(x = expression(bar(r)[X]), y = expression(beta[long]),
linetype = NULL) +
theme_regsen(base_size = 10)
The two zero crossings are the two breakdown points of Table 1, Panel C:
Right panel: the breakdown frontier in \((\bar r_X, \bar r_Y)\) space
The paper’s right panel is a different object from the left: it plots
the breakdown frontier \(\bar r_Y^{bf}(\bar
r_X)\), one curve per \(\bar
c\), in the \((\bar r_X, \bar
r_Y)\) plane. That is what direction = "rybar"
computes – the frontier of DMP Theorem 4, solved for \(\bar r_Y\) at each \(\bar r_X\):
frontier <- function(cbar, rxs) {
r <- regsen_breakdown(form, bfg2020, compare = w1, cbar = cbar,
direction = "rybar", rxbar = rxs)
data.frame(rxbar = rxs, rybar = r$results$breakdown,
cbar = factor(cbar))
}
rxs <- c(0.75, 0.85, 0.95, 1.05, 1.2, 1.4, 1.7, 2.2, 3, 4)
fr <- do.call(rbind, lapply(c(1, 0.75, 0.5), frontier, rxs = rxs))
# Below its rxbar breakdown point a curve survives every rybar, so the
# frontier is +Inf: send those points off the top and let the panel clip
# them, which draws the vertical arm.
fr$rybar[!is.finite(fr$rybar)] <- 40
# As in the paper: thick black is cbar = 1; the greys are 0.75 and
# 0.5, moving outward. The coarse grid keeps the CRAN build fast; the
# website's figure-comparison article runs a fine one.
ggplot(fr, aes(x = rxbar, y = rybar, group = cbar)) +
geom_line(aes(linewidth = cbar == "1", colour = cbar == "1"),
na.rm = TRUE) +
scale_linewidth_manual(values = c(`TRUE` = 0.9, `FALSE` = 0.4),
guide = "none") +
scale_colour_manual(values = c(`TRUE` = "black", `FALSE` = "grey55"),
guide = "none") +
coord_cartesian(xlim = c(0, 4), ylim = c(0, 4)) +
labs(x = expression(bar(r)[X]), y = expression(bar(r)[Y])) +
theme_regsen(base_size = 10)
Each curve is the boundary between \((\bar r_X, \bar r_Y)\) pairs under which the sign conclusion survives and those under which it fails. Each has two arms. The vertical one sits at \(\bar r_X = 0.804\) for \(\bar c = 1\), the breakdown point from Table 1: as \(\bar r_Y\) grows the restriction on the outcome side stops binding and the frontier is the \(\bar r_X\) breakdown point under no restriction at all. The horizontal arm is the level of \(\bar r_Y\) below which the sign survives any \(\bar r_X\). Smaller \(\bar c\) pushes both out, because restricting how endogenous the controls may be makes the conclusion harder to overturn.
Reading the frontier in the other direction shows why the package offers both. Fix \(\bar r_Y\) and ask for the \(\bar r_X\) at which the sign fails: just above the horizontal arm there is an answer, and on it there is none, because no \(\bar r_X\) overturns the sign there.
vapply(c(0.7, 0.6, 0.55, 0.5), function(ry) {
regsen_breakdown(form, bfg2020, compare = w1,
cbar = 1, rybar = ry)$results$breakdown
}, numeric(1))
#> [1] 1.074537 1.395827 Inf InfThe identified set at those larger \(\bar r_X\) is bounded, even though \(\bar r_X\) alone would say nothing there – restricting \(\bar r_Y\) is what keeps it finite:
Overlaying the calibration values
# The breakdown point as a function of cbar alone, with each covariate's
# calibrated rho_k drawn as a reference line.
bd_cbar <- regsen_breakdown(form, bfg2020, compare = w1,
cbar = seq(0, 1, 0.02))
df_rho <- calibrate_rho(form, bfg2020, compare = w1)
df_rho$variable <- labels[df_rho$variable]
df_rho$rho_dec <- df_rho$rho / 100 # express as fraction
# Several covariates calibrate to similar rho, so labels placed at a
# common x collide into an unreadable stack. Staggering them across three
# x positions keeps every label rather than dropping the crowded ones.
df_rho <- df_rho[order(-df_rho$rho_dec), ]
df_rho$xpos <- rep(c(0.02, 0.36, 0.70), length.out = nrow(df_rho))
plot(bd_cbar) +
geom_hline(yintercept = df_rho$rho_dec, linetype = "dotted",
colour = "grey55", linewidth = 0.3) +
geom_text(data = df_rho,
aes(x = xpos, y = rho_dec, label = variable),
hjust = 0, vjust = -0.4, size = 2.5, colour = "grey25") +
coord_cartesian(ylim = c(0, 1.45))
Each dotted line is one covariate’s \(\rho_k\): how much of the treatment’s variation that single observed control explains. Reading the frontier against them is the point of the figure – a covariate sitting above the frontier would, if an unobservable were comparably important, be enough to overturn the sign.
