Control sintético en R

class: title-slide

.title[
# Clase 26. Control sintético en R
]
.subtitle[
## Evaluación de Programas
]
.author[
### Irvin Rojas <br> [rojasirvin.com](https://www.rojasirvin.com/) <br> [<i class="fab fa-github"></i>](https://github.com/rojasirvin) [<i class="fab fa-twitter"></i>](https://twitter.com/RojasIrvin) [<i class="ai ai-google-scholar"></i>](https://scholar.google.com/citations?user=FUwdSTMAAAAJ&hl=en)
]

.affiliation[
### Centro de Investigación y Docencia Económicas <br> División de Economía
]

---

# Proposición 99

- Usamos los datos del estudio sobre la proposición 99 Abadie, Diamond y Hainmueller (2010)

- Tenemos un panel de estados de 1970 a 2000

- La intervención ocurrió en California (el estado 3) en 1989

- Noten que tenemos NA para varios periodos en las variables que usamos para hacer el ajuste del CS, lo cual no será un problema

```r
panel.ca <- as.data.frame(read_csv("./california_panel.csv"))

head(panel.ca)
```

```
##   state_id   state year cigsale lnincome beer age15to24 retprice
## 1        1 Alabama 1970    89.8       NA   NA 0.1788618     39.6
## 2        1 Alabama 1971    95.4       NA   NA 0.1799278     42.7
## 3        1 Alabama 1972   101.1 9.498476   NA 0.1809939     42.3
## 4        1 Alabama 1973   102.9 9.550107   NA 0.1820599     42.1
## 5        1 Alabama 1974   108.2 9.537163   NA 0.1831260     43.1
## 6        1 Alabama 1975   111.7 9.540031   NA 0.1841921     46.6
```

---

# Formato de datos

.pull-left[
- Usaremos varias funciones incluidas en el paquete *Synth*, desarrollado por Hainmueller & Diamond

- Asegúrense de tener también la librería *reshape2*, que usaremos para manipular los datos en panel

- Para ejecutar el proceso de optimizaición, debemos de poner los datos en el formato apropiado, partiendo del panel *long*

- La mayoría de los insumos necesarios tienen nombres autoexplicados

- Especificamos las variables del panel que identifican a los estados (**state_id**) y al tiempo (**year**)
]

.pull-right[

```r
dataprep.out <-
  dataprep(panel.ca,
           predictors= c("lnincome", "beer", "age15to24","retprice"),
           predictors.op = c("mean"),
           dependent = c("cigsale"),
           unit.variable = c("state_id"),
           time.variable = c("year"),
           special.predictors = list(
             list("cigsale",1975,c("mean")),
             list("cigsale",1980,c("mean")),
             list("cigsale",1988,c("mean"))),
           treatment.identifier = 3,
           controls.identifier = c(1:2,4:39),
           time.predictors.prior = c(1980:1988),
           time.optimize.ssr = c(1970:1988),
           unit.names.variable = c("state"),
           time.plot = c(1970:2000))
```
]

---

# Formato de datos

.pull-left[
- Los predictores entrarán como un promedio de los valores para cada unidad de 1980 a 1988

- Los predictores especiales en este caso son tres puntos pre intervención de la variable de resultados (1975, 1980 y 1988)

- Especificamos quién es la unidad tratada (3) y quiénes los donantes (del 1 al 2 y del 4 al 39)

- El proceso de optimización para obtener `$V$` minimizará los errores cuadráticos de la variable de resultados y su contraparte ajustada de 1970 a 1988

]

