FACULTAD DE CIENCIAS SOCIALES - PUCP

Curso: POL 304 - Estadística para el análisis político 2 | Semestre 2024 - 2

Jefas de Práctica: Karina Alcántara 👩‍🏫 y Lizette Crispín 👩‍🏫

library(rio)
library(dplyr)
library(car)
library(nnet)
library(DescTools)
library(RVAideMemoire)
library(marginaleffects)
data <- import("Repaso.xlsx")
Diccionario de datos
Nombre de variable Descripción Valores
abany1 ¿A favor del aborto? 1: si/0:No
age Edad
treinta_menos ¿La persona tiene 30 años o menos? 1: si/0:No
relig_bajo ¿Tiene asistencia baja a la iglesia? 1: si/0:No
favor_penamuerte ¿A favor de la pena de muerte? 1: si/0:No
childs N° de hijos
mucha_conf_congreso ¿Tiene mucha confianza en el congreso? 1: si/0:No
blanco_raza ¿La persona es de raza blanca? 1: si/0:No
partido ¿Por cuál partido siente afinidad? 1-Democrata,2-Republicano, 3-Independiente

Regresión logística binaria:

Modelo 1

¿Qué factores afectan la probabilidad de que una persona esté a favor de la pena de muerte?

  • Su edad (treinta_menos):
modelo1 <- glm(favor_penamuerte ~ treinta_menos,family= binomial,data)
summary(modelo1)
## 
## Call:
## glm(formula = favor_penamuerte ~ treinta_menos, family = binomial, 
##     data = data)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -1.4695  -1.4695   0.9111   0.9111   1.0070  
## 
## Coefficients:
##               Estimate Std. Error z value Pr(>|z|)    
## (Intercept)    0.66475    0.05503  12.079   <2e-16 ***
## treinta_menos -0.24967    0.12272  -2.034   0.0419 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 2357.1  on 1818  degrees of freedom
## Residual deviance: 2353.0  on 1817  degrees of freedom
##   (155 observations deleted due to missingness)
## AIC: 2357
## 
## Number of Fisher Scoring iterations: 4

¿Cuál es el efecto de la variable?

Cuando una persona tiene menos que 30 años, la probabilidad de que esté a favor de la pena de muerte disminuye.

Significancia de las variables

¿La variable es significativa?

Sí, su p valor es menor a 0.05 :)

Predicciones

¿Cuál sera la probabilidad de estar a favor de la pena de muerte cuando una persona si tiene 30 años o menos (treinta_menos = 1)?

coef(modelo1) #Veamos los coeficientes
##   (Intercept) treinta_menos 
##     0.6647477    -0.2496671
#Prob cuando tiene 30 años o menos
Num1 = exp(0.6647477 -0.2496671*1)
Den1 = 1 + Num1 
Prob_simenor30 = Num1/Den1
Prob_simenor30
## [1] 0.6023055

¿Cuál sera la probabilidad de estar a favor de la pena de muerte cuando una persona si tiene 30 años o menos (treinta_menos = 1)?

#Prob cuando NO tiene 30 años o menos
Num1 = exp(0.6647477 -0.2496671*0)
Den1 = 1 + Num1 
Prob_simenor30 = Num1/Den1
Prob_simenor30
## [1] 0.6603261

¿Hay alguna diferencia entre las probabilidades?

Efectos marginales:

Revisemos el ompacto de la VI en la probabilidad con efectos marginales. Recuerda que la interpretación se hace por cada variable independiente.

Calculemos como la edad impacta en la probabilidad con efectos marginales.

avg_slopes(modelo1)[c(1,3)]
## 
##           Term Estimate
##  treinta_menos   -0.058
## 
## Columns: term, estimate

Cuando una persona tiene menos que 30 años la probabilidad en promedio de que esté a favor de la pena de muerte disminuye en 5.8%

(Solo para ver que la variación de la probabilidad calza con lo calculado previamente)

head(modelo1$fitted.values)
##         2         4         5         6         7         8 
## 0.6023055 0.6603261 0.6603261 0.6603261 0.6603261 0.6023055
0.6603261-0.6023055 
## [1] 0.0580206

Sale igualito :)

