---
title: "Stylized examples from Masten and Poirier (2026)"
output: rmarkdown::html_vignette
vignette: >
  %\VignetteIndexEntry{Stylized examples from Masten and Poirier (2026)}
  %\VignetteEngine{knitr::rmarkdown}
  %\VignetteEncoding{UTF-8}
---

```{r setup, include = FALSE}
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  fig.width = 6, fig.height = 4
)
```

This vignette illustrates, on a *stylized* constructed example, the
figures of **Masten and Poirier (2026),** [*The Effect of Omitted
Variables on the Sign of Regression Coefficients*][mp]. The paper's
Figures 1, 2, and S1 are built on its empirical application to
Satyanath, Voigtländer and Voth (2017), whose microdata is distributed
separately (Harvard Dataverse, doi:10.7910/DVN/EE6I7N) and is not
bundled here; the paper itself does not print the moments needed to
regenerate those curves. Its survey tables aggregate across many
published studies. So this vignette exercises the machinery in
`regsensitivity` end-to-end on a data-generating process we control,
and the structural features of the published figures -- at most three
solutions at any $\delta$, the vertical asymptote at $\delta = 1$ --
are what should carry over. The numerical values should not be
compared.

[mp]: https://arxiv.org/abs/2208.00552

## A stylized data-generating process

We construct a small example where the medium-regression coefficient
is positive but Oster's identified set $\mathcal{B}_I(\delta, R_{long})$
crosses zero at moderate $\delta$.

```{r}
library(regsensitivity)
library(ggplot2)

set.seed(2208)
n <- 5000
w1 <- rnorm(n)
w2 <- rnorm(n)
w3 <- rnorm(n)
x  <- 0.3 * w1 + 0.3 * w2 + 0.5 * w3 + rnorm(n)
y  <- 0.8 * x + 0.4 * w1 - 0.3 * w2 + 0.6 * w3 + rnorm(n)
dat <- data.frame(y = y, x = x, w1 = w1, w2 = w2)   # w3 is unobserved!

form <- y ~ x + w1 + w2
```

The "true" long-regression coefficient is 0.8; the medium regression
sees an upward-biased estimate because `w3` is correlated with `x`.

```{r}
coef(lm(form, data = dat))["x"]
```

Two observed controls rather than one is not cosmetic. With a single
control, $\gamma_{med}$ and $\pi_{med}$ are scalars, the numerator and
denominator of $\delta(\beta)$ share a root, and the asymptote at that
$\beta$ cancels into a removable hole -- a degenerate case with none of
the structure the paper's figures show.

## Figure 1: Oster's identified set $\mathcal{B}_I(\delta, R_{long})$

```{r mp-fig1}
res <- regsen_bounds(form, dat,
                      analysis = "oster",
                      delta = seq(-2, 2, 0.02),
                      r2long = 1)
plot(res, ylim = c(-2, 4),
     title = "Figure 1 (stylized): Oster identified set vs delta")
```

The branches of the cubic in $\beta$ that solve Oster's equation give
the identified set. The cubic's leading coefficient is proportional to
$\delta - 1$, so a root escapes to infinity exactly at $\delta = 1$:
below it there is one solution near $\beta_{med}$, and at $\delta = 1$
a second branch enters from $-\infty$ and sweeps up across zero. The
curves are drawn as branches of $\delta(\beta)$ rather than as
functions of $\delta$, which is why a branch can fold back -- one
$\delta$ carrying two solutions on the same branch -- as this one does
just past $\delta = 1$.

## Figure 2: cumulative identified set $\delta \le \bar d$

```{r mp-fig2}
res2 <- regsen_bounds(form, dat,
                       analysis = "oster",
                       delta = seq(0, 1, 0.005),
                       delta_type = "bound",
                       r2long = 1)
plot(res2, ylim = c(0, 2),
     title = "Figure 2 (stylized): cumulative identified set")
```

The cumulative set is a narrow cone around $\beta_{med}$ for every
$\delta$ short of one, and at $\delta = 1$ it is the whole real line:
both bounds leave the panel rather than flattening along its edge. The
sign of the effect is therefore not in doubt anywhere below the
threshold and completely undetermined at it -- the discontinuity, not a
gradual widening, is what does the work.

## Table 1: breakdown points

| Quantity                                         | Value                              |
|--------------------------------------------------|------------------------------------|
| `oster_breakdown_eq`, $\beta = 0$, $R_{long}=1$  | `r round(regsen_breakdown(form, dat, analysis="oster", r2long=1, beta=bnd_eq(0))$results$breakdown[1], 4)` |
| `oster_breakdown_bound`, $\beta > 0$, $R_{long}=1$ | `r round(regsen_breakdown(form, dat, analysis="oster", r2long=1)$results$breakdown[1], 4)` |
| DMP $\bar r_X^{bp}$ at $\bar c = 1$              | `r round(regsen_bounds(form, dat, cbar=1)$breakdown, 4)` |

## Effect of a maxovb constraint

Masten-Poirier (2026) extend Oster by adding a **maximum omitted
variable bias** constraint. A sign change requires the bias to carry
$\beta$ all the way from $\beta_{med}$ to zero, so any cap below
$\beta_{med}$ rules one out and the breakdown point is $+\infty$:

```{r mp-maxovb-inf}
bmed <- regsen_bounds(form, dat, analysis = "oster",
                       delta = 0, r2long = 1)$dgp$beta_med
sapply(c(0.5, 1, round(bmed, 3) + 0.001), function(M) {
    regsen_breakdown(form, dat, analysis = "oster",
                      r2long = 1, maxovb = M)$results$breakdown[1]
})
```

Above that threshold the cap binds without forbidding the sign change,
and the breakdown point falls back towards its uncapped value as the
cap loosens:

```{r mp-maxovb}
ovbs <- seq(1.1, 3, 0.1)
out <- lapply(ovbs, function(M) {
    r <- regsen_breakdown(form, dat,
                           analysis = "oster",
                           r2long = 1, maxovb = M)
    data.frame(maxovb = M, breakdown = r$results$breakdown[1])
})
out <- do.call(rbind, out)
uncapped <- regsen_breakdown(form, dat, analysis = "oster",
                              r2long = 1)$results$breakdown[1]

ggplot(out, aes(maxovb, breakdown)) +
    geom_hline(yintercept = 1, linetype = "dotted", colour = "grey40") +
    geom_line() + geom_point() +
    labs(x = "maxovb", y = "Delta (breakdown)",
         title = "Oster sign-change breakdown vs max OVB") +
    theme_regsen()
```

A tighter cap on the OVB magnitude lifts the breakdown delta, and every
value drawn is above one -- the dotted line. That is the point of the
constraint: without it, Masten and Poirier's Theorem 2 caps the
sign-change breakdown at one (here `r round(uncapped, 4)`), so no sign
conclusion can be called robust by the $|\delta| > 1$ convention. The
cap is the extra assumption that lifts the ceiling, and it has to be
argued for rather than chosen for the answer it gives.

## Meta-analysis tables (paper Tables 3-4)

The paper's Tables 3 and 4 aggregate breakdown-point statistics across
many published studies. (Table 2 belongs to the Satyanath et al.
application, not the survey.) The package contains the primitives needed to
reproduce those tables (`regsen_breakdown(... maxovb = ...)`); plug your
own meta-analysis data in and call:

```r
results <- lapply(study_list, function(study) {
    out <- regsen_breakdown(study$formula, study$data,
                             analysis = "oster",
                             r2long = 1, maxovb = study$maxovb,
                             beta = bnd_eq(0))
    out$results$breakdown[1]
})
```