9.3 Modelo con intercepto y pendiente aleatoria

Los modelos con intercepto y pendiente aleatoria son un tipo de modelo estadístico que permite modelar la relación entre una variable de respuesta y una o más variables predictoras, teniendo en cuenta tanto efectos fijos como efectos aleatorios en donde el intercepto y la pendiente varían según el subgrupo de interés. En estos modelos, los coeficientes de la regresión (es decir, la pendiente y el intercepto) se consideran aleatorios en lugar de fijos. Esto significa que se asume que estos coeficientes pueden variar entre las unidades de análisis, que pueden ser individuos, grupos, regiones geográficas, etc. Estas variaciones se modelan como efectos aleatorios que se incorporan en la ecuación de regresión. Siguiendo con la encuesta de hogares, consideremos el siguiente modelo:

\[ Ingreso_{ij}=\beta_{0j}+\beta_{1j}Gasto_{ij}+\epsilon_{ij} \]

En donde,

\[ \beta_{0j} = \gamma_{00}+\gamma_{01}Stratum_{j} + \tau_{0j} \] Y,

\[ \beta_{1j} = \gamma_{10}+\gamma_{11}Stratum_{j} + \tau_{1j} \]

El ajuste del modelo se realiza utilizando la función lmer como se presenta a continuación:

mod_IntPend_Aleatoria <-
  lmer(Income ~ Expenditure  + (1 + Expenditure | Stratum),
       data = encuesta,
       weights  =  qw)

Los coeficientes del modelo son:

coef(mod_IntPend_Aleatoria)$Stratum %>% slice(1:10L)

	(Intercept)	Expenditure
idStrt001	-229.29	2.7555
idStrt002	36.19	1.6039
idStrt003	151.78	1.1637
idStrt004	219.82	1.3600
idStrt005	-87.91	1.2818
idStrt006	29.15	1.2178
idStrt007	40.63	1.0783
idStrt008	164.18	0.9288
idStrt009	20.03	0.8187
idStrt010	91.05	1.8226

Gráficamente,

Coef_Estimado <- inner_join(
  coef(mod_IntPend_Aleatoria)$Stratum %>%
    add_rownames(var = "Stratum"),
  encuesta_plot %>% dplyr::select(Stratum) %>% distinct()
)

ggplot(data = encuesta_plot,
       aes(y = Income, x = Expenditure,
           colour = Stratum)) +
  geom_jitter() + theme(legend.position = "none",
                        plot.title = element_text(hjust = 0.5)) +
  geom_abline(
    data = Coef_Estimado,
    mapping = aes(
      slope = Expenditure,
      intercept = `(Intercept)`,
      colour = Stratum
    )
  ) +
  theme_cepal()

Como se pudo observar en la gráfica anterior, el ajuste del modelo con intercepto y pendiente aleatoria se ajusta mejor a los datos que los otros dos modelos mostrados anteriormente. A continuación, se realizan las predicciones de los ingresos con el modelo:

data.frame(
  Pred = predict(mod_IntPend_Aleatoria),
  Income = encuesta$Income,
  Stratum = encuesta$Stratum
) %>%
  distinct() %>%
  slice(1:6L)

	Pred	Income	Stratum
1	725.059	409.87	idStrt001
6	851.538	823.75	idStrt001
10	-25.189	90.92	idStrt001
13	1.594	135.33	idStrt001
18	487.643	336.19	idStrt001
22	1243.348	1539.75	idStrt001

Para poder ver qué tan buena son las predicciones, se realiza el siguiente gráfico:

ggplot(data = tab_pred, aes(x = Pred, y = Income, colour = Stratum)) +
  geom_point() +
  geom_abline(intercept = 0,
              slope = 1,
              colour = "red") +
  theme_bw() +
  theme(legend.position = "none") 

Ahora bien, para robustecer el modelo, se ajusta nuevamente, pero agregando la variable zona como se muestra a continuación:

\[ Ingreso_{ij}=\beta_{0j}+\beta_{1j}Gasto_{ij}+\beta_{2j}Zona_{ij} +\epsilon_{ij} \]

Donde,

\[ \beta_{0j} = \gamma_{00}+\gamma_{01}Stratum_{j} + \gamma_{02}\mu_{j} + \tau_{0j} \]

Además,

\[ \beta_{1j} = \gamma_{10}+\gamma_{11}Stratum_{j} + \gamma_{12}\mu_{j} + \tau_{1j} \]

Y,

\[ \beta_{2j} = \gamma_{20}+\gamma_{21}Stratum_{j} + \gamma_{12}\mu_{j} + \tau_{2j} \]

donde \(\mu_{j}\) es el gasto medio de los hogares en el estrato \(j\). En R el ajuste se hace de la siguiente manera:

media_estrato <- encuesta %>% group_by(Stratum) %>%
  summarise(mu = mean(Expenditure))

encuesta <- inner_join(encuesta, media_estrato, by = "Stratum")

mod_IntPend_Aleatoria2 <-
  lmer(
    Income ~ 1 + Expenditure + Zone + mu +
      (1 + Expenditure + Zone + mu | Stratum),
    data = encuesta,
    weights  =  qw
  )

calculando las predicciones de los ingresos de los hogares por estrato:

data.frame(
  Pred = predict(mod_IntPend_Aleatoria2),
  Income = encuesta$Income,
  Stratum = encuesta$Stratum
) %>%
  distinct() %>%
  slice(1:6L)

	Pred	Income	Stratum
1	723.19	409.87	idStrt001
6	847.74	823.75	idStrt001
10	-15.60	90.92	idStrt001
13	10.78	135.33	idStrt001
18	489.40	336.19	idStrt001
22	1233.57	1539.75	idStrt001