Modelo 2

  • Su edad (treinta_menos)

  • Baja asistencia a misa (relig_bajo)

modelo2 <- glm(favor_penamuerte ~ treinta_menos+relig_bajo,family= binomial,data)
summary(modelo2)
## 
## Call:
## glm(formula = favor_penamuerte ~ treinta_menos + relig_bajo, 
##     family = binomial, data = data)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -1.5195  -1.4150   0.8702   0.9571   1.0667  
## 
## Coefficients:
##               Estimate Std. Error z value Pr(>|z|)    
## (Intercept)    0.54311    0.07399   7.340 2.13e-13 ***
## treinta_menos -0.27703    0.12373  -2.239   0.0252 *  
## relig_bajo     0.23268    0.09941   2.341   0.0192 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 2349.8  on 1811  degrees of freedom
## Residual deviance: 2340.4  on 1809  degrees of freedom
##   (162 observations deleted due to missingness)
## AIC: 2346.4
## 
## Number of Fisher Scoring iterations: 4

¿Cuál es el efecto de la variable?

Cuando una persona tiene menos que 30 años, la probabilidad de que esté a favor de la pena de muerte disminuye.

Cuando una persona tiene una asistencia baja a la iglesia la probabilidad de que esté a favor de la pena de muerte aumenta.

Significancia de las variables

¿Las variables son significativas?

Sí, las dos tienen valor menor a 0.05 :)

Predicciones

¿Cuál sera la probabilidad de estar a favor de la pena de muerte cuando una persona si tiene 30 años o menos (treinta_menos = 1) y tiene asistencia baja a la iglesia (relig_bajo = 1) ?

coef(modelo2) #Revisemos los coeficientes
##   (Intercept) treinta_menos    relig_bajo 
##     0.5431132    -0.2770298     0.2326816
Num2 = exp(0.5431132 -0.2770298*1 + 0.2326816*1)
Den2 = 1 + Num2 
Prob2 = Num2/Den2
Prob2
## [1] 0.6221691

¿Cuál sera la probabilidad de estar a favor de la pena de muerte cuando una persona si tiene 30 años o menos (treinta_menos = 1) y tiene asistencia baja a la iglesia (relig_bajo = 0) ?

Num2 = exp(0.5431132 -0.2770298*1 + 0.2326816*0)
Den2 = 1 + Num2 
Prob3 = Num2/Den2
Prob3
## [1] 0.5661311

Efectos marginales:

Revisemos el ompacto de la VI en la probabilidad con efectos marginales. Recuerda que la interpretación se hace por cada variable independiente.

avg_slopes(modelo2)[c(1,3)]
## 
##           Term Estimate
##  relig_bajo      0.0530
##  treinta_menos  -0.0644
## 
## Columns: term, estimate

Cuando una persona sí tienen una asistencia baja a la iglesia la probabilidad (en promedio) de que esté a favor del aborto aumenta en 5.3%.

Cuando una persona si tiene 30 años o menos, la probabilidad (en promedio) de que esté a favor del aborto disminuye en 6.4%.

Regresión logística multinomial

¿Qué factores afectan la probabilidad de que una persona sienta afinidad por cierto partido (democrata/republicano/independiente)?

Elección de linea base

table(data$partido)
## 
##   1   2   3 
## 699 442 765
data$partido1 <- factor(data$partido,levels=c(1:3), labels = c("Democrata","Republicano","Independiente"))

table(data$partido1)
## 
##     Democrata   Republicano Independiente 
##           699           442           765
contrasts(data$partido1)
##               Republicano Independiente
## Democrata               0             0
## Republicano             1             0
## Independiente           0             1
data$partido1 <- relevel(data$partido1 , ref = "Independiente")

Modelo 1

Variables independientes

abany: ¿Apoya el aborto? (Si/No)

age: Edad (numérico)

Creación del modelo

mod1 <- multinom(partido1 ~ abany + age, data = data)
## # weights:  12 (6 variable)
## initial  value 1317.236134 
## iter  10 value 1246.902792
## final  value 1246.902753 
## converged
summary(mod1)
## Call:
## multinom(formula = partido1 ~ abany + age, data = data)
## 
## Coefficients:
##             (Intercept)      abany        age
## Democrata     -1.277693  0.4664781 0.02104493
## Republicano   -1.236709 -0.7020387 0.02129955
## 
## Std. Errors:
##             (Intercept)     abany         age
## Democrata     0.2160525 0.1354483 0.004016450
## Republicano   0.2346277 0.1625249 0.004439657
## 
## Residual Deviance: 2493.806 
## AIC: 2505.806

