Utilizo a base de Lee, Moretti e Butler. A running variable
é a parcela de votos democratas na eleição anterior
(lagdemvoteshare); o limiar é \(c
= 0{,}5\) e o tratamento é a vitória democrata em \(t-1\) (lagdemocrat). Como cada
id identifica uma única observação, o agrupamento por
id coincide numericamente com o erro-padrão robusto HC0 — é
assim que o reporto a seguir.
lmb <- readr::read_csv(file.path(dir_dados, "lmb-data.csv"), show_col_types = FALSE) |>
dplyr::filter(!is.na(lagdemvoteshare))
stopifnot(all(lmb$lagdemocrat == as.integer(lmb$lagdemvoteshare >= 0.5)))
A regressão local linear inclui a running variable
centrada e sua interação com o tratamento em cada lado do limiar; o
coeficiente do tratamento é o salto em \(c\). Os desfechos são o ADA futuro
(score, período \(t\)), o
ADA contemporâneo (lagscore, período \(t-1\)) e a incumbência
(democrat).
desfechos <- c(score = "ADA futuro (t)",
lagscore = "ADA contemporaneo (t-1)",
democrat = "Incumbencia (vitoria dem. em t)")
q1 <- purrr::map_dfr(c(0.05, 0.10), function(h)
purrr::imap_dfr(desfechos, function(rotulo, y) {
r <- rd_local_linear(lmb, y, h)
tibble::tibble(h = h, Desfecho = rotulo, `Salto RD` = r$tau,
`EP (HC0)` = r$ep, t = r$t, n = r$n)
}))
knitr::kable(q1, digits = 3, caption = "Q1: estimativas RD local-lineares")
| h | Desfecho | Salto RD | EP (HC0) | t | n |
|---|---|---|---|---|---|
| 0.05 | ADA futuro (t) | 19.823 | 2.433 | 8.146 | 2441 |
| 0.05 | ADA contemporaneo (t-1) | 50.205 | 1.760 | 28.530 | 2441 |
| 0.05 | Incumbencia (vitoria dem. em t) | 0.418 | 0.036 | 11.718 | 2441 |
| 0.10 | ADA futuro (t) | 17.664 | 1.676 | 10.539 | 4787 |
| 0.10 | ADA contemporaneo (t-1) | 49.090 | 1.209 | 40.619 | 4787 |
| 0.10 | Incumbencia (vitoria dem. em t) | 0.424 | 0.024 | 17.551 | 4787 |
O salto sobre o ADA futuro é de cerca de 18 a 20 pontos: representantes que conquistam a cadeira numa eleição apertada votam, no período seguinte, de forma substancialmente mais alinhada à agenda liberal — é o efeito “elege” de Lee, Moretti e Butler. O salto sobre o ADA contemporâneo (~49–50 pontos) é muito maior porque, condicionando a uma vitória democrata por margem mínima em \(t-1\), o titular daquele período literalmente é democrata: o coeficiente recupera quase toda a distância partidária no padrão de votação. A incumbência salta ~0,42: vencer por pouco eleva em ~42 pontos percentuais a probabilidade de o partido vencer de novo na eleição seguinte (vantagem do incumbente). As conclusões não mudam entre \(h = 0{,}05\) e \(h = 0{,}10\): sinais, magnitudes e significância são estáveis (a estimativa do ADA futuro cai apenas de ~19,8 para ~17,7, dentro da margem de erro), o que é um primeiro sinal de robustez.
Os números podem divergir das tabelas do livro de Cunningham porque ali a especificação é diferente: aquelas tabelas usam, em boa parte, uma janela ampla/o suporte inteiro com polinômio global e, em outra, a versão local com banda própria. Minha estimativa restringe-se a uma janela estreita em torno do limiar com polinômio de 1ª ordem e kernel uniforme. Como a identificação em RD é local — baseia-se na continuidade das funções de resposta em \(c\) —, considero a versão local (banda pequena, polinômio baixo) mais apropriada: ela usa apenas a informação próxima ao limiar e impõe menos estrutura funcional, ao custo de mais variância. Estimativas de janela larga com polinômios altos tendem a ser contaminadas por observações distantes do corte.
roda_rd <- function(y, run = "lagdemvoteshare")
rdrobust::rdrobust(lmb[[y]], lmb[[run]], c = 0.5, p = 1, kernel = "triangular",
bwselect = "mserd", cluster = lmb$id, vce = "hc0")
rd_score <- roda_rd("score"); rd_lag <- roda_rd("lagscore"); rd_dem <- roda_rd("democrat")
conv <- function(m, r) tibble::tibble(Desfecho = r, `Salto RD (conv.)` = m$coef[1],
`EP (HC0)` = m$se[1], `Banda h` = m$bws[1,1])
q2 <- dplyr::bind_rows(conv(rd_score,"ADA futuro (t)"),
conv(rd_lag,"ADA contemporaneo (t-1)"),
conv(rd_dem,"Incumbencia (vitoria dem. em t)"))
knitr::kable(q2, digits = 3, caption = "Q2: rdrobust, estimativa convencional")
| Desfecho | Salto RD (conv.) | EP (HC0) | Banda h |
|---|---|---|---|
| ADA futuro (t) | 18.575 | 2.001 | 0.088 |
| ADA contemporaneo (t-1) | 49.258 | 1.287 | 0.107 |
| Incumbencia (vitoria dem. em t) | 0.424 | 0.030 | 0.088 |
grafico_rd(lmb, "score", rd_score$bws[1,1], titulo = "Score ADA no período t (futuro)",
eixo_y = "Score ADA (t)", eixo_x = "Votos democratas em t-1",
tau = rd_score$coef[1], ep = rd_score$se[1])
grafico_rd(lmb, "lagscore", rd_lag$bws[1,1], titulo = "Score ADA no período t-1",
eixo_y = "Score ADA (t-1)", eixo_x = "Votos democratas em t-1",
tau = rd_lag$coef[1], ep = rd_lag$se[1])
grafico_rd(lmb, "democrat", rd_dem$bws[1,1], titulo = "Incumbência (vitória dem. em t)",
eixo_y = "Pr(vitória dem. em t)", eixo_x = "Votos democratas em t-1",
tau = rd_dem$coef[1], ep = rd_dem$se[1])
As estimativas convencionais do rdrobustpraticamente
reproduzem as da Q1: ~18,8 (ADA futuro), ~49,2 (contemporâneo) e ~0,43
(incumbência), todas fortemente significantes. A diferença em relação à
Q1 é de método, não de substância: o rdrobust (i) escolhe a
banda de forma endógena pelo critério de erro quadrático médio, em vez
de fixá-la em 0,05/0,10; (ii) usa kernel triangular,
que dá mais peso às observações próximas ao corte; e (iii) acompanha a
estimativa convencional de versões robustas a viés. O fato de os pontos
serem essencialmente os mesmos sob esquemas de ponderação e seleção de
banda distintos reforça a robustez do desenho.
O teste investiga manipulação/ordenamento da running variable: se agentes conseguissem se posicionar de propósito de um dos lados do limiar, a densidade saltaria em \(c\) e a hipótese de continuidade (logo, a comparação causal local) ficaria comprometida. O teste compara a densidade estimada imediatamente à esquerda e à direita de 0,5.
dens <- rddensity::rddensity(X = lmb$lagdemvoteshare, c = 0.5)
summary(dens)
##
## Manipulation testing using local polynomial density estimation.
##
## Number of obs = 13577
## Model = unrestricted
## Kernel = triangular
## BW method = estimated
## VCE method = jackknife
##
## c = 0.5 Left of c Right of c
## Number of obs 5670 7907
## Eff. Number of obs 1856 2161
## Order est. (p) 2 2
## Order bias (q) 3 3
## BW est. (h) 0.073 0.096
##
## Method T P > |T|
## Robust 0.6834 0.4944
##
## P-values of binomial tests (H0: p=0.5).
##
## Window Length / 2 <c >=c P>|T|
## 0.001 21 23 0.8804
## 0.002 55 49 0.6241
## 0.004 72 80 0.5703
## 0.005 89 100 0.4671
## 0.006 112 124 0.4740
## 0.007 141 156 0.4166
## 0.008 166 195 0.1405
## 0.009 192 223 0.1408
## 0.011 228 231 0.9256
## 0.012 276 255 0.3855
rddensity::rdplotdensity(dens, X = lmb$lagdemvoteshare, plotN = 25,
lcol = c(cor_controle, cor_tratamento),
CIcol = c(cor_controle, cor_tratamento))
## $Estl
## Call: lpdensity
##
## Sample size 5670
## Polynomial order for point estimation (p=) 2
## Order of derivative estimated (v=) 1
## Polynomial order for confidence interval (q=) 3
## Kernel function triangular
## Scaling factor 0.417648791985857
## Bandwidth method user provided
##
## Use summary(...) to show estimates.
##
## $Estr
## Call: lpdensity
##
## Sample size 7907
## Polynomial order for point estimation (p=) 2
## Order of derivative estimated (v=) 1
## Polynomial order for confidence interval (q=) 3
## Kernel function triangular
## Scaling factor 0.582424867413082
## Bandwidth method user provided
##
## Use summary(...) to show estimates.
##
## $Estplot
O teste não rejeita a continuidade da densidade em 0,5 (estatística pequena, \(p\)-valor bem acima de 0,10), e o resultado é estável a diferentes bandas de suavização. Não há evidência de que candidatos consigam manipular de forma precisa a margem de vitória — exatamente o que se espera de eleições apertadas, em que o resultado por poucos votos é, na prática, quase-aleatório. O diagnóstico, portanto, sustenta a hipótese de identificação.
rd_placebo <- rdrobust::rdrobust(lmb$lagscore, lmb$demvoteshare, c = 0.5, p = 1,
kernel = "triangular", bwselect = "mserd",
cluster = lmb$id, vce = "hc0")
summary(rd_placebo)
## Call: rdrobust
##
## Sharp RD estimates using local polynomial regression. Std. errors are clustered (13566 clusters).
##
## Number of Obs. 13566
## BW type mserd
## Kernel Triangular
## VCE method CR1
##
## Left Right
## Number of Obs. 5471 8095
## Eff. Number of Obs. 1860 1698
## Order est. (p) 1 1
## Order bias (q) 2 2
## BW est. (h) 0.076 0.076
## BW bias (b) 0.142 0.142
## rho (h/b) 0.533 0.533
## Clusters (g) 5471 8095
## Unique Obs. 2765 3350
##
## =====================================================================
## Point Robust Inference
## Estimate z P>|z| [ 95% C.I. ]
## ---------------------------------------------------------------------
## RD Effect 3.860 1.049 0.294 [-2.482 , 8.196]
## =====================================================================
grafico_rd(lmb, "lagscore", rd_placebo$bws[1,1], run = "demvoteshare",
titulo = "Placebo: ADA passado (t-1) vs. votos em t",
eixo_y = "Score ADA (t-1)", eixo_x = "Votos democratas em t",
tau = rd_placebo$coef[1], ep = rd_placebo$se[1])
Aqui a running variable é o voto em \(t\) e o desfecho é o ADA passado (\(t-1\)). Como uma vitória em \(t\) não pode causar o padrão de votação que já ocorreu em \(t-1\), o salto deveria ser nulo. Na banda ótima o salto é pequeno (~3,5 pontos ADA, contra ~19 e ~50 dos efeitos verdadeiros) e estatisticamente indistinguível de zero aos níveis usuais. Vale registrar que, em bandas largas, esse “salto” cresce, refletindo a forte persistência serial da força partidária do distrito (não uma violação em si); na vizinhança do corte, porém, não há descontinuidade no resultado pré-determinado. O placebo corrobora a estratégia de identificação.
card <- readr::read_csv(file.path(dir_dados, "card.csv"), show_col_types = FALSE) |>
dplyr::mutate(D1 = as.integer(educ >= 12), D2 = as.integer(educ > 12))
covariaveis <- c("exper","expersq","black","south","smsa","smsa66", paste0("reg66", 2:9))
Tomados literalmente, “mais de 12 anos” (D1) e “alguma experiência de
college” (D2) coincidiriam, já que educ é inteiro. Para ter
duas margens distintas, uso \(D_1 =
\mathbf{1}[\text{educ} \ge 12]\) (conclusão do ensino médio) e
\(D_2 = \mathbf{1}[\text{educ} >
12]\) (algum college). O instrumento é nearc4
(presença de faculdade de 4 anos no condado).
medias <- card |> dplyr::group_by(nearc4) |>
dplyr::summarise(lwage = mean(lwage), D1 = mean(D1), D2 = mean(D2),
n = dplyr::n(), .groups = "drop")
knitr::kable(medias, digits = 4, caption = "Q5: médias por status do instrumento")
| nearc4 | lwage | D1 | D2 | n |
|---|---|---|---|---|
| 0 | 6.1555 | 0.7722 | 0.4222 | 957 |
| 1 | 6.3114 | 0.8641 | 0.5441 | 2053 |
m0 <- dplyr::filter(medias, nearc4 == 0); m1 <- dplyr::filter(medias, nearc4 == 1)
itt <- m1$lwage - m0$lwage
fs_D1 <- m1$D1 - m0$D1; fs_D2 <- m1$D2 - m0$D2
tibble::tibble(
Grandeza = c("ITT (forma reduzida)", "1º estágio D1", "1º estágio D2",
"Wald LATE D1", "Wald LATE D2"),
Valor = c(itt, fs_D1, fs_D2, itt/fs_D1, itt/fs_D2)) |>
knitr::kable(digits = 4)
| Grandeza | Valor |
|---|---|
| ITT (forma reduzida) | 0.1559 |
| 1º estágio D1 | 0.0919 |
| 1º estágio D2 | 0.1219 |
| Wald LATE D1 | 1.6966 |
| Wald LATE D2 | 1.2787 |
Quem mora perto de uma faculdade tem lwage ~0,156 maior
(forma reduzida/ITT), completa o ensino médio ~9,2 p.p. mais e cursa
algum college ~12,2 p.p. mais (primeiros estágios). Os LATE de Wald
sem controles resultam (~1,7 e ~1,3 em log-salário),
economicamente implausíveis: sem condicionar nas covariáveis,
nearc4 está confundido com região, urbanidade e origem
familiar, de modo que a forma reduzida superestima o efeito. Isso motiva
a inclusão das covariáveis a seguir.
fs <- function(d) estimatr::lm_robust(stats::reformulate(c("nearc4", covariaveis), d),
data = card, se_type = "HC1")
fs1 <- fs("D1"); fs2 <- fs("D2")
resumo <- function(m, r) tibble::tibble(Tratamento = r,
`Coef. nearc4` = m$coefficients["nearc4"], `EP (HC1)` = m$std.error["nearc4"],
t = m$coefficients["nearc4"]/m$std.error["nearc4"],
`F robusta` = (m$coefficients["nearc4"]/m$std.error["nearc4"])^2)
dplyr::bind_rows(resumo(fs1,"D1 (educ>=12)"), resumo(fs2,"D2 (educ>12)")) |>
knitr::kable(digits = 4, caption = "Q6: primeiro estágio")
| Tratamento | Coef. nearc4 | EP (HC1) | t | F robusta |
|---|---|---|---|---|
| D1 (educ>=12) | 0.0267 | 0.0137 | 1.9446 | 3.7814 |
| D2 (educ>12) | 0.0636 | 0.0180 | 3.5293 | 12.4559 |
Com as covariáveis, o instrumento move pouco a margem do ensino
médio: para \(D_1\) o coeficiente de
nearc4 é ~0,027 (\(t \approx
1{,}9\), \(F \approx 3{,}8\)),
abaixo da regra prática \(F
> 10\) — instrumento fraco para \(D_1\). Já para \(D_2\) (algum college) o coeficiente é
~0,064 (\(t \approx 3{,}5\), \(F \approx 12{,}5\)), claramente relevante.
Faz sentido econômico: proximidade de uma faculdade de 4 anos afeta
sobretudo a decisão de ingressar no ensino superior,
não a de concluir o ensino médio.
iv <- function(trat) estimatr::iv_robust(stats::as.formula(paste0(
"lwage ~ ", trat, " + ", paste(covariaveis, collapse=" + "),
" | nearc4 + ", paste(covariaveis, collapse=" + "))), data = card, se_type = "HC1")
iv1 <- iv("D1"); iv2 <- iv("D2")
tibble::tibble(
Tratamento = c("D1 (educ>=12)", "D2 (educ>12)"),
`LATE (2SLS)` = c(iv1$coefficients["D1"], iv2$coefficients["D2"]),
`EP (HC1)` = c(iv1$std.error["D1"], iv2$std.error["D2"]),
t = c(iv1$coefficients["D1"]/iv1$std.error["D1"],
iv2$coefficients["D2"]/iv2$std.error["D2"])) |>
knitr::kable(digits = 4, caption = "Q7: MQ2E/2SLS")
| Tratamento | LATE (2SLS) | EP (HC1) | t |
|---|---|---|---|
| D1 (educ>=12) | 1.5779 | 0.9413 | 1.6762 |
| D2 (educ>12) | 0.6613 | 0.2950 | 2.2417 |
Para \(D_2\) (algum college), o LATE 2SLS é ~0,66 log-pontos, significante (\(t \approx 2{,}2\)): para os compliers induzidos a entrar na faculdade pela proximidade geográfica, cursar algum college eleva substancialmente o salário. A magnitude é alta porque (i) o tratamento é binário e absorve vários anos de estudo e (ii) o LATE refere-se a uma subpopulação específica de compliers, com retorno provavelmente acima da média. Para \(D_1\), o LATE 2SLS é ~1,58 com EP muito grande (\(t \approx 1{,}7\)): economicamente exacerbado e não confiável, sintoma direto do primeiro estágio fraco da Q6 (viés de instrumento fraco e imprecisão). A conclusão é que o instrumento de Card identifica um efeito crível apenas na margem que ele de fato desloca — o ingresso no ensino superior (\(D_2\)) —, e não na conclusão do ensino médio (\(D_1\)). Sempre que se interpreta um 2SLS, é o primeiro estágio que diz se a estimativa merece crédito.