9.4 Modelo logístico multinivel.

Los modelos logísticos multinivel son una extensión de los modelos logísticos simples, que se utilizan para predecir la probabilidad de un resultado binario en función de una o varias variables explicativas. Sin embargo, en muchas situaciones, los datos se recogen de individuos que están agrupados en diferentes niveles o unidades de análisis, como escuelas, ciudades o países. En estos casos, los modelos logísticos simples pueden no ser suficientes para capturar la estructura jerárquica de los datos y la variación en las respuestas entre los diferentes grupos. Estos modelos resuelven este problema al permitir que los coeficientes del modelo varíen a través de los diferentes niveles de análisis.

Además, los modelos logísticos multinivel permiten incluir tanto variables a nivel individual como variables a nivel de grupo, lo que aumenta la precisión de las estimaciones y la capacidad de explicar la variabilidad en las respuestas. También permiten estimar la varianza en las respuestas entre los diferentes grupos, lo que es útil para identificar las fuentes de variabilidad y para comparar la variabilidad entre grupos.

Sea la variable \(y_{ij} = 1\) si el individuo \(i\) en el estrato \(j\) está por encima de la línea de pobreza y \(y_{ij} = 0\) en caso contrario, la variable \(y_{ij}\) se puede modelar mediante el modelo logístico:

\[ \pi_{ij}=Pr\left(y_{ij}\right)=Pr\left(y_{ij}=1\mid \boldsymbol{X}, \boldsymbol{\beta}\right)=\frac{\exp\left(\boldsymbol{\beta}_{j}\boldsymbol{x}_{ij}\right)}{1+\exp\left(\boldsymbol{\beta}_{j}\boldsymbol{x}_{ij}\right)} \]

Ó también,

\[ \log\left(\frac{\pi_{ij}}{1-\pi_{ij}}\right)=\boldsymbol{\beta}_{j}\boldsymbol{x}_{ij} \]

Los modelos logísticos con intercepto y pendiente aleatoria son un tipo de modelo logístico multinivel que permiten que tanto el intercepto como la pendiente varíen aleatoriamente entre los diferentes grupos de observación. En los modelos logísticos básicos, la relación entre las variables predictoras y la variable de respuesta se modela mediante una función logística, donde la respuesta es la probabilidad de que el resultado binario ocurra. En los modelos con intercepto y pendiente aleatoria, la función logística se ajusta para cada grupo de observación, y tanto el intercepto como la pendiente son variables aleatorias que varían de un grupo a otro. Esto permite que los coeficientes del modelo, que representan la relación entre las variables predictoras y la respuesta, varíen según el grupo de observación.

Por ejemplo, asuma que se quiere modelar la pobreza en términos del gasto y que se considera que el estrato es importante en la variación de este fenómeno. El modelo se define de la siguiente manera:

\[ logit(Pobreza_{ij})=\beta_{0j}+\beta_{1j}Gasto_{ij}+\epsilon_{ij} \]

En donde,

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

Además,

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

En R, el ajuste se hace de la siguiente manera:

encuesta <-
  encuesta %>% mutate(pobreza = ifelse(Poverty != "NotPoor", 1, 0))

mod_logit_Pen_Aleatorio <-
  glmer(
    pobreza ~ Expenditure  + (1 + Expenditure | Stratum),
    data = encuesta,
    weights  =  qw,
    binomial(link = "logit")
  )

Los coeficientes del modelo son:

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

	(Intercept)	Expenditure
idStrt001	4.9568	-0.0256
idStrt002	9.7610	-0.0351
idStrt003	-1.1263	-0.0068
idStrt004	1.9918	-0.0158
idStrt005	8.1255	-0.0264
idStrt006	-1.1729	0.0089
idStrt007	0.9893	-0.0121
idStrt008	1.4810	-0.0057
idStrt009	3.6139	-0.0043
idStrt010	4.1611	-0.0206

Gráficamente el ajuste de los modelo se muestra a continuación:

dat_pred <- encuesta %>% group_by(Stratum) %>%
  summarise(Expenditure = list(seq(min(Expenditure), max(Expenditure), len = 100))) %>%
  tidyr::unnest_legacy()

dat_pred <-
  mutate(dat_pred,
         Proba = predict(mod_logit_Pen_Aleatorio, newdata = dat_pred , type = "response"))

ggplot(data = dat_pred,
       aes(y = Proba, x = Expenditure,
           colour = Stratum)) +
  geom_line() +   theme_bw() +
  geom_point(data = encuesta, aes(y = pobreza, x = Expenditure)) +
  theme(legend.position = "none",
        plot.title = element_text(hjust = 0.5))

Las predicciones se muestran a continuación:

(tab_pred <- data.frame(
  Pred = predict(mod_logit_Pen_Aleatorio,
                 type = "response"), 
           pobreza = encuesta$pobreza, 
           Stratum = encuesta$Stratum, 
           qw = encuesta$qw)) %>% distinct() %>% 
  slice(1:6L)

Pred	Stratum	qw
0.0194	idStrt001	0.6193
0.0194	idStrt001	0.6058
0.0194	idStrt001	0.6089
0.0194	idStrt001	0.6242
0.0194	idStrt001	0.6096
0.0061	idStrt001	0.6079

La calidad de la predicción del modelo es muy buena como se muestra a continuación:

tab_pred %>% 
  summarise(Pred = weighted.mean(Pred, qw), 
            pobreza = weighted.mean(pobreza,qw))

Pred	pobreza
0.3881	0.3895