Significancia de las variables

  1. Solo podemos revisar la significancia de las variables numéricas.

  2. El test se hace variable por variable.

test.multinom(mod1,age)
##                               Coeff        SE Odds.ratio      z  Pr(>|z|)    
## Democrata|Independiente   0.0210449 0.0040164     1.0213 5.2397 1.609e-07 ***
## Republicano|Independiente 0.0212996 0.0044397     1.0215 4.7976 1.606e-06 ***
## Republicano|Democrata     0.0002547 0.0044263     1.0003 0.0575    0.9541    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Sobre la variable edad: La edad es una variable que puede impactar en la probabilidad de sentir afinidad por el partido demócrata en contraste al independiente; y también impacta en la probabilidad de sentir afinidad por el partido republicano en contraste del independiente. Sin embargo, no es significativa para la probabilidad de ser republicano y no demócrata.

Predicciones:

¿Cuál será la probabilidad de sentir afinidad por x partido cuando se está a favor del aborto y tiene 45 años?

#recordando los coeficientes
coef(mod1)
##             (Intercept)      abany        age
## Democrata     -1.277693  0.4664781 0.02104493
## Republicano   -1.236709 -0.7020387 0.02129955

Probabilidad por demócrata:

#Demócrata
Num1 = exp(-1.277693 + 0.4664781*1 + 0.02104493*45 )
Den1 = 1 + Num1 
Prob_dem = Num1/Den1
Prob_dem
## [1] 0.5338997

Probabilidad por republicano:

Num2 = exp(-1.236709 -0.7020387*1 + 0.02129955*45 )
Den2 = 1 + Num2 
Prob_rep = Num2/Den2
Prob_rep
## [1] 0.2728386

Como sabemos la probabilidad es un valor que va del 0 al 1. Para poder encontrar la probabilidad restante solo debemos restarle la suma de las dos probabilidades encontradas al 1; es decir 1 - (prob1 + prob2).

Probabilidad por independiente:

Prob_inde=1-(Prob_dem+Prob_rep)
Prob_inde
## [1] 0.1932617

Efectos marginales:

Revisemos el ompacto de la VI en la probabilidad con efectos marginales. Recuerda que la interpretación se hace por cada variable independiente.

avg_slopes(mod1)[c(1,3,4)]
## 
##   Term Contrast Estimate
##  abany    1 - 0  0.16684
##  age      dY/dX  0.00292
##  abany    1 - 0 -0.00693
##  age      dY/dX -0.00488
##  abany    1 - 0 -0.15991
##  age      dY/dX  0.00196
## 
## Columns: term, contrast, estimate

  • Cuando una persona está a favor del aborto, la probabilidad (en promedio) de sentir afinidad por el partido demócrata aumenta en 16.68%

  • Cuando la edad de una persona aumenta en un año, la probabilidad (en promedio) de sentir afinidad por el partido demócrata aumenta en 0.29%

  • Cuando una persona está a favor del aborto, la probabilidad (en promedio) de sentir afinidad por el partido independiente disminuye en 0.69%

  • Cuando la edad de una persona aumenta en un año, la probabilidad (en promedio) de sentir afinidad por el partido independiente disminuye en 0.48%

Modelo 2

Se agregaron las variables

  • childs: número de hijos

  • blanco_raza: es blanco?

Creación del modelo

mod2 <- multinom(partido1 ~ abany + age+childs+blanco_raza, data = data)
## # weights:  18 (10 variable)
## initial  value 1315.038910 
## iter  10 value 1192.297537
## final  value 1173.666990 
## converged
summary(mod2)
## Call:
## multinom(formula = partido1 ~ abany + age + childs + blanco_raza, 
##     data = data)
## 
## Coefficients:
##             (Intercept)      abany        age      childs blanco_raza
## Democrata    -0.7794812  0.5204134 0.02994665 -0.13445720   -1.011832
## Republicano  -2.3455902 -0.8127828 0.02064037 -0.06776204    1.519681
## 
## Std. Errors:
##             (Intercept)     abany         age     childs blanco_raza
## Democrata     0.2319615 0.1417077 0.004569937 0.04530739   0.1558222
## Republicano   0.3298047 0.1668108 0.004886855 0.05191693   0.2709868
## 
## Residual Deviance: 2347.334 
## AIC: 2367.334

