Taller 3: Analizando datos de experimentos reales

Carlos Daboin Contreras

2023-10-01

Resumen de contenido

La meta de hoy

  • Analizaremos a fondo los datos de un experimento.

  • Repasaremos lo aprendido en talleres anteriores sobre limpieza y análisis de datos, con énfasis en lo primero.

  • Usaremos el análisis de regresión para hacer pruebas de balanceo y replicar resultados principales.

Conceptos

  • Exogeneidad.
  • Experimentos.
  • Fuga (Attrition).
  • Prueba de Balanceo (Balancing Test).

Herramientas

  • skim::skimr: Función para revisar estadísticas de distribución y conteo de missing values en todas las columnas de un tibble/data.frame.
  • Funciones: Crearemos una función para abreviar una tarea en código que haremos de forma repetitiva.
  • GT: Librería versátil y práctica para armar tablas elegantes y funcionales.
  • huxtable: Esta librería tiene otras funciones para presentar regresiones. Es otra alternativa a su disposición.
  • zoo::as.yearqtr: Función para calcular la diferencia de tiempo entre trimestres.

Librerías

Usaremos las siguientes librerías:1

library(dplyr)
library(tidyr)
library(ggplot2)
library(gt)
library(huxtable)
library(zoo)

The Tennesse Star Experiment

Contexto

Pregunta: ¿Cual es el efecto del tamaño de la clase sobre el desempeño de los alumnos?

  • Relevancia: Reducir el tamaño de las clases pudiera ser efectivo, pero es costoso.

  • Evidencia previa: Análisis descriptivos encuentran correlación nula entre tamaño de clase y aprendizaje.

  • Endogeneidad: Hay aspectos correlacionados con el aprendizaje que están correlacionados con el tamaño de la clase. Hay sesgo. (p.e Los alumnos de peor conducta tienen peores calificaciones y son puestos en aulas mas pequeñas.)

  • Necesitamos un experimento: la única diferencia entre los alumnos de clases chicas (promedio) y clases grandes (promedio) deberia serel tamano de la clase.

US goverment to the rescue

“The 2002 Education Sciences Reform Act passed by the U.S. Congress mandates the use of rigorous experimental or quasi-experimental research designs for all federally-funded education studies.”

Student Teacher Acvchievment Ratio (STAR) Experiment

  • Pregunta de investigación: ¿La cantidad de docentes en el aula por alumno afectan el aprendizaje en la niñez?

  • Población objetivo: Cohortes de kindergarten 1985-1986 en el estado de Tennesse.

  • Implementación: Duración de 4 años, involucró 11.598 estudiantes, a un costo total de US$12 millones.

Tratamientos

Todas las escuelas implementaron estos tipos de aula:

  • Small classes (13–17 students)
  • Regular classes (22–35 students)
  • Regular classes (22–35 students) plus full-time teacher’s aide

Los estudiantes y profesores fueron asignados a cada sección de forma aleatoria en cada una de las 80 escuelas participantes.

Datos

Revisión de la data

Descarguemos la data desde la libreria AER.

# esta funcion busca datos en las librerias que tengamos abiertas en la sesion,
# los guarda como objetos en nuestro ambiente de trabajo, no hace falta usar <-
data("STAR", package = "AER")

Revisión de la data

Todos los objetos en librerías disponibles en la nube CRAN tienen documentación. Échale un vistazo a la documentación del STAR dataset.

# este código abrirá la documentación del dataset en la pestaña de help.
?"STAR"

Dimensión de los datos

Siempre que abrimos una base de datos nueva debemos preguntarnos por el nivel al que está agregada la información (escuela, profesor, alumno).

# Hechemos un vistazo
dim(STAR) # Tiene 11.598 filas y 47 columnas
[1] 11598    47

  • Vemos que la tabla tiene 11598 filas, igual a la cantidad de estudiantes en el estudio: Cada fila contiene información de un individuo.

  • Moraleja: Chequear las dimensiones nos puede develar mucha información de antemano. No olviden chequearlo.

Estructura de los datos

head(STAR)
gender ethnicity birth stark star1 star2 star3 readk read1 read2 read3 mathk math1 math2 math3 lunchk lunch1 lunch2 lunch3 schoolk school1 school2 school3 degreek degree1 degree2 degree3 ladderk ladder1 ladder2 ladder3 experiencek experience1 experience2 experience3 tethnicityk tethnicity1 tethnicity2 tethnicity3 systemk system1 system2 system3 schoolidk schoolid1 schoolid2 schoolid3
female afam 1979.5 regular 580 564 free suburban bachelor level1 30 cauc 22 54
female cauc 1980 small small small small 447 507 568 587 473 538 579 593 non-free free non-free free rural rural rural rural bachelor bachelor bachelor bachelor level1 level1 apprentice apprentice 7 7 3 1 cauc cauc cauc cauc 30 30 30 30 63 63 63 63
female afam 1979.75 small small regular+aide regular+aide 450 579 588 644 536 592 579 639 non-free non-free non-free suburban suburban suburban suburban bachelor master bachelor bachelor level1 probation level1 level1 21 32 4 4 cauc afam afam cauc 11 11 11 11 20 20 20 20
male cauc 1979.75 small 686 667 non-free rural bachelor level1 10 cauc 6 8
male afam 1980 regular+aide 439 463 free inner-city bachelor probation 0 cauc 11 19
male cauc 1979.5 regular regular 644 648 non-free non-free rural rural bachelor bachelor notladder level1 13 15 cauc cauc 6 6 8 8

Estructura de los datos