.pull-right[

---

# Estimación

.pull-left[
- El procedimiento anterior genera una lista (*dataprep.out*) con los ingredientes necesarios para estimar el control sintético usando la función *synth*

- Ponemos los resultados en tabla usando *synth.tab*

```r
synth.out <- synth(data.prep.obj = dataprep.out)

synth.tables <- synth.tab(dataprep.res = dataprep.out,
                          synth.res = synth.out) 
```
]

.pull-right[
- Podemos ver los resultados de los pesos en la matriz `$V$`

- Estos pesos indican la importancia relativa de los predictores

.tiny[

```r
print(synth.tables$tab.v)
```

```
##                      v.weights
## lnincome             0.001    
## beer                 0.012    
## age15to24            0.003    
## retprice             0.031    
## special.cigsale.1975 0.493    
## special.cigsale.1980 0.392    
## special.cigsale.1988 0.068
```
]
]
---

# Estimación

- La matriz `$W$` nos indica el peso que tiene cada una de las unidades del *grupo donador* para construir el CS

.tiny[

```r
print(synth.tables$tab.w[1:10,])
```

```
##    w.weights  unit.names unit.numbers
## 1      0.000     Alabama            1
## 2      0.000    Arkansas            2
## 4      0.175    Colorado            4
## 5      0.062 Connecticut            5
## 6      0.000    Delaware            6
## 7      0.000     Georgia            7
## 8      0.001       Idaho            8
## 9      0.000    Illinois            9
## 10     0.000     Indiana           10
## 11     0.000        Iowa           11
```
]

---

# Estimación

.pull-left[
- Podemos ver cómo se compara la unidad tratada con su contraparte sintética y con el promedio de unidades del grupo donador
]

.pull-right[
.tiny[

```r
print(synth.tables$tab.pred)
```

```
##                      Treated Synthetic Sample Mean
## lnincome              10.077     9.859       9.829
## beer                  24.280    24.095      23.655
## age15to24              0.174     0.174       0.173
## retprice              89.422    89.318      87.266
## special.cigsale.1975 127.100   126.897     136.932
## special.cigsale.1980 120.200   120.248     138.089
## special.cigsale.1988  90.100    91.432     113.824
```
]
]

---

# Gráfica de series de tiempo

.pull-left[
- Una de las formas más claras de presentar los resultados es mostrando las trayectorias realizada y sintética de la unidad tratada

```r
path.plot(synth.res = synth.out,
          dataprep.res = dataprep.out,
          tr.intake = 1989,
          Ylab = c("per-capita cigarette sales (in packs)"),
          Xlab = c("year"), 
          Ylim = c(0,140), 
          Legend = c("California","synthetic California")) 
```
]

.pull-right[
<img src="figures/unnamed-chunk-10-1.png" width="100%" />
]
---

# Brechas

.pull-left[
- El gráfico de las brechas nos permite visualizar más fácilmente el efecto del tratamiento

- La brecha es simplemente la distancia entre la trayectoria realizada y el control sintético

```r
gaps.plot(synth.res = synth.out,
          dataprep.res = dataprep.out,
          tr.intake = 1989,
          Ylab = c("per-capita cigarette sales (in packs)"),
          Xlab = c("year"), 
          Ylim = c(-30,30))
```
]

.pull-right[
<img src="figures/unnamed-chunk-12-1.png" width="100%" />
]

---

# Gráficas *a mano*

.pull-left[
- Podemos recuperar los productos de las estimaciones y realizar las mismas gráficas *a mano*

- Esto nos será útil no solo para saber exactamente qué estamos graficando, sino para hacer el estudio placebo
]

.pull-right[

```r
#Unidad sintética
Ys <- dataprep.out$Y0plot %*% synth.out$solution.w
                    
#Unidad verdadera
Y1 <- dataprep.out$Y1plot

#Creamos un data frame
data.plot <- as.data.frame(cbind(Y1,Ys))
colnames(data.plot) <- c("Y1","Ys")
data.plot <- data.plot %>% 
  mutate(year=seq(from=1970, to=2000))
```
]

---

# Gráficas *a mano*

.pull-left[

```r
#Gráfico de series
data.plot %>% 
  ggplot()+
  geom_line(aes(y=Y1,x=year)) +
  geom_line(aes(y=Ys,x=year), linetype = "dashed")+
  ylab("per-capita cigarette sales (in packs)")+
  xlab("year")+
  geom_vline(xintercept=1988, color = "black", size=1, linetype="dashed")+
  scale_y_continuous(breaks = seq(0,140,20))+
  scale_x_continuous(breaks=seq(1970, 2000, 5))
```
]

.pull-right[
<img src="figures/unnamed-chunk-15-1.png" width="100%" />
]

---
  
# Gráficas *a mano*
  
.pull-left[
- Para la gráfica de la brecha simplemente calculamos primero dicha brecha

```r
data.plot <- data.plot %>% 
mutate(gap=Y1-Ys)
```

- Y construimos la gráfica

```r
data.plot %>% 
ggplot()+
geom_line(aes(y=gap,x=year)) +
ylab("per-capita cigarette sales (in packs)")+
xlab("year")+
geom_vline(xintercept=1988, color = "black", size=1, linetype="dashed")+
geom_hline(yintercept=0, color = "black", size=1, linetype="dashed")+
scale_y_continuous(breaks = seq(-30,30,10))+
scale_x_continuous(breaks=seq(1970, 2000, 5))
```
]

.pull-right[
<img src="figures/unnamed-chunk-18-1.png" width="100%" />
]

---

# Inferencia usando placebos

.pull-left[
- El estudio placebo consiste en estimar un control sintético para cada una de las unidades del grupo donador

- Asumimos que en dichas unidades **no** hubo una ley contra el tabaco, por lo que esperamos no ver efectos en el consumo de cigarros

- Queremos ver qué tan común sería ver el efecto estimado para California con nuestra estrategia empírica

- Inicio creando un data frame para guardar los 39 placebos (39 series de 31 años)

```r
placebos <- data.frame(matrix(ncol = 39, nrow = 31))
```
]

.pull-right[
- Después realizamos exactamente la misma tarea para cada uno de los estados no tratados (y para California, para facilitar el manejo de los resultados)

- Aquí veamos el script del laboratorio

]

---

# Inferencia usando placebos

.pull-left[
- El resultado es un panel *long* de unidades placebo

- Replicamos la Figura 4

```r
placebos %>%
  filter(cons_synth>-30 & cons_synth<30) %>% 
  ggplot(aes(x=year, y=cons_synth, group=state, linetype=treated, color=treated))+
  geom_line()+
  scale_linetype_manual(values=c("solid", "solid"))+
  scale_color_manual(values=c("grey","black")) +
  ylab("per-capita cigarette sales (in packs)")+
  xlab("year")+
  geom_vline(xintercept=1988, color = "black", size=.5, linetype="dashed")+
  geom_hline(yintercept=0, color = "black", size=.5, linetype="dashed")+
  scale_y_continuous(breaks = seq(-30,30,10))+
  scale_x_continuous(breaks=seq(1970, 2000, 5))+
  theme(legend.title = element_blank(),
        legend.position = c(.14, .90),
        legend.box.background = element_rect(color="black", size=.3),
        legend.box.margin = margin(1, 1, 1, 1))
```
]

.pull-right[
<img src="figures/unnamed-chunk-22-1.png" width="100%" />
]

---

# Recomendación

- Vale la pena este tutorial directamente del padre del control sintético

.center[
<iframe width="560" height="315" src="https://www.youtube.com/embed/3YgV2LYYZc0?controls=0" title="YouTube video player" frameborder="0" allow="accelerometer; autoplay; clipboard-write; encrypted-media; gyroscope; picture-in-picture" allowfullscreen></iframe>
]

---

# Próxima sesión

- La siguiente semana hablaremos sobre modelos econométricos estructurales aplicados a evaluación

- Low, H., & Meghir, C. (2017). The use of structural models in econometrics. *Journal of Economic Perspectives*, 31(2), 33-58.

- El jueves tendremos una presentación basada en

- Attanasio, O. P., Meghir, C., & Santiago, A. (2011). Education choices in Mexico: using a structural model and a randomized experiment to evaluate Progresa. *The Review of Economic Studies*, 79(1), 37-66.

---

class: center, middle

Presentación creada usando el paquete [**xaringan**](https://github.com/yihui/xaringan) en R.

El *chakra* viene de [remark.js](https://remarkjs.com), [**knitr**](http://yihui.org/knitr), y [R Markdown](https://rmarkdown.rstudio.com).

Material de clase en versión preliminar.

**No reproducir, no distribuir, no citar.**