Estimação em Diff-in-Diff (DID) usam quatro pontos de dados para deduzir o impacto de uma mudança política ou algum outro choque na população tratada: o efeito do tratamento sobre o tratado. A estrutura do experimento implica que o grupo de tratamento e de controle tem características similares e possuem uma tendência semelhante ao longo do tempo. Isso significa que o contrafactual é tal que, tivesse o grupo tratamento não recebido o tratamento, seu valor médio poderia ter a mesma distância do grupo de controle no segundo período.
O banco de dados eitc.dta é sobre a expansão do Earned Income Tax Credit, que é uma legislação que fornece uma redução de impostos para indivíduos de baixa renda.
Importando os dados com a library foreign:
data <- foreign::read.dta("eitc.dta")
head(as_tibble(data),10)
## # A tibble: 10 x 11
## state year urate children nonwhite finc earn age ed work
## <dbl> <dbl> <dbl> <int> <int> <dbl> <dbl> <int> <int> <int>
## 1 11.0 1991 7.60 0 1 18714 18714 26 10 1
## 2 12.0 1991 7.20 1 0 4839 471 22 9 1
## 3 13.0 1991 6.40 2 0 8178 0 33 11 0
## 4 14.0 1991 9.10 0 1 9370 0 43 11 0
## 5 15.0 1991 8.60 3 1 14707 14707 23 7 1
## 6 16.0 1991 6.80 1 0 21605 18855 53 7 1
## 7 21.0 1991 7.30 0 1 19147 14141 52 11 1
## 8 22.0 1991 6.70 0 1 64312 63803 51 11 1
## 9 23.0 1991 7.00 1 1 17676 17676 20 11 1
## 10 31.0 1991 6.40 2 1 12214 2358 32 11 1
## # ... with 1 more variable: unearn <dbl>
psych::describe(data)
## vars n mean sd median trimmed mad min
## state 1 13746 54.52 27.13 56.00 54.42 37.06 11.0
## year 2 13746 1993.35 1.70 1993.00 1993.31 1.48 1991.0
## urate 3 13746 6.76 1.46 6.80 6.76 1.48 2.6
## children 4 13746 1.19 1.38 1.00 0.98 1.48 0.0
## nonwhite 5 13746 0.60 0.49 1.00 0.63 0.00 0.0
## finc 6 13746 15255.32 19444.25 9636.66 11816.27 8598.03 0.0
## earn 7 13746 10432.48 18200.76 3332.18 6723.97 4940.29 0.0
## age 8 13746 35.21 10.16 34.00 34.88 13.34 20.0
## ed 9 13746 8.81 2.64 10.00 9.30 1.48 0.0
## work 10 13746 0.51 0.50 1.00 0.52 0.00 0.0
## unearn 11 13746 4.82 7.12 2.97 3.53 4.41 0.0
## max range skew kurtosis se
## state 95.00 84.00 0.04 -1.38 0.23
## year 1996.00 5.00 0.11 -1.25 0.01
## urate 11.40 8.80 -0.03 -0.19 0.01
## children 9.00 9.00 1.28 1.85 0.01
## nonwhite 1.00 1.00 -0.41 -1.83 0.00
## finc 575616.82 575616.82 7.06 131.59 165.85
## earn 537880.61 537880.61 6.76 121.51 155.24
## age 54.00 34.00 0.22 -1.14 0.09
## ed 11.00 11.00 -1.64 2.54 0.02
## work 1.00 1.00 -0.05 -2.00 0.00
## unearn 134.06 134.06 4.98 50.79 0.06
Podemos criar duas variáveis dummy para indicar os quatro pontos de dados: antes/depois e tratamento/controle. Como a política de EITC foi iniciada em 1994, usaremos essa data para separar o antes/depois. Por fim, como o EITC apenas afeta mulheres com no mínimo uma criança, o grupo de tratamento serão todas as mulheres com crianças.
data <- data %>%
mutate(post93 = as.numeric(year>=1994),
anykids = as.numeric(children>=1))
## Warning: package 'bindrcpp' was built under R version 3.4.4
Os pontos a e b denotam as médias de emprego das mulheres no período anterior a 1993 para o grupo de controle e tratamento:
a<-data %>%
filter(post93==0 & anykids==0) %>%
select(work) %>%
summarise_all(mean)
b<-data %>%
filter(post93==0 & anykids==1) %>%
select(work) %>%
summarise_all(mean)
Por fim, c e d se referem ao período pós implantação do programa:
c<-data %>%
filter(post93==1 & anykids==0) %>%
select(work) %>%
summarise_all(mean)
d<-data %>%
filter(post93==1 & anykids==1) %>%
select(work) %>%
summarise_all(mean)
Assim, a estimativa DID incondicional do efeito da política EITC 1993 sobre o emprego das mulheres é dado por: \((d-c)-(b-a)\).
(d-c)-(b-a)
## work
## 1 0.04687313
O que pode levar a crer que a política elevou o emprego entre as mulheres tratadas em 4%.
diagram <- data.frame(
Time=factor(c("Before", "After")),
Control =c(a$work, c$work),
Treatment=c(b$work,d$work)
)
diagram
## Time Control Treatment
## 1 Before 0.5754597 0.4459619
## 2 After 0.5733862 0.4907615
p<-ggplot(data=diagram)+
geom_point(aes(x=reorder(Time,desc(Time)), y=Control),colour="red")+
geom_point(aes(x=reorder(Time,desc(Time)), y=Treatment),colour="blue")+
ylab("Unemployment")
p
Mesmo gráfico com dados para cada ano:
treatment<-data %>% group_by(year) %>%
filter(anykids==1) %>%
select(work) %>%
summarise(work = mean(work))
## Adding missing grouping variables: `year`
treatment
## # A tibble: 6 x 2
## year work
## <dbl> <dbl>
## 1 1991 0.460
## 2 1992 0.439
## 3 1993 0.438
## 4 1994 0.464
## 5 1995 0.508
## 6 1996 0.503
control<-data %>% group_by(year) %>%
filter(anykids==0) %>%
select(work) %>%
summarise(work = mean(work))
## Adding missing grouping variables: `year`
control
## # A tibble: 6 x 2
## year work
## <dbl> <dbl>
## 1 1991 0.583
## 2 1992 0.572
## 3 1993 0.571
## 4 1994 0.591
## 5 1995 0.574
## 6 1996 0.552
data_graph = left_join(control, treatment, by="year")
colnames(data_graph)<-c("year","control", "treament")
q<-ggplot(data=data_graph)+
geom_line(aes(x=year, y=treament), colour="blue")+
geom_point(aes(x=year, y=treament))+
geom_line(aes(x=year, y=control),colour="red") +
geom_point(aes(x=year, y=control))
q
Agora podemos rodar uma regressão para estimar a estimativa DID condicionada do efeito do EITC sobre o emprego das mulheres, usando mulheres com crianças como o grupo de tratamento.
\[\text{work} = \beta_0+\delta_0\text{post93}+\beta_1\text{anykids}+\delta_1\text{(anykids}\times\text{post93)}+\epsilon\] onde \(\epsilon\) é o termo de erro, \(\delta_1\) é o efeito do tratamento no tratado – o shift exibido no diagrama. Para ser mais claro, \(\text{(anykids}\times\text{post93)}\) é o valor que estamos interessados.
data$interaction_term <- data$post93*data$anykids
reg1<-lm(work ~post93+anykids+interaction_term, data=data)
summary(reg1)
##
## Call:
## lm(formula = work ~ post93 + anykids + interaction_term, data = data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.5755 -0.4908 0.4245 0.5092 0.5540
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.575460 0.008845 65.060 < 2e-16 ***
## post93 -0.002074 0.012931 -0.160 0.87261
## anykids -0.129498 0.011676 -11.091 < 2e-16 ***
## interaction_term 0.046873 0.017158 2.732 0.00631 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.4967 on 13742 degrees of freedom
## Multiple R-squared: 0.0126, Adjusted R-squared: 0.01238
## F-statistic: 58.45 on 3 and 13742 DF, p-value: < 2.2e-16
O valor estimado para interaction_term deve ser igual ao valor calculador acima \((d-c)-(b-a)\).