Cada fila tiene toda la información de cada estudiante.

  • Esto quiere decir que cada indicador está distribuído a lo largo de cuatro columnas (véase readk, read1, read2, read3, math1m, math2, etc.)

  • No se cumplen los principios tidy.

Queremos hacer una análisis reproducible de los datos y además queremos llegar un estimado global de diferencias en el aprendizaje. Tenemos que poner la data en formato long, o tidy:

  • Observaciónes a nivel estudiante-año, con una columna por indicador de aprendizaje.

Vamos de esto

gender ethnicity birth stark star1 star2 star3 readk read1 read2 read3 mathk math1 math2 math3 lunchk lunch1 lunch2 lunch3 schoolk school1 school2 school3 degreek degree1 degree2 degree3 ladderk ladder1 ladder2 ladder3 experiencek experience1 experience2 experience3 tethnicityk tethnicity1 tethnicity2 tethnicity3 systemk system1 system2 system3 schoolidk schoolid1 schoolid2 schoolid3
female afam 1979.5 regular 580 564 free suburban bachelor level1 30 cauc 22 54
female cauc 1980 small small small small 447 507 568 587 473 538 579 593 non-free free non-free free rural rural rural rural bachelor bachelor bachelor bachelor level1 level1 apprentice apprentice 7 7 3 1 cauc cauc cauc cauc 30 30 30 30 63 63 63 63
female afam 1979.75 small small regular+aide regular+aide 450 579 588 644 536 592 579 639 non-free non-free non-free suburban suburban suburban suburban bachelor master bachelor bachelor level1 probation level1 level1 21 32 4 4 cauc afam afam cauc 11 11 11 11 20 20 20 20
male cauc 1979.75 small 686 667 non-free rural bachelor level1 10 cauc 6 8
male afam 1980 regular+aide 439 463 free inner-city bachelor probation 0 cauc 11 19
male cauc 1979.5 regular regular 644 648 non-free non-free rural rural bachelor bachelor notladder level1 13 15 cauc cauc 6 6 8 8

a esto

id gender ethnicity birth grade star read math lunch schoolid degree ladder experience tethnicity system read_cdf math_cdf
1 female afam 1979 Q3 k           
1 female afam 1979 Q3 1           
1 female afam 1979 Q3 2           
1 female afam 1979 Q3 3 regular 580 564 free 54 bachelor level1 30 cauc 22 0.18  0.0793
2 female cauc 1980 Q1 k small 447 473 non-free 63 bachelor level1 7 cauc 30 0.677 0.41  
2 female cauc 1980 Q1 1 small 507 538 free 63 bachelor level1 7 cauc 30 0.449 0.573 

Uso avanzado de tidyr e introducción a funciones

Presentamos dos maneras de conseguirlo.

Uso avanzado de tidyr

Podemos conseguir nuestro objetivo en 5 líneas de código, pero necesitamos:

  • Uso avanzado de la función pivot_longer().

  • Familiaaridad con expresiones regulares (reprex).1

Uso avanzado de tidyr

STAR_long<-STAR %>%
  mutate(id=1:nrow(STAR)) %>% #creo id de estudiante. Servirá de guia y control
  select(id, everything()) %>% #id va a primera columna
  # Aplico pivot_longer con opciones avanzadas
  ## 1. cols: Traspone todas las columnas entre stark y schoolid3.
  ## 2. names_pattern: identifica el patron en los nombres con regular expressions (regex)
  ## Dile a chatgpt que te muestre ejemplos de palabras con el patron (.*)([k1234])
  ## 3. names to: manda las palabras las palabras (.*: "star", "read", "math" "etc") a su propia columna.
  ## Manda los numeros que corresponden al grado (k,1,2,3)  a columna grade.
  pivot_longer(cols=stark:schoolid3,            # 1
               names_pattern = '(.*)([k1234])', # 2
               names_to = c(".value","grade"))  # 3

Uso avanzado de tidyr

head(STAR_long)
id gender ethnicity birth grade star read math lunch school degree ladder experience tethnicity system schoolid
1 female afam 1979.5 k
1 female afam 1979.5 1
1 female afam 1979.5 2
1 female afam 1979.5 3 regular 580 564 free suburban bachelor level1 30 cauc 22 54
2 female cauc 1980 k small 447 473 non-free rural bachelor level1 7 cauc 30 63
2 female cauc 1980 1 small 507 538 free rural bachelor level1 7 cauc 30 63

Score de aprendizaje

Angrist & Pischke (2008) analizan el efecto del tratamiento sobre un score que promedia las calificaciones de lectura y matemática al final de cada año escolar. Tenemos que crear este score en los datos.

Componentes del score de aprendizaje

Usaremos la función skimr::skim(), para inspeccionar las distribuciones de las variables de interés. Guárdenla para inspeccionar sus bases de datos al inicio de sus proyectos.

# Vemos que en teoria ambos indicadores estan en una escala del 1 al 800
# pero en la practica estos rangos son distintos en cada grado, por eso hay que normalizarlo
# Normalizarlo nos dara resultados mas comparables

skim_summary<-STAR_long %>% 
  group_by(grade) %>% 
  select(read, math) %>% 
  skimr::skim()

Componentes del score de aprendizaje

