Ejercicios de Regresión Logística Binaria

Introducción

En esta lección utilizaremos los datos de la encuesta del Projecto de Opinión Pública de América Latina (LAPOP) del años 2018/19 que evalúa sobre creencias, actitudes, prácticas políticas, entre otros.

La base de datos y el libo de códigos se pueden descargase desde el siguiente enlace. (1) Copie el vínculo, (2) abra una ventana nueva y (3) péguelo en la barra de direcciones:

https://www.dropbox.com/sh/5tvi4uiww52by59/AABnFrvhs8N1fYICALPmRJYUa?dl=0

A continuación, se presenta la lista de variables de la base:

protesta: ha protestado en los últimos 12 meses (“No”, “Sí”)
sexo: sexo de la persona(“hombre” o “mujer”)
ciudad: ciudad (“pequeña”, “mediana”, “grande”)
int.pol: interés en política (1 = “Mucho”, 4 = ”Nada" )
aut.id.etn: autoidentificación étnica (“Blanca”,“Mestiza”,“Indígena”,“Negra”,“Otra”)
coi.emp.pub: algún funcionario público le ha pedido coima (“No”, “Sí”)
coi.pol: algún policía le ha pedido coima (“No”, “Sí”)
vic.del: ha sido víctima de delincuencia en los últimos 12 meses (“No”, “Sí”)

Cargar paquetes

library(foreign)
library(stargazer)
library(DescTools)

Carga de data

load("protesta.Rdata")

names(protesta)

## [1] "sexo"        "ciudad"      "prot"        "int.pol"     "aut.id.etn" 
## [6] "coi.emp.pub" "coi.pol"     "vic.del"

Ejercicio 1

Calcule un modelo con variable dependiente participación en protesta (“prot”) y variable independiente el requerimiento de coima por parte de un política (“coi.pol”).

modelo1 <- glm(prot~coi.pol, binomial, protesta)

summary(modelo1)

## 
## Call:
## glm(formula = prot ~ coi.pol, family = binomial, data = protesta)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -0.7081  -0.4871  -0.4871  -0.4871   2.0931  
## 
## Coefficients:
##             Estimate Std. Error z value Pr(>|z|)    
## (Intercept) -2.07201    0.09132 -22.689  < 2e-16 ***
## coi.polSí    0.81655    0.18051   4.524 6.08e-06 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 1117.5  on 1445  degrees of freedom
## Residual deviance: 1098.7  on 1444  degrees of freedom
## AIC: 1102.7
## 
## Number of Fisher Scoring iterations: 4

Interprete los coeficientes beta del modelo
¿Cuál es la probabilidad de que un ciudadano se involucre en protesta cuando este ha sido extorsionado por un policía (coi.pol)?
¿La desvianza “nula” es significativamente diferente de la desvianza residual? ¿ Cómo interpreta los resultados?
¿Cuán bueno es el ajuste modelo según el Pseud R cuadrado?

anova(modelo1, test = "Chisq")

## Analysis of Deviance Table
## 
## Model: binomial, link: logit
## 
## Response: prot
## 
## Terms added sequentially (first to last)
## 
## 
##         Df Deviance Resid. Df Resid. Dev  Pr(>Chi)    
## NULL                     1445     1117.5              
## coi.pol  1   18.815      1444     1098.7 1.441e-05 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

PseudoR2(modelo1, c("CoxSnell", "Nagel"))

##   CoxSnell Nagelkerke 
## 0.01292724 0.02401523

Predicciones

Calcule la probabilidad para el caso que el ciudadano ha sido extorsionado con pago de coima a un policía

new.data <- data.frame(coi.pol = c("Sí"))

predict(modelo1, new.data, type = "response")

##         1 
## 0.2217573

new.data2 <- data.frame(coi.pol = c("No"))

predict(modelo1, new.data2, type = "response")

##         1 
## 0.1118476

Calcule la probabilidad para el caso que el ciudadano NO ha sido extorsionado con pago de coima a un policía

Ejercicio 2

Calcule los coeficientes del modelo visto en el ejercicio 1, pero a partir de una tabla simple cruzada de las variables protesta “prot” y petición de coima de polícía “coi.pol”. Luego responda:

¿Qué resultado se obtiene al aplicar el logaritmo natural al odds de la participación en protesta pública en el caso de las personas que no han sufrido extorsión por parte de la polícía?

Primero calculamos una tabla simple cruzada con la función “table”.

prop.table(table(protesta$prot,protesta$coi.pol),2)

##     
##             No        Sí
##   No 0.8881524 0.7782427
##   Sí 0.1118476 0.2217573

Luego calculamos el logaritmo natural del odds de la participación en protesta pública en el caso de las personas que no han sufrido extorsión por parte de la polícía

¿Qué resultado se obtiene luego del calculo?

log(0.1118476/0.8881524)

## [1] -2.072006

log(0.2217573/0.7782427)

## [1] -1.255455

¿Y qué resultado se obtiene al sumarle el valor “2.072007” al logaritmo natural del odds?

##

log(0.2217573/0.7782427) + 2.072007

## [1] 0.8165521

Ejercicio 3

Por otro lado, ¿qué resultado se obtiene al aplicar la función exponencial al modelo calculado en el ejercicio 1 de la siguiente manera?

(exp(-2.07201 + 0.81655*1 ))/(exp(-2.07201 + 0.81655*1 )+1)

## [1] 0.2217564

¿Cómo podría obtener la probabilidad de participación en protesta pública para el caso de las personas que no han sido víctimas de extorsión por parte de la policía?

Ejercicio 4

Calculo los coeficientes B0 y B1 de un modelo de regresión logística binaria para la siguiente tabla cruzada de participación en protesta pública y victimización por delincuencia:

prop.table(table(protesta$prot,protesta$vic.del),2)

##     
##             No        Sí
##   No 0.8813886 0.8410758
##   Sí 0.1186114 0.1589242

modelo2 <- glm(prot~vic.del, binomial, protesta)

summary(modelo2)

## 
## Call:
## glm(formula = prot ~ vic.del, family = binomial, data = protesta)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -0.5883  -0.5025  -0.5025  -0.5025   2.0649  
## 
## Coefficients:
##             Estimate Std. Error z value Pr(>|z|)    
## (Intercept) -2.00565    0.09604 -20.883   <2e-16 ***
## vic.delSí    0.33939    0.16588   2.046   0.0408 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 1117.5  on 1445  degrees of freedom
## Residual deviance: 1113.4  on 1444  degrees of freedom
## AIC: 1117.4
## 
## Number of Fisher Scoring iterations: 4

Ejercicio 5

Finalmente, calcule un modelo de regresión logística quie tenga como variable dependiente a la protesta públicas (prot) y como independientes al interés en política (int.pol), ciudad (tamano) y extrosión con pedido de coima de polícía (coi.pol):

modelo2 <- glm(prot ~ coi.pol + int.pol + ciudad, binomial, protesta)

summary(modelo2)

## 
## Call:
## glm(formula = prot ~ coi.pol + int.pol + ciudad, family = binomial, 
##     data = protesta)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -1.2533  -0.5615  -0.4182  -0.3090   2.4763  
## 
## Coefficients:
##                Estimate Std. Error z value Pr(>|z|)    
## (Intercept)   -0.014224   0.303629  -0.047  0.96264    
## coi.polSí      0.807395   0.186655   4.326 1.52e-05 ***
## int.pol       -0.625422   0.090748  -6.892 5.51e-12 ***
## ciudadgrande  -0.502327   0.186630  -2.692  0.00711 ** 
## ciudadmediana  0.008936   0.243292   0.037  0.97070    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 1117.5  on 1445  degrees of freedom
## Residual deviance: 1045.4  on 1441  degrees of freedom
## AIC: 1055.4
## 
## Number of Fisher Scoring iterations: 5

anova(modelo2, test = "Chisq")

## Analysis of Deviance Table
## 
## Model: binomial, link: logit
## 
## Response: prot
## 
## Terms added sequentially (first to last)
## 
## 
##         Df Deviance Resid. Df Resid. Dev  Pr(>Chi)    
## NULL                     1445     1117.5              
## coi.pol  1   18.815      1444     1098.7 1.441e-05 ***
## int.pol  1   43.783      1443     1054.9 3.669e-11 ***
## ciudad   2    9.526      1441     1045.4  0.008538 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

PseudoR2(modelo2, c("CoxSnell", "Nagel"))

##   CoxSnell Nagelkerke 
## 0.04865475 0.09038702

Identificación de variable más importante del modelo

exp(coefficients(modelo2))

##   (Intercept)     coi.polSí       int.pol  ciudadgrande ciudadmediana 
##     0.9858769     2.2420595     0.5350355     0.6051209     1.0089760

Interpreta los coeficientes beta del modelo
¿Cuál es la probabilidad de protesta cuando el ciudadano ha sido extorsionado por un policía?
¿La desvianza “nula” es significativamente diferente de la desvianza residual? ¿ Cómo interpreta los resultados?
¿Cuán bueno es el ajuste modelo según el Pseud R cuadrado?

Predicciones

Calcule la probabilidad para los siguientes casos:

Un ciudadano que fue víctima de extorsión por parte de polícía (“coi.pol”), ningún interés en política (“int.pol”) y que habita en ciudad grande (“ciudad”)
Un ciudadano que fue víctima de extorsión por parte de polícía (“coi.pol”), mucho interés en política (“int.pol”) y que habita en ciudad pequeña (“ciudad”)

new.data <- data.frame(coi.pol = c("Sí"), int.pol = c(4), ciudad = "grande")
predict(modelo2, new.data, type = "response")


new.data <- data.frame(int.pol = 1, ciudad = "pequeña", coi.pol = "Sí")
predict(modelo2, new.data, type = "response")