none <- simulate_mr(pleiotropy = "none")
bal <- simulate_mr(pleiotropy = "balanced")
dir <- simulate_mr(pleiotropy = "directional")6 When assumptions break: pleiotropy
Every estimate so far came from valid instruments, and every method landed on the truth. Real variants are not so obliging. A single variant often influences several traits at once (a phenomenon called pleiotropy), and when a variant affects the outcome through some pathway other than the exposure, it violates the exclusion restriction from Chapter 2. This chapter breaks that assumption on purpose and shows what it does to our estimates, then builds the tools that detect and resist it.
6.1 Two flavours of pleiotropy
The simulator can plant a direct variant-to-outcome effect \(\alpha_j\) on a subset of instruments. The sign of those effects matters enormously.
- Balanced. The direct effects point in random directions and roughly cancel. IVW stays approximately unbiased, because the pleiotropic pushes average out. This is the optimistic case people quietly hope holds.
- Directional. The direct effects mostly point the same way. Now they do not cancel, and they drag the estimate with them. This is the dangerous case, and the whole point of MR sensitivity analysis is to survive it.
6.2 Watching IVW break
Let’s run every method on all three scenarios. A small helper turns a simulated dataset into two-sample summary statistics and applies IVW, MR-Egger, and the weighted median.
analyse <- function(sim) {
ts <- split_two_sample(sim)
bx <- sapply(seq_len(ncol(ts$sample1$G)), \(j) snp_assoc(ts$sample1$G[, j], ts$sample1$x)["beta"])
by <- sapply(seq_len(ncol(ts$sample2$G)), \(j) snp_assoc(ts$sample2$G[, j], ts$sample2$y)["beta"])
sy <- sapply(seq_len(ncol(ts$sample2$G)), \(j) snp_assoc(ts$sample2$G[, j], ts$sample2$y)["se"])
list(bx = bx, by = by, sy = sy,
ivw = mr_ivw(bx, by, sy),
egg = mr_egger(bx, by, sy),
wm = mr_weighted_median(bx, by, sy, n_boot = 1000))
}
res <- lapply(list(none = none, balanced = bal, directional = dir), analyse)
tab <- do.call(rbind, lapply(names(res), function(sc) {
r <- res[[sc]]
data.frame(scenario = sc,
IVW = round(r$ivw$estimate, 3),
`MR-Egger` = round(r$egg$estimate[2], 3),
`Weighted median` = round(r$wm$estimate, 3),
`Egger intercept` = round(r$egg$estimate[1], 4),
check.names = FALSE)
}))
tab| scenario | IVW | MR-Egger | Weighted median | Egger intercept | |
|---|---|---|---|---|---|
| beta | none | 0.357 | 0.314 | 0.371 | 0.0160 |
| beta1 | balanced | 0.329 | 0.298 | 0.306 | 0.0116 |
| beta2 | directional | 0.499 | 0.355 | 0.423 | 0.0541 |
Read the IVW column top to bottom. With no pleiotropy it is near 0.35. With balanced pleiotropy it holds up. With directional pleiotropy it lurches up to roughly 0.5: a large, confident, completely spurious causal effect. Nothing in the IVW estimate itself warns you; its confidence interval is happily narrow around the wrong number. This is the failure mode that makes naïve MR dangerous.
6.3 MR-Egger: let the line miss the origin
IVW forced the regression of \(\beta_Y\) on \(\beta_X\) through the origin. That constraint is precisely what directional pleiotropy exploits: if invalid variants all nudge the outcome the same way, they lift the whole cloud of points off the origin, and a through-the-origin line has to tilt to chase them.
MR-Egger (Bowden, Davey Smith, and Burgess 2015) relaxes the constraint. It fits the same weighted regression but allows an intercept:
\[ \beta_{Y_j} \;=\; \beta_0 + \theta\,\beta_{X_j} + \text{error}. \]
The payoff is twofold. The intercept \(\beta_0\) estimates the average directional pleiotropy. Under valid instruments it should be zero, so a non-zero intercept is a red flag. And the slope \(\theta\) stays consistent for the causal effect even when that intercept is non-zero, provided pleiotropy is uncorrelated with instrument strength (the “InSIDE” assumption).
print(mr_egger)function (bx, by, sy)
{
s <- sign(bx)
s[s == 0] <- 1
bxp <- bx * s
byp <- by * s
w <- 1/sy^2
X <- cbind(1, bxp)
WX <- X * w
b <- solve(crossprod(X, WX), crossprod(WX, byp))
L <- length(bx)
resid <- byp - as.vector(X %*% b)
s2 <- sum(w * resid^2)/(L - 2)
V <- s2 * solve(crossprod(X, WX))
data.frame(term = c("intercept_pleiotropy", "slope_causal"),
estimate = as.numeric(b), se = sqrt(diag(V)), pval = 2 *
pt(abs(as.numeric(b)/sqrt(diag(V))), df = L - 2,
lower.tail = FALSE))
}
<bytecode: 0x1294eb078>
egg <- res$directional$egg
egg| term | estimate | se | pval | |
|---|---|---|---|---|
| intercept_pleiotropy | 0.0541385 | 0.0226841 | 0.0202865 | |
| bxp | slope_causal | 0.3550584 | 0.0666029 | 0.0000017 |
In the directional scenario the Egger slope comes back to about 0.36, close to the true 0.35, while IVW was stuck up near 0.5. The intercept, at roughly 0.05 against essentially zero under valid instruments, is no longer null. That is the correct flag: something pleiotropic is going on.
Here the intercept reaches significance, helped by having sixty instruments with a wide spread of strengths. Do not generalise from that. MR-Egger’s intercept test is notoriously underpowered with fewer variants or little variation in instrument strength, so a non-significant intercept is not reassurance that pleiotropy is absent. Read a non-zero point estimate as the warning sign, and never treat a null intercept as a clean bill of health.
6.4 The weighted median: a different kind of robustness
MR-Egger buys robustness by changing the model. The weighted median (Bowden et al. 2016) buys it by changing the summary statistic. Take all the per-variant Wald ratios, weight them, and report their weighted median instead of their weighted mean. A median ignores extreme values, so the estimate stays consistent as long as variants making up at least half the weight are valid, even if you have no idea which ones are the bad ones.
wm <- res$directional$wm
sprintf("Weighted median (directional): %.3f (95%% CI %.3f to %.3f)",
wm$estimate, wm$ci[1], wm$ci[2])[1] "Weighted median (directional): 0.423 (95% CI 0.369 to 0.477)"
It lands between the badly-biased IVW and the truth. That is typical: the weighted median and MR-Egger lean on different assumptions, so they fail in different ways. When they agree, you can believe the answer; when they diverge, you have learned that the result is fragile. That agreement-or-not is the real output of a sensitivity analysis, more than any single number.
6.5 Seeing all three at once
r <- res$directional
d <- data.frame(bx = r$bx, by = r$by, w = 1 / r$sy^2,
invalid = seq_along(r$bx) %in% dir$params$invalid)
b0 <- r$egg$estimate[1]; b1 <- r$egg$estimate[2]
# egger fit was oriented on positive bx; recover display intercept/slope
ggplot(d, aes(bx, by)) +
geom_hline(yintercept = 0, colour = mrcol("grey"), linewidth = 0.3) +
geom_vline(xintercept = 0, colour = mrcol("grey"), linewidth = 0.3) +
geom_abline(aes(slope = dir$params$theta, intercept = 0, colour = "Truth"),
linetype = "22", linewidth = 0.9) +
geom_abline(aes(slope = r$ivw$estimate, intercept = 0, colour = "IVW (through origin)"),
linewidth = 1) +
geom_abline(aes(slope = b1, intercept = b0, colour = "MR-Egger (free intercept)"),
linewidth = 1) +
geom_point(aes(size = w, shape = invalid), colour = mrcol("blue"), alpha = 0.75) +
scale_shape_manual(values = c(`FALSE` = 16, `TRUE` = 17),
labels = c("valid", "pleiotropic"), name = NULL) +
scale_size_continuous(range = c(1.5, 5), guide = "none") +
scale_colour_manual(values = c("Truth" = mrcol("green"),
"IVW (through origin)" = mrcol("red"),
"MR-Egger (free intercept)" = mrcol("amber")),
name = NULL) +
labs(title = "How directional pleiotropy fools IVW but not MR-Egger",
x = "SNP → exposure association (bx)", y = "SNP → outcome association (by)") +
theme_mr() +
guides(colour = guide_legend(order = 1), shape = guide_legend(order = 2))
6.6 Leave-one-out: is one variant driving everything?
A final, cheap diagnostic: drop each variant in turn and recompute IVW. If one variant’s removal swings the estimate, your result is hostage to that single instrument and deserves suspicion.
loo <- sapply(seq_along(r$bx), \(i) mr_ivw(r$bx[-i], r$by[-i], r$sy[-i])$estimate)
dl <- data.frame(dropped = factor(seq_along(loo)), est = loo)
ggplot(dl, aes(est, dropped)) +
geom_vline(xintercept = r$ivw$estimate, colour = mrcol("red"), linetype = "22") +
geom_vline(xintercept = dir$params$theta, colour = mrcol("green"), linetype = "22") +
geom_point(colour = mrcol("blue"), size = 1.6) +
labs(title = "Leave-one-out IVW estimates",
subtitle = "red = full IVW · green = truth",
x = "IVW estimate with one variant removed", y = "Variant dropped") +
theme_mr() +
theme(axis.text.y = element_text(size = 6))
6.7 Cross-check against MendelianRandomization
library(MendelianRandomization)
obj <- mr_input(bx = r$bx, bxse = rep(0.01, length(r$bx)), by = r$by, byse = r$sy)
pkg_egg <- MendelianRandomization::mr_egger(obj)
data.frame(
quantity = c("Egger slope", "Egger intercept"),
scratch = round(c(r$egg$estimate[2], r$egg$estimate[1]), 4),
package = round(c(pkg_egg$Estimate, pkg_egg$Intercept), 4)
)| quantity | scratch | package |
|---|---|---|
| Egger slope | 0.3551 | 0.3551 |
| Egger intercept | 0.0541 | 0.0541 |
The from-scratch MR-Egger matches the package on both the slope and the intercept. We have now built, and validated, the core toolkit of applied MR. Chapter 7 turns it around: how to use these ideas to read someone else’s MR paper with a critical eye.