tibble(skim_summary)
skim_type skim_variable grade n_missing complete_rate numeric.mean numeric.sd numeric.p0 numeric.p25 numeric.p50 numeric.p75 numeric.p100 numeric.hist
numeric read 1 5202 0.551 521 55.2 404 478 514 558 651 ▂▇▇▅▃
numeric read 2 5521 0.524 584 46   468 552 582 614 732 ▂▇▇▃▁
numeric read 3 5598 0.517 615 38.6 499 588 614 641 775 ▁▇▇▂▁
numeric read k 5809 0.499 437 31.7 315 414 433 453 627 ▁▇▅▁▁
numeric math 1 4998 0.569 531 43.1 404 500 529 557 676 ▁▆▇▃▁
numeric math 2 5533 0.523 581 44.6 441 550 579 611 721 ▁▃▇▃▁
numeric math 3 5521 0.524 618 39.8 487 591 616 645 774 ▁▅▇▂▁
numeric math k 5727 0.506 485 47.7 288 454 484 513 626 ▁▁▇▅▂

Creando un score promedio

Normalicemos los scores read y math entre el 0 y 1 a nivel de grado, siguiendo una cdf (funcion de probabilidad acumulada.)1

Luego creemos un score compuesto.

STAR_long<-STAR_long %>% 
  group_by(grade) %>%                    # agrupo por grado
  mutate(read_cdf=percent_rank(read),    # percent_rank devuelve el percentil de cada ob.
         math_cdf=percent_rank(math)) %>%
  ungroup() %>%                          # Desagrupo. No olvidar nunca.
  mutate(score=math_cdf*0.5+read_cdf*0.5,# Calculo el promedio
         score_raw=math*0.5+read*0.5)

El experimento ideal?

Había que mantener un diseño en el que alguién más le dice a un padre el tipo de tratamiento que recibiran sus hijos. Díficil ¿no les parece?

Fallas en el diseño experimental

Los estudiantes debían permanecer en el mismo grupo al que fueron sorteados durante los 4 años del programa. Hubo desviaciones durante la implementación:

  1. Estudiantes de clases “regulares” fueron re-aleatorizados a clases “con ayudante” al principio del primer grado por solicitud de varios padres. Sería un problema si….¿?

  2. Casi 10% de los estudiantes cambiaron entre clases “pequeñas” y “regulares” al pasar de grado por problemas de conducta o solicitud de los padres.

  3. Algunos estudiantes se mudaron durante los años escolares, esto hizo que el tamaño de algunos cursos saliera de lo contemplado (hasta 20 para clases pequeñas y 30 para clases regulares).

  4. Fuga o Attrition: la mitad de los estudiantes que estuvieron presentes en kindergarten salieron eventualmente de la muestra.

Revisemos los datos

Hagamos algunas cuentas para visualizar los problemas anteriores.

Fíjense en los datos del infividuo No 1. ¿Les recuerda a alguno de los problemas anteriores? ¿Cual sería la implicación de incluirlo?

id gender ethnicity birth grade star read math lunch school degree ladder experience tethnicity system schoolid read_cdf math_cdf score score_raw
1 female afam 1979.5 k                
1 female afam 1979.5 1                
1 female afam 1979.5 2                
1 female afam 1979.5 3 regular 580 564 free suburban bachelor level1 30 cauc 22 54 0.18  0.0793 0.13  572
2 female cauc 1980 k small 447 473 non-free rural bachelor level1 7 cauc 30 63 0.677 0.41   0.543 460
2 female cauc 1980 1 small 507 538 free rural bachelor level1 7 cauc 30 63 0.449 0.573  0.511 522

Mudanza de distritos

Cantidad de alumnos que entran o salen de los colegios del programa == Cantidad de individuos con menos de 4 registros en el dataset:

### Contemos la cantidad de individuos que cuentan con menos de 4 registros en la data
in_out_data<-STAR_long %>% 
  # agrupo por individuo y calculo el No. total de periodos que estuvo ausente
  group_by(id) %>% 
  summarise(count=sum(is.na(star))) %>% 
  filter(count>0) 

# 8513 o 18% de los individuos en los datos no estuvo presente durante todo el experimento
print(
  paste(nrow(in_out_data),"filas o",
        round(nrow(in_out_data)/nrow(STAR)*100,1),"% del total") 
  )
[1] "8513 filas o 73.4 % del total"

Cambio de tratamiento entre años escolares

Contemos la cantidad de tratamientos que recibió cada integrante, después veamos cuantos recibieron más de un tratamiento.

tratamientos_por_id<-STAR_long %>% 
  # remuevo individuos que no participaron en el programa ese año
  filter(!is.na(star)) %>% 
  # conservo tratamientos small | regular
  filter(star=="regular" | star=="small") %>% 
  # lista de tratamientos que recibio cada id
  distinct(id, star) %>% 
  # contemos cantidad de tratamientos por individuo
  group_by(id) %>% 
  summarise(count=n())

## Porcentaje de individuos con 1 o 2 tratamientos:
table(tratamientos_por_id$count)/nrow(tratamientos_por_id)*100

        1         2 
92.862216  7.137784

Fuga de la muestra de kindergarden (attrition)

Identifiquemos a los alumnos que fueron tratados en kinder y veamos cuantos de ellos no estuvieron en la muestra de 3er grado.

## Id's de los que participaron desde kindergarden
muestra_kinder<-STAR_long %>%
  filter(grade=="k" & !is.na(star)) %>% 
  distinct(id)

## Id's de los que permanecieron hasta el final del experimento
muestra_kinder_final<-STAR_long %>%
  filter(grade=="3" & !is.na(star)) %>% 
  distinct(id) %>% 
  inner_join(muestra_kinder, by="id")

diferencia<-nrow(muestra_kinder)-nrow(muestra_kinder_final)

#  de 6325 estudiantes que ingresaron en kinder, solo 3234 permanecieon en la muestra  
print(
  paste0(
  "Se salieron ", diferencia,
  " estudiantes, equivalente a ",round(diferencia/nrow(muestra_kinder)*100),"%"
  )
  )
