Evaluación de políticas públicas
Pruebas de significancia estadística y evaluación de impacto
Iris Carolina Hernández Pérez — HP10013
Pablo José flores Parra — FP21011
Gracia María Lemus Mejía — LM21017
28 de octubre de 2026
1 Introducción
El presente trabajo aplica herramientas estadísticas utilizadas en la evaluación de políticas y programas públicos. En el primer ejercicio se examina el cambio entre dos mediciones relacionadas mediante la prueba de rangos con signo de Wilcoxon. En el segundo se combina el emparejamiento por puntaje de propensión (PSM) con el método de Diferencias en Diferencias (DiD) para analizar el cambio en los gastos directos de los hogares en salud.
2 Ejercicio práctico 1. Prueba de rangos con signo de Wilcoxon
2.1 Importación y exploración de la base
La base contiene las puntuaciones de las empresas en la línea de base y en la línea de salida. Primero se revisa la estructura de los datos, los nombres de las variables y la presencia de valores faltantes.
ruta_excel <- "C:/Users/Pablo/Desktop/Pablo/Ejercicio_significancia_estadistica.xlsx"
datos <- readxl::read_excel(ruta_excel)
str(datos)## tibble [81 × 3] (S3: tbl_df/tbl/data.frame)
## $ ID Empresa : chr [1:81] "BL001" "BL002" "BL003" "BL004" ...
## $ Indicador LB: num [1:81] 0.093 0 0.178 0.576 0.229 ...
## $ Indicador LS: num [1:81] 0.153 0.442 0.208 0.573 0.745 ...names(datos)## [1] "ID Empresa" "Indicador LB" "Indicador LS"head(datos)colSums(is.na(datos))## ID Empresa Indicador LB Indicador LS
## 0 0 0nrow(datos)## [1] 812.2 Estadísticas descriptivas y cálculo de las diferencias
Se toma la segunda columna como línea de base y la tercera como línea de salida, de acuerdo con la estructura utilizada en el ejercicio. La diferencia se calcula restando la medición inicial a la final; por tanto, un valor positivo representa un aumento en la puntuación.
linea_base <- datos[[2]]
linea_salida <- datos[[3]]
resumen_mediciones <- data.frame(
Medición = c("Línea de base", "Línea de salida"),
Media = c(mean(linea_base, na.rm = TRUE),
mean(linea_salida, na.rm = TRUE)),
Mediana = c(median(linea_base, na.rm = TRUE),
median(linea_salida, na.rm = TRUE)),
Mínimo = c(min(linea_base, na.rm = TRUE),
min(linea_salida, na.rm = TRUE)),
Máximo = c(max(linea_base, na.rm = TRUE),
max(linea_salida, na.rm = TRUE))
)
knitr::kable(resumen_mediciones, digits = 4,
caption = "Estadísticas descriptivas de las mediciones")| Medición | Media | Mediana | Mínimo | Máximo |
|---|---|---|---|---|
| Línea de base | 0.2206 | 0.1754 | 0 | 0.8585 |
| Línea de salida | 0.3695 | 0.3356 | 0 | 0.8126 |
datos$diferencia <- linea_salida - linea_base
summary(datos$diferencia)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.4754 0.0000 0.1120 0.1489 0.2741 0.71562.3 Evaluación de la normalidad de las diferencias
El histograma permite observar la forma de la distribución de las diferencias. La prueba de Shapiro-Wilk complementa la inspección visual: con un valor p inferior a 0.05 se rechaza la hipótesis nula de normalidad al nivel de significancia del 5%.
hist(
stats::na.omit(datos$diferencia),
main = "Diferencias entre mediciones",
xlab = "Línea de salida − línea de base",
ylab = "Frecuencia",
col = "lightblue",
border = "white"
)
Distribución de las diferencias entre la línea de salida y la línea de base
prueba_shapiro <- shapiro.test(stats::na.omit(datos$diferencia))
prueba_shapiro##
## Shapiro-Wilk normality test
##
## data: stats::na.omit(datos$diferencia)
## W = 0.96911, p-value = 0.04745Comentario de análisis. La decisión sobre la normalidad debe apoyarse tanto en el histograma como en el valor p de Shapiro-Wilk. Si el valor p es menor que 0.05, existe evidencia para rechazar la normalidad de las diferencias. Si es igual o mayor que 0.05, no se cuenta con evidencia suficiente para rechazarla. La selección de Wilcoxon también depende del diseño de mediciones relacionadas y de las características de los datos.
2.4 Prueba de Wilcoxon para muestras relacionadas
La prueba contrasta si existe evidencia de una diferencia sistemática entre las puntuaciones de la línea de base y de la línea de salida.
resultado_wilcoxon <- wilcox.test(
linea_salida,
linea_base,
paired = TRUE,
alternative = "two.sided",
exact = FALSE
)
resultado_wilcoxon##
## Wilcoxon signed rank test with continuity correction
##
## data: linea_salida and linea_base
## V = 2175.5, p-value = 4.837e-08
## alternative hypothesis: true location shift is not equal to 0Comentario de análisis. El valor p se compara con el nivel de significancia del 5%. Si es inferior a 0.05, se rechaza la hipótesis nula de ausencia de diferencia sistemática. Si es igual o superior a 0.05, no se dispone de evidencia suficiente para rechazarla. La significancia estadística no demuestra por sí sola que el programa haya causado el cambio observado.
2.5 Dirección del cambio y magnitud
Se comparan las medianas de ambas mediciones y se clasifica a las empresas según la variación registrada en su puntuación.
mediana_base <- median(linea_base, na.rm = TRUE)
mediana_salida <- median(linea_salida, na.rm = TRUE)
medianas <- data.frame(
Medición = c("Línea de base", "Línea de salida"),
Mediana = c(mediana_base, mediana_salida)
)
knitr::kable(medianas, digits = 4,
caption = "Medianas de las puntuaciones")| Medición | Mediana |
|---|---|
| Línea de base | 0.1754 |
| Línea de salida | 0.3356 |
clasificacion_cambio <- ifelse(
is.na(datos$diferencia), "Dato faltante",
ifelse(datos$diferencia > 0, "Aumentó",
ifelse(datos$diferencia < 0, "Disminuyó", "Sin cambio"))
)
knitr::kable(
as.data.frame(table(Cambio = clasificacion_cambio)),
col.names = c("Tipo de cambio", "Número de empresas"),
caption = "Empresas según la dirección del cambio"
)| Tipo de cambio | Número de empresas |
|---|---|
| Aumentó | 57 |
| Disminuyó | 13 |
| Sin cambio | 11 |
n_cambios <- sum(datos$diferencia != 0, na.rm = TRUE)
if (n_cambios > 0 && is.finite(resultado_wilcoxon$p.value) &&
resultado_wilcoxon$p.value > 0) {
z_aprox <- qnorm(resultado_wilcoxon$p.value / 2,
lower.tail = FALSE)
efecto_r <- abs(z_aprox) / sqrt(n_cambios)
cat("Tamaño del efecto r (aproximado):", round(efecto_r, 3))
} else {
cat("No fue posible calcular una medida aproximada del tamaño del efecto.")
}## Tamaño del efecto r (aproximado): 0.652Comentario de análisis. Si la mediana de la línea de salida es mayor que la de la línea de base, se observa un aumento en la puntuación central del indicador; si es menor, se observa una disminución. La interpretación final debe considerar conjuntamente la dirección del cambio y el resultado de Wilcoxon. Al no contar con un grupo de comparación en este ejercicio, no se puede atribuir exclusivamente al programa la variación observada.
3 Ejercicio práctico 2. Emparejamiento por puntaje de propensión y Diferencias en Diferencias
3.1 Importación y revisión de la base
La base longitudinal incluye hogares participantes y no
participantes, observados en la línea de base y en la línea de salida.
La variable enrolled identifica la participación y
round distingue el momento de medición.
ruta_dta <- "C:/Users/Pablo/Desktop/Pablo/evaluation.dta"
data_full <- haven::read_dta(ruta_dta)
dplyr::glimpse(data_full)## Rows: 19,827
## Columns: 22
## $ locality_identifier <dbl> 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 2…
## $ household_identifier <dbl> 5, 5, 11, 11, 13, 13, 16, 16, 21, 21, 22, 22, 23,…
## $ treatment_locality <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1…
## $ promotion_locality <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1…
## $ eligible <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1…
## $ enrolled <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1…
## $ enrolled_rp <dbl> 1, 1, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 0, 0, 1, 1, 1…
## $ poverty_index <dbl> 55.95054, 55.95054, 46.05873, 46.05873, 54.09583,…
## $ round <dbl> 0, 1, 0, 1, 1, 0, 1, 0, 0, 1, 0, 1, 1, 0, 1, 0, 0…
## $ health_expenditures <dbl> 15.1854553, 19.5809021, 13.0762568, 2.3988545, 0.…
## $ age_hh <dbl> 24, 25, 30, 31, 59, 58, 36, 35, 37, 39, 34, 35, 3…
## $ age_sp <dbl> 23, 24, 26, 27, 57, 56, 25, 24, 35, 36, 41, 41, 3…
## $ educ_hh <dbl> 0, 0, 4, 4, 0, 0, 3, 3, 0, 0, 0, 0, 0, 0, 3, 3, 2…
## $ educ_sp <dbl> 6, 6, 0, 0, 0, 0, 0, 0, 0, 0, 2, 2, 6, 6, 0, 0, 6…
## $ female_hh <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0…
## $ indigenous <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ hhsize <dbl> 4, 4, 6, 6, 6, 6, 7, 7, 7, 7, 9, 9, 7, 7, 9, 9, 7…
## $ dirtfloor <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 1…
## $ bathroom <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ land <dbl> 1, 1, 2, 2, 4, 4, 2, 2, 2, 2, 1, 1, 1, 1, 4, 4, 2…
## $ hospital_distance <dbl> 124.82, 124.82, 124.82, 124.82, 124.82, 124.82, 1…
## $ hospital <dbl> 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…knitr::kable(
as.data.frame(table(data_full$enrolled, data_full$round)),
col.names = c("Participación", "Medición", "Observaciones"),
caption = "Observaciones por grupo y momento"
)| Participación | Medición | Observaciones |
|---|---|---|
| 0 | 0 | 6949 |
| 1 | 0 | 2964 |
| 0 | 1 | 6949 |
| 1 | 1 | 2965 |
3.2 Pregunta 1. Reorganización de la base
La base se transforma a formato ancho para que las variables medidas en ambos períodos queden en columnas separadas. Se conservan los hogares con información de gastos sanitarios en la línea de base.
variables_medicion <- c(
"health_expenditures", "poverty_index", "age_hh", "age_sp",
"educ_hh", "educ_sp", "female_hh", "indigenous", "hhsize",
"dirtfloor", "bathroom", "land", "hospital_distance"
)
requeridas <- c(
"round", "household_identifier", "enrolled",
variables_medicion
)
no_encontradas <- setdiff(requeridas, names(data_full))
if (length(no_encontradas) > 0) {
stop(
"No se encontraron estas variables en la base: ",
paste(no_encontradas, collapse = ", ")
)
}
data <- data_full |>
tidyr::pivot_wider(
id_cols = c(household_identifier, enrolled),
names_from = round,
values_from = dplyr::all_of(variables_medicion),
names_glue = "{.value}_{round}"
) |>
dplyr::filter(!is.na(health_expenditures_0))
dim(data)## [1] 9913 28dplyr::glimpse(data)## Rows: 9,913
## Columns: 28
## $ household_identifier <dbl> 5, 11, 13, 16, 21, 22, 23, 25, 27, 28, 29, 31, 3…
## $ enrolled <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, …
## $ health_expenditures_0 <dbl> 15.185455, 13.076257, 15.286353, 11.311761, 11.2…
## $ health_expenditures_1 <dbl> 19.5809021, 2.3988545, 0.0000000, 20.0269089, 16…
## $ poverty_index_0 <dbl> 55.95054, 46.05873, 54.09583, 56.90340, 46.90881…
## $ poverty_index_1 <dbl> 55.95054, 46.05873, 54.09583, 56.90340, 46.90881…
## $ age_hh_0 <dbl> 24, 30, 58, 35, 37, 34, 30, 57, 24, 40, 23, 40, …
## $ age_hh_1 <dbl> 25, 31, 59, 36, 39, 35, 31, 58, 25, 40, 24, 41, …
## $ age_sp_0 <dbl> 23, 26, 56, 24, 35, 41, 29, 56, 28, 36, 22, 35, …
## $ age_sp_1 <dbl> 24, 27, 57, 25, 36, 41, 30, 57, 29, 37, 23, 36, …
## $ educ_hh_0 <dbl> 0, 4, 0, 3, 0, 0, 0, 3, 2, 0, 5, 2, 3, 2, 0, 4, …
## $ educ_hh_1 <dbl> 0, 4, 0, 3, 0, 0, 0, 3, 2, 0, 5, 2, 3, 2, 0, 4, …
## $ educ_sp_0 <dbl> 6, 0, 0, 0, 0, 2, 6, 0, 6, 2, 5, 6, 0, 0, 0, 0, …
## $ educ_sp_1 <dbl> 6, 0, 0, 0, 0, 2, 6, 0, 6, 2, 5, 6, 0, 0, 0, 0, …
## $ female_hh_0 <dbl> 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
## $ female_hh_1 <dbl> 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
## $ indigenous_0 <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
## $ indigenous_1 <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
## $ hhsize_0 <dbl> 4, 6, 6, 7, 7, 9, 7, 9, 7, 9, 4, 9, 5, 5, 7, 8, …
## $ hhsize_1 <dbl> 4, 6, 6, 7, 7, 9, 7, 9, 7, 9, 4, 9, 5, 5, 7, 8, …
## $ dirtfloor_0 <dbl> 1, 1, 1, 1, 1, 1, 0, 0, 1, 1, 0, 0, 1, 1, 1, 0, …
## $ dirtfloor_1 <dbl> 1, 1, 1, 1, 1, 1, 0, 0, 1, 1, 0, 0, 1, 1, 1, 0, …
## $ bathroom_0 <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
## $ bathroom_1 <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
## $ land_0 <dbl> 1, 2, 4, 2, 2, 1, 1, 4, 2, 1, 1, 5, 2, 5, 2, 2, …
## $ land_1 <dbl> 1, 2, 4, 2, 2, 1, 1, 4, 2, 1, 1, 5, 2, 5, 2, 2, …
## $ hospital_distance_0 <dbl> 124.8200, 124.8200, 124.8200, 124.8200, 124.8200…
## $ hospital_distance_1 <dbl> 124.8200, 124.8200, 124.8200, 124.8200, 124.8200…# Comando para abrir la base en la ventana de datos de RStudio:
View(data)3.3 Pregunta 2. Número de observaciones
resumen_dimensiones <- data.frame(
Indicador = c("Observaciones", "Variables"),
Cantidad = c(nrow(data), ncol(data))
)
knitr::kable(resumen_dimensiones,
caption = "Dimensiones de la base reorganizada")| Indicador | Cantidad |
|---|---|
| Observaciones | 9913 |
| Variables | 28 |
Comentario de análisis. El número de observaciones corresponde a las filas de la base reorganizada. La cantidad puede diferir de la base original porque ahora cada hogar debe quedar representado en una fila y se excluyen los hogares sin gasto sanitario observado en la línea de base.
3.4 Pregunta 3. Emparejamiento por puntaje de propensión (PSM)
El puntaje de propensión se estima mediante un modelo logístico a partir de características observadas en la línea de base. El método de vecino más cercano empareja hogares participantes con hogares no participantes que presentan puntajes similares.
modelo_psm <- MatchIt::matchit(
enrolled ~ age_hh_0 + educ_hh_0 + age_sp_0 + educ_sp_0 +
female_hh_0 + indigenous_0 + hhsize_0 + dirtfloor_0 +
bathroom_0 + hospital_distance_0,
data = data,
distance = "glm",
link = "logit",
method = "nearest",
replace = FALSE,
ratio = 1
)
modelo_psm## A `matchit` object
## - method: 1:1 nearest neighbor matching without replacement
## - distance: Propensity score
## - estimated with logistic regression
## - number of obs.: 9913 (original), 5928 (matched)
## - target estimand: ATT
## - covariates: age_hh_0, educ_hh_0, age_sp_0, educ_sp_0, female_hh_0, indigenous_0, hhsize_0, dirtfloor_0, bathroom_0, hospital_distance_03.4.1 Variables y resultados del emparejamiento
resumen_psm <- summary(modelo_psm)
resumen_psm$nn## Control Treated
## All (ESS) 6949 2964
## All 6949 2964
## Matched (ESS) 2964 2964
## Matched 2964 2964
## Unmatched 3985 0
## Discarded 0 0unidades_emparejadas <- data.frame(
Grupo = c("Participantes", "No participantes"),
Emparejadas = c(
sum(modelo_psm$weights[data$enrolled == 1] > 0, na.rm = TRUE),
sum(modelo_psm$weights[data$enrolled == 0] > 0, na.rm = TRUE)
)
)
knitr::kable(unidades_emparejadas,
caption = "Unidades con peso positivo tras el emparejamiento")| Grupo | Emparejadas |
|---|---|
| Participantes | 2964 |
| No participantes | 2964 |
Comentario de análisis.
distance = "glm" utiliza un modelo lineal generalizado para
estimar el puntaje de propensión y link = "logit"
especifica la función logística, apropiada para una variable de
participación binaria. La calidad del emparejamiento debe valorarse
revisando cuántas unidades se emparejaron y el balance de las
covariables, no únicamente el número de parejas.
3.5 Pregunta 4. Distribución del puntaje antes del emparejamiento
datos_con_puntaje <- modelr::add_predictions(
data,
model = modelo_psm$model,
var = "puntaje",
type = "response"
) |>
dplyr::mutate(
grupo = factor(
enrolled,
levels = c(0, 1),
labels = c("No participantes", "Participantes")
)
)
ggplot2::ggplot(
datos_con_puntaje,
ggplot2::aes(x = puntaje, colour = grupo, fill = grupo)
) +
ggplot2::geom_density(alpha = 1/3) +
ggplot2::labs(
title = "Puntaje de propensión antes del emparejamiento",
x = "Puntaje de propensión estimado",
y = "Densidad",
colour = "Grupo",
fill = "Grupo"
) +
ggplot2::theme_minimal()
Comentario de análisis. La superposición de las distribuciones permite examinar si existe soporte común entre participantes y no participantes. Si las distribuciones se encuentran muy separadas, puede ser difícil encontrar hogares comparables. La conclusión debe basarse en el gráfico obtenido con los datos.
3.6 Pregunta 5. Distribución del puntaje después del emparejamiento
data_psm <- MatchIt::match.data(modelo_psm) |>
dplyr::mutate(
grupo = factor(
enrolled,
levels = c(0, 1),
labels = c("No participantes", "Participantes")
)
)
ggplot2::ggplot(
data_psm,
ggplot2::aes(x = distance, colour = grupo, fill = grupo)
) +
ggplot2::geom_density(alpha = 1/3) +
ggplot2::labs(
title = "Puntaje de propensión después del emparejamiento",
x = "Puntaje de propensión estimado",
y = "Densidad",
colour = "Grupo",
fill = "Grupo"
) +
ggplot2::theme_minimal()
3.6.1 Balance de las covariables
summary(modelo_psm)##
## Call:
## MatchIt::matchit(formula = enrolled ~ age_hh_0 + educ_hh_0 +
## age_sp_0 + educ_sp_0 + female_hh_0 + indigenous_0 + hhsize_0 +
## dirtfloor_0 + bathroom_0 + hospital_distance_0, data = data,
## method = "nearest", distance = "glm", link = "logit", replace = FALSE,
## ratio = 1)
##
## Summary of Balance for All Data:
## Means Treated Means Control Std. Mean Diff. Var. Ratio
## distance 0.3677 0.2697 0.7502 0.8618
## age_hh_0 41.6566 48.1384 -0.4731 0.7798
## educ_hh_0 2.9712 2.7745 0.0743 0.8960
## age_sp_0 36.8364 41.6117 -0.4098 0.8042
## educ_sp_0 2.7033 2.5810 0.0494 0.9257
## female_hh_0 0.0732 0.1101 -0.1416 .
## indigenous_0 0.4291 0.3203 0.2199 .
## hhsize_0 5.7699 4.9263 0.4226 0.8030
## dirtfloor_0 0.7217 0.5533 0.3756 .
## bathroom_0 0.5735 0.6340 -0.1223 .
## hospital_distance_0 109.2043 103.6626 0.1324 0.9917
## eCDF Mean eCDF Max
## distance 0.1983 0.3052
## age_hh_0 0.0881 0.2074
## educ_hh_0 0.0218 0.0623
## age_sp_0 0.0648 0.2100
## educ_sp_0 0.0141 0.0690
## female_hh_0 0.0369 0.0369
## indigenous_0 0.1088 0.1088
## hhsize_0 0.0652 0.1833
## dirtfloor_0 0.1683 0.1683
## bathroom_0 0.0605 0.0605
## hospital_distance_0 0.0396 0.0830
##
## Summary of Balance for Matched Data:
## Means Treated Means Control Std. Mean Diff. Var. Ratio
## distance 0.3677 0.3669 0.0063 1.0170
## age_hh_0 41.6566 42.0368 -0.0278 1.1047
## educ_hh_0 2.9712 2.9737 -0.0010 0.9606
## age_sp_0 36.8364 37.0870 -0.0215 1.1510
## educ_sp_0 2.7033 2.7051 -0.0008 0.9231
## female_hh_0 0.0732 0.0725 0.0026 .
## indigenous_0 0.4291 0.4362 -0.0143 .
## hhsize_0 5.7699 5.7797 -0.0049 0.8743
## dirtfloor_0 0.7217 0.7325 -0.0241 .
## bathroom_0 0.5735 0.5746 -0.0020 .
## hospital_distance_0 109.2043 108.8581 0.0083 0.9951
## eCDF Mean eCDF Max Std. Pair Dist.
## distance 0.0008 0.0105 0.0066
## age_hh_0 0.0143 0.0472 0.8996
## educ_hh_0 0.0079 0.0196 1.0781
## age_sp_0 0.0139 0.0476 0.9503
## educ_sp_0 0.0056 0.0169 1.0781
## female_hh_0 0.0007 0.0007 0.5129
## indigenous_0 0.0071 0.0071 0.9223
## hhsize_0 0.0100 0.0223 1.0291
## dirtfloor_0 0.0108 0.0108 0.6805
## bathroom_0 0.0010 0.0010 0.9366
## hospital_distance_0 0.0099 0.0439 1.1173
##
## Sample Sizes:
## Control Treated
## All 6949 2964
## Matched 2964 2964
## Unmatched 3985 0
## Discarded 0 0plot(summary(modelo_psm))
Comentario de análisis. Después del emparejamiento, se espera una mayor comparabilidad entre los grupos en las características observadas. Las curvas de densidad deben interpretarse junto con las medidas de balance de covariables. El PSM no elimina posibles diferencias no observadas entre participantes y no participantes.
3.7 Pregunta 6. Diferencias en Diferencias en la muestra emparejada
Se recuperan las observaciones de los hogares emparejados y se incorporan las ponderaciones del procedimiento de emparejamiento para estimar el modelo DiD.
hogares_emparejados <- data_psm |>
dplyr::select(household_identifier, weights)
data_psm_did <- dplyr::inner_join(
hogares_emparejados,
data_full,
by = "household_identifier"
)
modelo_did <- stats::lm(
health_expenditures ~ enrolled * round,
data = data_psm_did,
weights = weights
)
summary(modelo_did)##
## Call:
## stats::lm(formula = health_expenditures ~ enrolled * round, data = data_psm_did,
## weights = weights)
##
## Residuals:
## Min 1Q Median 3Q Max
## -9.581 -4.461 -1.049 2.946 80.306
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 15.0616 0.1217 123.800 < 2e-16 ***
## enrolled -0.5719 0.1721 -3.324 0.00089 ***
## round 2.7264 0.1721 15.846 < 2e-16 ***
## enrolled:round -9.3763 0.2433 -38.535 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 6.624 on 11852 degrees of freedom
## Multiple R-squared: 0.2337, Adjusted R-squared: 0.2335
## F-statistic: 1205 on 3 and 11852 DF, p-value: < 2.2e-163.7.1 Efecto estimado e intervalo de confianza
El coeficiente de la interacción enrolled:round
representa la estimación de Diferencias en Diferencias. Su signo indica
la dirección del cambio relativo estimado en los gastos sanitarios del
grupo participante frente al grupo de comparación.
tabla_efecto <- as.data.frame(
summary(modelo_did)$coefficients["enrolled:round", , drop = FALSE]
)
tabla_efecto <- data.frame(
Término = rownames(tabla_efecto),
tabla_efecto,
row.names = NULL,
check.names = FALSE
)
intervalo_efecto <- stats::confint(modelo_did, level = 0.95)
tabla_efecto$IC_95_inferior <- intervalo_efecto["enrolled:round", 1]
tabla_efecto$IC_95_superior <- intervalo_efecto["enrolled:round", 2]
knitr::kable(
tabla_efecto,
digits = 4,
caption = "Estimación del efecto DiD e intervalo de confianza del 95%"
)| Término | Estimate | Std. Error | t value | Pr(>|t|) | IC_95_inferior | IC_95_superior |
|---|---|---|---|---|---|---|
| enrolled:round | -9.3763 | 0.2433 | -38.5345 | 0 | -9.8532 | -8.8993 |
Comentario de análisis. El signo del coeficiente de interacción indica si el cambio en los gastos del grupo participante fue mayor o menor que el cambio del grupo de comparación. Se debe examinar el valor p y el intervalo de confianza para valorar la incertidumbre estadística. Una interpretación causal requiere, entre otros supuestos, que en ausencia del programa ambos grupos hubieran seguido tendencias paralelas.
3.7.2 Comprobación mediante las medias de los grupos
medias_grupo <- data_psm_did |>
dplyr::group_by(enrolled, round) |>
dplyr::summarise(
media = weighted.mean(
health_expenditures,
w = weights,
na.rm = TRUE
),
.groups = "drop"
)
knitr::kable(
medias_grupo,
digits = 4,
col.names = c("Participación", "Medición", "Gasto medio ponderado"),
caption = "Gasto sanitario medio por grupo y momento"
)| Participación | Medición | Gasto medio ponderado |
|---|---|---|
| 0 | 0 | 15.0616 |
| 0 | 1 | 17.7880 |
| 1 | 0 | 14.4897 |
| 1 | 1 | 7.8398 |
media_trat_despues <- medias_grupo$media[
medias_grupo$enrolled == 1 & medias_grupo$round == 1
]
media_trat_antes <- medias_grupo$media[
medias_grupo$enrolled == 1 & medias_grupo$round == 0
]
media_comp_despues <- medias_grupo$media[
medias_grupo$enrolled == 0 & medias_grupo$round == 1
]
media_comp_antes <- medias_grupo$media[
medias_grupo$enrolled == 0 & medias_grupo$round == 0
]
efecto_did_medias <- (media_trat_despues - media_trat_antes) -
(media_comp_despues - media_comp_antes)
cat("Estimación DiD calculada a partir de las medias:",
round(efecto_did_medias, 4))## Estimación DiD calculada a partir de las medias: -9.3763Nota metodológica. La comprobación con medias resume el cambio de cada grupo entre los dos momentos. Las diferencias entre esta comprobación y el coeficiente de la regresión pueden depender de la ponderación, de las observaciones utilizadas y de la especificación del modelo.
3.8 Pregunta 7. Conclusión
La conclusión debe resumir el efecto estimado sobre los gastos directos en salud, su dirección, magnitud e incertidumbre estadística. También debe señalar que la interpretación causal depende de la comparabilidad de los grupos y del supuesto de tendencias paralelas. Los resultados numéricos deben interpretarse a partir de las tablas generadas al ejecutar el documento.
4 Referencias metodológicas
- Guía de clase: Control de lectura de evaluación.
- Prueba de rangos con signo de Wilcoxon para comparar mediciones relacionadas.
- Emparejamiento por puntaje de propensión (PSM) y método de Diferencias en Diferencias (DiD).