9.2 Modelo con pendiente aleatoria

Este tipo de modelos permiten que la relación entre la variable independiente y la variable dependiente cambie según alguna otra variable explicativa. En otras palabras, permite que la pendiente de la relación entre las variables sea diferente a medida que lo grupos o subconjuntos de datos. En un modelo de regresión lineal simple, la relación entre la variable independiente y la variable dependiente se modela como una línea recta con una pendiente fija. Sin embargo, en un modelo con pendiente aleatoria, se permite que la pendiente varíe según otra variable explicativa.

En este tipo de modelos, la relación entre las variables puede suponer una curva con diferentes pendientes para diferentes subgrupos. Los modelos con pendiente aleatoria son útiles en situaciones donde se espera que la relación entre las variables cambie de manera no lineal o cuando se desea modelar diferencias en la pendiente entre subgrupos. Consideremos el siguiente modelo:

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

donde \(\beta_{1j}\) esta dado como

\[ \beta_{1j} = \gamma_{10}+\gamma_{11}Stratum_{j} + \tau_{1j} \] Para este caso en particular, la pendiente varía de acuerdo con los estratos de muestreo, no así el intercepto que seguirá fijo siempre. Para ajustar el modelo se utiliza la función lmer como se muestra a continuación:

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

Para cada estrato se tienen las siguientes estimaciones para las pendientes aleatorias \(\beta_{1j}\):

coef(mod_Pend_Aleatoria)$Stratum %>% slice(1:8L)

	Expenditure	(Intercept)
idStrt001	1.8914	148.8
idStrt002	1.2666	148.8
idStrt003	1.1200	148.8
idStrt004	1.4717	148.8
idStrt005	0.8316	148.8
idStrt006	0.7942	148.8
idStrt007	0.8950	148.8
idStrt008	0.8070	148.8

Organizando los coeficientes en un gráfico se tiene:

Coef_Estimado <- inner_join(
  coef(mod_Pend_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()

Se puede observar que la estimación de la pendiente varía de manera importante para cada uno de los estratos pero que, al imponer la restricción de un intercepto común para todos los estratos, no hay un buen ajuste en general. Por otro lado, la estimación de los ingresos para las unidades observadas usando este modelo se muestra a continuación:

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

	Pred	Income	Stratum
1	803.8	409.87	idStrt001
6	890.6	823.75	idStrt001
10	288.8	90.92	idStrt001
13	307.2	135.33	idStrt001
18	640.8	336.19	idStrt001
22	1159.6	1539.75	idStrt001

Gráficamente se muestran las estimaciones versus los valores estimados de los ingresos y se logra observar que la predicción está más cerca a la línea de 45 grados que el modelo anterior.

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")