[1] "Se salieron 3091 estudiantes, equivalente a 49%"

Consecuencia

Por estas razones, los resultados principales del paper provienen del impacto del programa en las calificaciones de los alumnos de kindergarden durante ese año escolar.

Funcionó la aleatorización?

Supuesto de exogeneidad

¿Cómo saber si estan bien randomizados?

Debemos fijarnos en que tan balanceadas están las muestras a lo largo de distintas variables relevantes cómo nivel de ingresos, etnicidad, edad, e incluso attrition (porcentaje que se salio de la muestra inicial).

En otras palabras, debemos asegurarnos de que:

\[ Cor(x_i u_i)=0 \]

Prueba de Balanceo

Angrist & Pischke (2008) presentan el siguiente análisis de diferencia de medias en los distintos grupos del experimento STAR:

Tabla 2.2.1, Angrist & Pischke (2008)
Students who entered STAR in kindergarden
Variable Small Regular Regular + Aide Joint P-val
Free lunch 0.47 0.48 0.50 0.09
White/Asian 0.68 0.67 0.66 0.26
Age in 1985 5.44 5.43 5.42 0.32
Attrition rate 0.49 0.52 0.53 0.02
K. class size 15.10 22.40 22.80 0.00
K. test percentile 54.70 48.90 50.00 0.00

No se puede rechazar la hipótesis nula de que los los tres grupos del experimento sean iguales (en promedio) a una significancia menor a 9%.

Balanceo: Conservamos datos del primer período

# Intento de replicar la tabla 2.2.1 de MHE
# All variables are for the first year a student is observed
# Here we filter the table to fulfill that 
kinder_stats_table<-STAR_long %>% 
  group_by(id) %>% 
  mutate(grade_num=as.numeric(ifelse(grade=="k","0",grade))) %>%
  filter(grade_num==min(grade_num)) %>% 
  filter(!is.na(star)) %>% 
  # recuerda aplicar ungroup despues de usar group_by: mejora velocidad y previene errores
  ungroup() %>% 
  # one of the rows reffers to white/assian, so we create a variable that blends these groups
  # carefull about the factor vs character format, it can cause errors 
  mutate(ethnicity=as.character(ethnicity),
         table_etnicity=ifelse(ethnicity %in% c("cauc","asian"),
                               "white/asian",ethnicity)) %>% 
  # Another variable we need to create is age in 1985
  mutate(age=zoo::as.yearqtr("1985 Q3")-birth)

Balanceo: Una función para testear las hipótesis nula

# The P-value in the last column is for the F-test of equality of variable means across all three groups. 
# This functions pulls the joint p value from a regression object
lmp <- function (modelobject) {
  # le anades un modelo lm. Ej: lm(precio~cantidad, data=mercado)
  # si no es un objeto lm, te arrojara un mensaje de error
    if (class(modelobject) != "lm") stop("Not an object of class 'lm' ")
    # extraemos el elemento fstatistic de esos resultados
    f <- summary(modelobject)$fstatistic
    # con el f, y los grados de libertad, extraemos el joint p-value
    p <- pf(f[1],f[2],f[3],lower.tail=F)
    # limpiamos el joint p-value para que sea un numero "plano": sin atributos
    attributes(p) <- NULL
    return(p)
}

Balanceo: Probemos la funcion

## Probemos la función sobre la hipotesis de free lunch
free_lunch_m<-lm(lunch=="free"~star,data=kinder_stats_table )
summary(free_lunch_m)

Call:
lm(formula = lunch == "free" ~ star, data = kinder_stats_table)

Residuals:
    Min      1Q  Median      3Q     Max 
-0.5027 -0.4774 -0.4709  0.5226  0.5291 

Coefficients:
                  Estimate Std. Error t value Pr(>|t|)    
(Intercept)       0.477366   0.010685  44.677   <2e-16 ***
starsmall        -0.006436   0.015689  -0.410   0.6816    
starregular+aide  0.025334   0.015051   1.683   0.0924 .  
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 0.4997 on 6298 degrees of freedom
  (24 observations deleted due to missingness)
Multiple R-squared:  0.0007597, Adjusted R-squared:  0.0004424 
F-statistic: 2.394 on 2 and 6298 DF,  p-value: 0.09132
lmp(free_lunch_m)
[1] 0.09132441

Balanceo: Ejemplo

(free_data<-kinder_stats_table%>% 
  group_by(star,lunch) %>% 
  summarise(count=n()) %>% 
  group_by(star) %>% 
  mutate(share=count/sum(count)) %>% 
  filter(lunch=="free") %>% 
  select(-count) %>% 
  tidyr::pivot_wider(names_from = star, values_from=share) %>% 
  mutate(p_value=lmp(lm(lunch=="free"~star,data=kinder_stats_table )))%>% 
  rename(variable=1) %>% 
  mutate(variable="free lunch"))
variable regular small regular+aide p_value
free lunch 0.476 0.469 0.501 0.0913

Balanceo: Ejemplo

(white_asian_data<-kinder_stats_table %>% 
  group_by(star,table_etnicity) %>% 
  summarise(count=n()) %>% 
  group_by(star) %>% 
  mutate(share=count/sum(count)) %>% 
  filter(table_etnicity %in% c("white/asian")) %>% 
  select(-count) %>% 
  tidyr::pivot_wider(names_from = star, values_from=share) %>% 
  mutate(p_value=lmp(lm(table_etnicity=="white/asian"~star,data=kinder_stats_table ))) %>% 
  rename(variable=1))