Significancia de las variables

test.multinom(mod2,age)
##                                Coeff        SE Odds.ratio       z  Pr(>|z|)    
## Democrata|Independiente    0.0299467 0.0045699    1.03040  6.5530 5.640e-11 ***
## Republicano|Independiente  0.0206404 0.0048869    1.02085  4.2237 2.404e-05 ***
## Republicano|Democrata     -0.0093064 0.0050739    0.99074 -1.8342   0.06663 .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
test.multinom(mod2,childs)
##                               Coeff       SE Odds.ratio       z Pr(>|z|)   
## Democrata|Independiente   -0.134457 0.045307    0.87419 -2.9677 0.003001 **
## Republicano|Independiente -0.067762 0.051917    0.93448 -1.3052 0.191824   
## Republicano|Democrata      0.066694 0.054628    1.06897  1.2209 0.222135   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

En el caso de edad, encontramos que la variable solo es significativa para los cruces demócrata-independiente y republicano - independiente. Para la variable n° de hijos, la variable solo es significativa cuando queremos saber la probabilidad de sentir afinidad por el partido demócrata en comparación del independiente.

Predicciones:

¿Cuál es la probabilidad de sentir afinidad por x partido cuando la persona está a favor del aborto, tiene 45 años, tiene 3 hijos, y es de raza blanca?

Probabilidad por partido demócrata

Num1 = exp(-0.7794812 + 0.5204134*1 + 0.02994665*45 -0.13445720*3 -1.011832 * 1)
Den1 = 1 + Num1 
Prob_dem = Num1/Den1
Prob_dem
## [1] 0.4190506

Probabilidad por partido republicano

Num2 = exp(-2.3455902 -0.8127828*1 + 0.02064037*45 -0.06776204*3 + 1.519681*1)
Den2 = 1 + Num2 
Prob_rep = Num2/Den2
Prob_rep
## [1] 0.2863533

Probabilidad por partido independiente

1 - (Prob_dem+Prob_rep)
## [1] 0.2945961

Efectos marginales:

Revisemos el ompacto de la VI en la probabilidad con efectos marginales. Recuerda que la interpretación se hace por cada variable independiente.

avg_slopes(mod2)[c(1,2,4)]
## 
##          Group        Term  Estimate
##  Democrata     abany        0.167523
##  Democrata     age          0.004700
##  Democrata     blanco_raza -0.317477
##  Democrata     childs      -0.022840
##  Independiente abany        0.000714
##  Independiente age         -0.005968
##  Independiente blanco_raza  0.070818
##  Independiente childs       0.024482
##  Republicano   abany       -0.168237
##  Republicano   age          0.001268
##  Republicano   blanco_raza  0.246658
##  Republicano   childs      -0.001642
## 
## Columns: term, group, estimate

Interpretemos para las variables que acabamos de agregar (blanco_raza y childs)

  • Cuando la persona es de raza blanca (blanco_raza = 1), la probabilidad de sentir afinidad por el partido demócrata disminuye en 31.75%

  • Cuando la persona aumenta sus hijos en 1, la probabilidad de sentir afinidad por el partido demócrata disminuye en 2.28%

  • Cuando la persona es de raza blanca (blanco_raza = 1), la probabilidad de sentir afinidad por el partido independiente aumenta en 7.08%

  • Cuando la persona aumenta sus hijos en 1, la probabilidad de sentir afinidad por el partido independiente aumenta en 2.45%

  • Cuando la persona es de raza blanca (blanco_raza = 1), la probabilidad de sentir afinidad por el partido republicano aumenta en 24.67%

  • Cuando la persona aumenta sus hijos en 1, la probabilidad de sentir afinidad por el partido republicano disminuye en 0.16%