variable regular small regular+aide p_value
white/asian 0.675 0.683 0.659 0.251

Balanceo: Ejemplo

(age_data<-kinder_stats_table %>% 
  # esta no da igual, debe ser porque estoy calculando edad 
  # de manera incorrecta. Hay bono para quien pueda corregirlo.
  group_by(star) %>% 
  summarise(age=mean(age, na.rm = T)) %>% 
  tidyr::pivot_wider(names_from = star, values_from=age) %>% 
  mutate(p_value=lmp(lm(age~star,data=kinder_stats_table ))) %>% 
  mutate(variable="Edad")  )
regular small regular+aide p_value variable
5.38 5.39 5.39 0.619 Edad

Balanceo: Ejemplo

(score_data<-kinder_stats_table%>% 
  group_by(star) %>% 
  summarise(score=mean(score, na.rm = T)) %>% 
  tidyr::pivot_wider(names_from = star, values_from=score) %>% 
  mutate(p_value=lmp(lm(score~star,data=kinder_stats_table )))%>% 
  mutate(variable="K. Score promedio")  )
regular small regular+aide p_value variable
0.473 0.523 0.471 5.69e-10 K. Score promedio

Balanceo: Armado de tabla

tabla<-dplyr::bind_rows(
  free_data,
  white_asian_data,
  age_data,
  tab221_data %>%
    filter(v1 == "Attrition rate" |
             v1 == "K. class size") %>%
    rename(
      variable = v1,
      small = v2,
      regular = v3,
      `regular+aide` = v4,
      p_value = v5
    ),
  score_data) %>%
  select(variable, small, regular, `regular+aide`, p_value) %>%
  # Usamos el paquete gt:: para imprimir tablas en formato de publicacion
  # Revisenlo, es muy flexible para presentar resumenes de datos.
  # No es tan bueno para imprimir resultados de regresiones, para eso les recomiendo huxtable::
  gt() %>%
  gt::tab_header("Tabla 2.2.1, Replica",
                 subtitle = "Adaptada usando datos de libreria AER::STARS") %>%
  gt::fmt_number(columns = 2:5)

Balanceo: Tabla

#|echo: false
tabla
Tabla 2.2.1, Replica
Adaptada usando datos de libreria AER::STARS
variable small regular regular+aide p_value
free lunch 0.47 0.48 0.50 0.09
white/asian 0.68 0.67 0.66 0.25
Edad 5.39 5.38 5.39 0.62
Attrition rate 0.49 0.52 0.53 0.02
K. class size 15.10 22.40 22.80 0.00
K. Score promedio 0.52 0.47 0.47 0.00

Analisis del experimento

Diferencias en aprendizaje por tamaño de la clase

# make a density plot
ggplot(data = STAR_long, 
       mapping = aes(x = score,
                     color=factor(star,
                                  levels = c("regular",
                                             "regular+aide",
                                             "small")))) + 
  geom_density() + 
  # Este comando te permite segmentar un grafico de ggplot sobre segmentos de la data
  # creando un panel de graficos para cada uno de estos
  facet_wrap(~ factor(paste0("Star ",grade),
                      levels = c("Star k","Star 1",
                                 "Star 2","Star 3"))) +
  labs(title="Distribución del score promedio por grado",
       subtitle = "Segmentado según el tratamiento",color="Class size")

Diferencias en aprendizaje por tamaño de la clase

Diferencias en aprendizaje por tamaño de la clase

# make a boxplot
ggplot(data = drop_na(STAR_long), 
       mapping = aes(x = factor(star,
                                  levels = c("regular",
                                             "regular+aide",
                                             "small")),
                     y=score)) + 
  geom_boxplot() + 
  facet_wrap(~ factor(paste0("Star ",grade),
                      levels = c("Star k","Star 1",
                                 "Star 2","Star 3"))) +
  labs(color="Class size",
       x="Tratamiento (tamano de clase)")

Diferencias en aprendizaje por tamaño de la clase

Análisis de regresión

  • Modelo 1: Sin controles.

  • Modelo 2: Controlando por schoolid para restar las diferencias explicadas por la escuela.

  • Modelo 3: Controlando por género y cupón alimenticio. Género no fue medida en balancing test y cupón alimenticio muestra diferencias promedio significativas al 5%.

# Creemos las variables dummys de forma practica
kinder_table =  as_tibble(kinder_stats_table) %>%
    mutate(girl  = (gender == "female"),
           freelunch = (lunch == "free"))


lm1<-lm(score ~ star , data=kinder_table )
lm2<-lm(score ~ star + schoolid, data = kinder_table)
lm3<-lm(score ~ star + schoolid + girl + lunch, data = kinder_table)

Presentación de resultados

Nótese cómo la cantidad de coeficientes incrementa muchísimo debido a los efectos fijos por escuela. Estos coeficientes son irrelevantes. Los removeremos de nuestra tabla final.

summary(lm1)

Call:
lm(formula = score ~ star, data = kinder_table)

Residuals:
     Min       1Q   Median       3Q      Max 
-0.51833 -0.22470  0.00161  0.22116  0.52269 

Coefficients:
                  Estimate Std. Error t value Pr(>|t|)    
(Intercept)       0.473356   0.005994  78.966  < 2e-16 ***
starsmall         0.049176   0.008797   5.590 2.37e-08 ***
starregular+aide -0.002183   0.008438  -0.259    0.796    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 0.2684 on 5783 degrees of freedom
  (539 observations deleted due to missingness)
Multiple R-squared:  0.007335,  Adjusted R-squared:  0.006991 
F-statistic: 21.36 on 2 and 5783 DF,  p-value: 5.695e-10
summary(lm2)

Call:
lm(formula = score ~ star + schoolid, data = kinder_table)

Residuals:
     Min       1Q   Median       3Q      Max 
-0.65269 -0.16974  0.00246  0.17885  0.75788 

Coefficients:
                   Estimate Std. Error t value Pr(>|t|)    
(Intercept)       0.5423105  0.0290701  18.655  < 2e-16 ***
starsmall         0.0566338  0.0078168   7.245 4.89e-13 ***
starregular+aide  0.0016478  0.0075134   0.219 0.826409    
schoolid2        -0.3535205  0.0435376  -8.120 5.67e-16 ***
schoolid3        -0.0178200  0.0376596  -0.473 0.636098    
schoolid4        -0.2000237  0.0422557  -4.734 2.26e-06 ***
schoolid5        -0.2221273  0.0420624  -5.281 1.33e-07 ***
schoolid6        -0.1577453  0.0430879  -3.661 0.000253 ***
schoolid7         0.0497902  0.0361455   1.377 0.168414    
schoolid8        -0.1296636  0.0372347  -3.482 0.000501 ***
schoolid9         0.0312535  0.0359901   0.868 0.385216    
schoolid10        0.1125868  0.0437752   2.572 0.010138 *  
schoolid11        0.1768476  0.0426580   4.146 3.44e-05 ***
schoolid12        0.0144750  0.0426580   0.339 0.734375    
schoolid13        0.1249626  0.0422526   2.958 0.003114 ** 
schoolid14       -0.1629369  0.0496682  -3.281 0.001042 ** 
schoolid15       -0.2058501  0.0428869  -4.800 1.63e-06 ***
schoolid16       -0.3187014  0.0369197  -8.632  < 2e-16 ***
schoolid17       -0.0989048  0.0401740  -2.462 0.013849 *  
schoolid18       -0.2118869  0.0391439  -5.413 6.45e-08 ***
schoolid19       -0.1500254  0.0373465  -4.017 5.97e-05 ***
schoolid20       -0.1013962  0.0393014  -2.580 0.009906 ** 
schoolid21        0.0547706  0.0396587   1.381 0.167319    
schoolid22       -0.0923894  0.0355233  -2.601 0.009324 ** 
schoolid23        0.0694170  0.0398836   1.740 0.081827 .  
schoolid24       -0.1615111  0.0413803  -3.903 9.61e-05 ***
schoolid25       -0.1403496  0.0428725  -3.274 0.001068 ** 
schoolid26       -0.2677496  0.0442767  -6.047 1.57e-09 ***
schoolid27        0.0919922  0.0352978   2.606 0.009180 ** 
schoolid28       -0.1775422  0.0354754  -5.005 5.76e-07 ***
schoolid29       -0.0816803  0.0433060  -1.886 0.059330 .  
schoolid30        0.2118242  0.0422550   5.013 5.52e-07 ***
schoolid31        0.0105794  0.0440164   0.240 0.810067    
schoolid32       -0.3248826  0.0368204  -8.823  < 2e-16 ***
schoolid33       -0.2805288  0.0376807  -7.445 1.11e-13 ***
schoolid34       -0.1738628  0.0404563  -4.298 1.76e-05 ***
schoolid35       -0.2052882  0.0418765  -4.902 9.74e-07 ***
schoolid36       -0.0296559  0.0413618  -0.717 0.473411    
schoolid37       -0.0542834  0.0379930  -1.429 0.153124    
schoolid38       -0.0411003  0.0456972  -0.899 0.368474    
schoolid39       -0.1340759  0.0418983  -3.200 0.001382 ** 
schoolid40        0.0527045  0.0408873   1.289 0.197443    
schoolid41        0.1590096  0.0408917   3.889 0.000102 ***
schoolid42       -0.0458752  0.0437747  -1.048 0.294691    
schoolid43       -0.0844568  0.0407310  -2.074 0.038168 *  
schoolid44        0.0021814  0.0397750   0.055 0.956266    
schoolid45       -0.4051051  0.0418783  -9.673  < 2e-16 ***
schoolid46       -0.0657906  0.0432980  -1.519 0.128696    
schoolid47       -0.0877728  0.0424541  -2.067 0.038734 *  
schoolid48       -0.0384892  0.0386612  -0.996 0.319510    
schoolid49        0.0466617  0.0424510   1.099 0.271732    
schoolid50       -0.0182088  0.0400281  -0.455 0.649199    
schoolid51        0.0463413  0.0352003   1.317 0.188058    
schoolid52        0.1155558  0.0445327   2.595 0.009487 ** 
schoolid53       -0.2958411  0.0433054  -6.832 9.28e-12 ***
schoolid54        0.0212897  0.0433053   0.492 0.623008    
schoolid55       -0.1442718  0.0394943  -3.653 0.000262 ***
schoolid56       -0.3629681  0.0375404  -9.669  < 2e-16 ***
schoolid57       -0.1995686  0.0417205  -4.783 1.77e-06 ***
schoolid58        0.0865847  0.0376667   2.299 0.021558 *  
schoolid59        0.0346704  0.0426804   0.812 0.416638    
schoolid60       -0.1748788  0.0408934  -4.276 1.93e-05 ***
schoolid61       -0.1036485  0.0401717  -2.580 0.009901 ** 
schoolid62       -0.1446448  0.0437720  -3.305 0.000957 ***
schoolid63        0.0693897  0.0364369   1.904 0.056911 .  
schoolid64       -0.0933847  0.0381409  -2.448 0.014379 *  
schoolid65        0.0753015  0.0466865   1.613 0.106817    
schoolid66       -0.1501987  0.0380841  -3.944 8.11e-05 ***
schoolid67       -0.0822587  0.0474270  -1.734 0.082896 .  
schoolid68        0.0941781  0.0375444   2.508 0.012154 *  
schoolid69        0.0940365  0.0428698   2.194 0.028309 *  
schoolid70       -0.0701095  0.0377446  -1.857 0.063296 .  
schoolid71       -0.1823648  0.0392872  -4.642 3.53e-06 ***
schoolid72        0.0281522  0.0367474   0.766 0.443648    
schoolid73       -0.0006973  0.0412074  -0.017 0.986500    
schoolid74       -0.0166240  0.0396479  -0.419 0.675019    
schoolid75       -0.0073771  0.0388163  -0.190 0.849275    
schoolid76       -0.0768938  0.0373879  -2.057 0.039765 *  
schoolid78       -0.2205072  0.0420626  -5.242 1.64e-07 ***
schoolid79       -0.0685800  0.0415456  -1.651 0.098851 .  
schoolid80       -0.0352358  0.0430810  -0.818 0.413451    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 0.2347 on 5705 degrees of freedom
  (539 observations deleted due to missingness)
Multiple R-squared:  0.2511,    Adjusted R-squared:  0.2406 
F-statistic: 23.92 on 80 and 5705 DF,  p-value: < 2.2e-16
summary(lm3)

Call:
lm(formula = score ~ star + schoolid + girl + lunch, data = kinder_table)

Residuals:
     Min       1Q   Median       3Q      Max 
-0.68555 -0.16573  0.00339  0.16954  0.67448 

Coefficients:
                   Estimate Std. Error t value Pr(>|t|)    
(Intercept)       0.5590539  0.0281769  19.841  < 2e-16 ***
starsmall         0.0568963  0.0075326   7.553 4.92e-14 ***
starregular+aide  0.0032905  0.0072420   0.454 0.649580    
schoolid2        -0.2836209  0.0420360  -6.747 1.66e-11 ***
schoolid3        -0.0099352  0.0362548  -0.274 0.784064    
schoolid4        -0.2133261  0.0406769  -5.244 1.62e-07 ***
schoolid5        -0.2009792  0.0405030  -4.962 7.18e-07 ***
schoolid6        -0.1235086  0.0415257  -2.974 0.002949 ** 
schoolid7         0.0688106  0.0348015   1.977 0.048064 *  
schoolid8        -0.1207408  0.0358500  -3.368 0.000762 ***
schoolid9         0.0384073  0.0346940   1.107 0.268328    
schoolid10        0.0961228  0.0421398   2.281 0.022582 *  
schoolid11        0.1814264  0.0410597   4.419 1.01e-05 ***
schoolid12        0.0671622  0.0411508   1.632 0.102714    
schoolid13        0.1410819  0.0406770   3.468 0.000528 ***
schoolid14       -0.0792269  0.0480008  -1.651 0.098889 .  
schoolid15       -0.1207880  0.0415318  -2.908 0.003648 ** 
schoolid16       -0.2194477  0.0359542  -6.104 1.11e-09 ***
schoolid17       -0.1021750  0.0386680  -2.642 0.008255 ** 
schoolid18       -0.1644353  0.0377507  -4.356 1.35e-05 ***
schoolid19       -0.0533896  0.0362669  -1.472 0.141040    
schoolid20       -0.0783609  0.0378591  -2.070 0.038516 *  
schoolid21        0.0987086  0.0387120   2.550 0.010804 *  
schoolid22       -0.0033621  0.0345046  -0.097 0.922381    
schoolid23        0.0821706  0.0384030   2.140 0.032422 *  
schoolid24       -0.1479379  0.0398579  -3.712 0.000208 ***
schoolid25       -0.0803424  0.0413813  -1.942 0.052245 .  
schoolid26       -0.1934065  0.0428099  -4.518 6.38e-06 ***
schoolid27        0.1693421  0.0342812   4.940 8.04e-07 ***
schoolid28       -0.0935225  0.0344446  -2.715 0.006645 ** 
schoolid29        0.0098203  0.0419392   0.234 0.814872    
schoolid30        0.2906511  0.0408893   7.108 1.32e-12 ***
schoolid31        0.1114263  0.0426812   2.611 0.009060 ** 
schoolid32       -0.2276627  0.0357871  -6.362 2.15e-10 ***
schoolid33       -0.1836929  0.0366143  -5.017 5.41e-07 ***
schoolid34       -0.1794561  0.0389416  -4.608 4.15e-06 ***
schoolid35       -0.1801002  0.0403249  -4.466 8.12e-06 ***
schoolid36       -0.0484832  0.0398243  -1.217 0.223491    
schoolid37       -0.0462998  0.0365774  -1.266 0.205635    
schoolid38        0.0070687  0.0440603   0.160 0.872546    
schoolid39       -0.0756777  0.0404423  -1.871 0.061361 .  
schoolid40        0.1192102  0.0395323   3.016 0.002577 ** 
schoolid41        0.1209379  0.0394008   3.069 0.002155 ** 
schoolid42       -0.0686659  0.0421468  -1.629 0.103325    
schoolid43       -0.1088262  0.0392212  -2.775 0.005544 ** 
schoolid44        0.0826520  0.0385050   2.147 0.031873 *  
schoolid45       -0.3019620  0.0406055  -7.436 1.19e-13 ***
schoolid46       -0.0750496  0.0416760  -1.801 0.071789 .  
schoolid47       -0.0930337  0.0412561  -2.255 0.024169 *  
schoolid48       -0.0053767  0.0372602  -0.144 0.885267    
schoolid49        0.0633723  0.0408663   1.551 0.121023    
schoolid50        0.0118719  0.0387111   0.307 0.759099    
schoolid51        0.0291903  0.0339317   0.860 0.389678    
schoolid52        0.0746033  0.0429111   1.739 0.082168 .  
schoolid53       -0.2569748  0.0417340  -6.157 7.90e-10 ***
schoolid54        0.0003739  0.0416928   0.009 0.992844    
schoolid55       -0.1427581  0.0380126  -3.756 0.000175 ***
schoolid56       -0.3436573  0.0361445  -9.508  < 2e-16 ***
schoolid57       -0.2067870  0.0401615  -5.149 2.71e-07 ***
schoolid58        0.0526353  0.0362994   1.450 0.147105    
schoolid59        0.0349543  0.0412803   0.847 0.397168    
schoolid60       -0.1412657  0.0394037  -3.585 0.000340 ***
schoolid61       -0.1229224  0.0386759  -3.178 0.001490 ** 
schoolid62       -0.1202253  0.0421488  -2.852 0.004355 ** 
schoolid63        0.0761024  0.0350725   2.170 0.030059 *  
schoolid64       -0.0750358  0.0368112  -2.038 0.041557 *  
schoolid65        0.0798223  0.0449418   1.776 0.075765 .  
schoolid66       -0.1474788  0.0367418  -4.014 6.05e-05 ***
schoolid67       -0.0524310  0.0456707  -1.148 0.251008    
schoolid68        0.1316694  0.0361869   3.639 0.000277 ***
schoolid69        0.0869535  0.0412651   2.107 0.035145 *  
schoolid70       -0.0338294  0.0363793  -0.930 0.352458    
schoolid71       -0.1681388  0.0378201  -4.446 8.92e-06 ***
schoolid72        0.0739684  0.0354441   2.087 0.036942 *  
schoolid73        0.0167263  0.0396781   0.422 0.673371    
schoolid74       -0.0118500  0.0381625  -0.311 0.756182    
schoolid75       -0.0291145  0.0373738  -0.779 0.436007    
schoolid76       -0.0748995  0.0361350  -2.073 0.038239 *  
schoolid78       -0.2178106  0.0404856  -5.380 7.75e-08 ***
schoolid79       -0.0538681  0.0399931  -1.347 0.178055    
schoolid80       -0.0315957  0.0414649  -0.762 0.446100    
girlTRUE          0.0470861  0.0059926   7.857 4.66e-15 ***
lunchfree        -0.1417930  0.0071298 -19.887  < 2e-16 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 0.2259 on 5686 degrees of freedom
  (556 observations deleted due to missingness)
Multiple R-squared:  0.3071,    Adjusted R-squared:  0.2971 
F-statistic: 30.74 on 82 and 5686 DF,  p-value: < 2.2e-16

Presentación de resultados

Usaremos la función huxreg de la librería huxtable para armar nuestra tabla final:

# la variable schoolid toma decenas de valores discretros (efecto fijo), son demasiados valores (irrelevantes) para mostrar. 
# Extraemos el nombre de todos los coeficientes y extraemos los que empiezan con "schoolid". De nuevo, con regular expressions
school_co = grep(names(coef(lm2)),pattern = "schoolid*",value=T) 

# nos aseguremos de incluir todos los schoolids en las regresiones
school_co = c(unique(school_co,grep(names(coef(lm2)),pattern = "schoolid*",value=T)),"schoolid77")

tabla_de_regresion<-huxtable::huxreg(lm1, lm2, lm3, 
       omit_coefs = school_co,  
       statistics = c("N. obs." = "nobs", 
      "R squared" = "r.squared", "F statistic" = "statistic",
      "P value" = "p.value")) %>%
    huxtable::set_caption("Estimados MCO del tratamiento de tamaño de clase en puntajes promedio") %>% 
    huxtable::insert_row(c("School control (FE)","No","Yes","Yes"),after = 11)

Estimados MCO del tratamiento de tamaño de clase en puntajes promedio
(1) (2) (3)
(Intercept) 0.473 *** 0.542 *** 0.559 ***
(0.006)    (0.029)    (0.028)   
starsmall 0.049 *** 0.057 *** 0.057 ***
(0.009)    (0.008)    (0.008)   
starregular+aide -0.002     0.002     0.003    
(0.008)    (0.008)    (0.007)   
girlTRUE                   0.047 ***
                  (0.006)   
lunchfree                   -0.142 ***
                  (0.007)   
School control (FE) No         Yes         Yes        
N. obs. 5786         5786         5769        
R squared 0.007     0.251     0.307    
F statistic 21.365     23.916     30.737    
P value 0.000     0.000     0.000    
*** p < 0.001; ** p < 0.01; * p < 0.05.

Análisis

Encontramos lo siguiente:

  • Es mejor contar con una clase pequeña que contar con un ayudante: Las clases pequeñas fueron mas efectivas en incrementar los puntajes en pruebas estandarizadas que las clases regulares en solitario y que las clases regulares con ayudante.

  • Los coeficientes de la primera especificación sugieren que los puntajes promedios de los alumnos de clases pequeñas exedió al de los alumnos de clases regulares en 0.049 puntos.

  • Al controlar por diferencias iniciales en la cantidad de niñas, en la cantidad de alumnos con cupones educativos, y todas las diferencias explicables a nivel de colegio, se observa que esta diferencia en las calificaciones promedio incrementa a 0.057.

Fin

Referencias:

Fuentes de consulta recomendadas para programacion en R: