Ejercicio Opcional - Modelos de Regresión


Cargo la data idh_elec.xlsx:

folder="data"
fileName="idh_elec.csv"
fileToRead=file.path(folder,fileName)
idhElec=read.csv(fileToRead)
idhElec$ganaPPK=NA
idhElec$ganaPPK=ifelse(idhElec$PPK>idhElec$FP,"Si","No")
str(idhElec)
## 'data.frame':    1834 obs. of  15 variables:
##  $ ubiReg    : int  10000 10000 10000 10000 10000 10000 10000 10000 10000 10000 ...
##  $ ubiProv   : int  10200 10200 10200 10200 10200 10200 10300 10300 10300 10300 ...
##  $ ubiDis    : int  10202 10201 10203 10204 10205 10206 10302 10303 10304 10305 ...
##  $ depa      : Factor w/ 25 levels "AMAZONAS","ANCASH",..: 1 1 1 1 1 1 1 1 1 1 ...
##  $ prov      : Factor w/ 195 levels "ABANCAY","ACOBAMBA",..: 19 19 19 19 19 19 24 24 24 24 ...
##  $ dist      : Factor w/ 1684 levels "ABANCAY","ABELARDO PARDO LEZAMETA",..: 83 117 411 476 645 730 324 358 421 437 ...
##  $ pobla     : int  11587 26067 6501 1443 23820 8020 349 282 922 883 ...
##  $ idh       : num  0.311 0.479 0.366 0.408 0.236 ...
##  $ esperanza : num  76.8 74.7 78 77.4 77.4 ...
##  $ secundaria: num  21.6 59.3 38.7 44.1 16 ...
##  $ tiempoedu : num  5.38 8.33 5.77 6.24 5.78 8.33 5.76 6.75 4.83 5.04 ...
##  $ percapitaf: num  405 662 452 551 209 ...
##  $ PPK       : int  1823 4949 1490 604 6282 2342 135 92 234 283 ...
##  $ FP        : int  3072 5809 1321 400 2059 2765 118 162 189 155 ...
##  $ ganaPPK   : chr  "No" "No" "Si" "Si" ...

Formateo:

idhElec[,c(1:3,15)]=lapply(idhElec[,c(1:3,15)],as.factor)
idhElec[,c(7:14)]=lapply(idhElec[,c(7:14)],as.numeric)
str(idhElec)
## 'data.frame':    1834 obs. of  15 variables:
##  $ ubiReg    : Factor w/ 25 levels "10000","20000",..: 1 1 1 1 1 1 1 1 1 1 ...
##  $ ubiProv   : Factor w/ 195 levels "10100","10200",..: 2 2 2 2 2 2 3 3 3 3 ...
##  $ ubiDis    : Factor w/ 1834 levels "10101","10102",..: 23 22 24 25 26 27 29 30 31 32 ...
##  $ depa      : Factor w/ 25 levels "AMAZONAS","ANCASH",..: 1 1 1 1 1 1 1 1 1 1 ...
##  $ prov      : Factor w/ 195 levels "ABANCAY","ACOBAMBA",..: 19 19 19 19 19 19 24 24 24 24 ...
##  $ dist      : Factor w/ 1684 levels "ABANCAY","ABELARDO PARDO LEZAMETA",..: 83 117 411 476 645 730 324 358 421 437 ...
##  $ pobla     : num  11587 26067 6501 1443 23820 ...
##  $ idh       : num  0.311 0.479 0.366 0.408 0.236 ...
##  $ esperanza : num  76.8 74.7 78 77.4 77.4 ...
##  $ secundaria: num  21.6 59.3 38.7 44.1 16 ...
##  $ tiempoedu : num  5.38 8.33 5.77 6.24 5.78 8.33 5.76 6.75 4.83 5.04 ...
##  $ percapitaf: num  405 662 452 551 209 ...
##  $ PPK       : num  1823 4949 1490 604 6282 ...
##  $ FP        : num  3072 5809 1321 400 2059 ...
##  $ ganaPPK   : Factor w/ 2 levels "No","Si": 1 1 2 2 2 1 2 1 2 2 ...

Nuestra variable de interés es PPK. Veamos si hay correlación entre los componentes del IDH y esta variable a través de una matriz de correlación:

matriz=cor(idhElec[,c(9:13)],use="complete.obs")
round(matriz,2)
##            esperanza secundaria tiempoedu percapitaf  PPK
## esperanza       1.00       0.19      0.28       0.31 0.17
## secundaria      0.19       1.00      0.75       0.55 0.29
## tiempoedu       0.28       0.75      1.00       0.80 0.42
## percapitaf      0.31       0.55      0.80       1.00 0.46
## PPK             0.17       0.29      0.42       0.46 1.00

Correlación muy baja entre los componentes del IDH y votación por PPK


Modelo de regresión lineal para explicar el número de votos válidos a PPK [sin controlar por pobla]:

lineal1=lm(PPK ~ esperanza + secundaria + tiempoedu + percapitaf,data=idhElec)
summary(lineal1)
## 
## Call:
## lm(formula = PPK ~ esperanza + secundaria + tiempoedu + percapitaf, 
##     data = idhElec)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
## -32901  -4531   -735   2662 243816 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -17776.398   4673.303  -3.804 0.000147 ***
## esperanza       90.945     64.967   1.400 0.161723    
## secundaria      -9.571     22.118  -0.433 0.665264    
## tiempoedu     1259.284    337.408   3.732 0.000196 ***
## percapitaf      19.299      2.138   9.027  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 13960 on 1829 degrees of freedom
## Multiple R-squared:  0.2168, Adjusted R-squared:  0.2151 
## F-statistic: 126.6 on 4 and 1829 DF,  p-value: < 2.2e-16

Respondemos las alternativas:

  1. VERDADERO [El modelo lineal tiene un efecto estadísticamente significativo]
  2. FALSO [esperanza no tiene un efecto estadísticamente significativo en PPK]
  3. VERDADERO [Un incremento de una unidad en percapitaf aumenta PPK en 19,2]
  4. VERDADERO [Un incremento de una unidad en tiempoedu aumenta PPK en 1259]
  5. FALSO [Las variables componentes del IDH solo explican el 21,51% de PPK]

Incluyamos pobla como variable de control:

lineal2=lm(PPK ~ esperanza + secundaria + tiempoedu + percapitaf + pobla,data=idhElec)
summary(lineal2)
## 
## Call:
## lm(formula = PPK ~ esperanza + secundaria + tiempoedu + percapitaf + 
##     pobla, data = idhElec)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
## -43330  -1177    259   1155  61403 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -1.654e+03  1.518e+03  -1.089   0.2761    
## esperanza   -2.798e+01  2.104e+01  -1.330   0.1838    
## secundaria   2.651e+00  7.158e+00   0.370   0.7111    
## tiempoedu    1.940e+02  1.095e+02   1.772   0.0766 .  
## percapitaf   5.486e+00  7.006e-01   7.830  8.2e-15 ***
## pobla        2.831e-01  2.264e-03 125.057  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 4518 on 1828 degrees of freedom
## Multiple R-squared:  0.918,  Adjusted R-squared:  0.9178 
## F-statistic:  4095 on 5 and 1828 DF,  p-value: < 2.2e-16

Ahora respondemos la última alternativa:

  1. FALSO [Al empezar a controlar por pobla, vemos que se modifica el efecto de las variables: el modelo mismo deja de tener efecto significativo]

ECUACIÓN

La ecuación del modelo lineal sin habitantes sería:

PPK = -17776.398 + 90.945(esperanza) - 9.571(secundaria) + 1259.284(tiempoedu) + 19.299(percapitaf)


Modelo de regresión binomial para ver si PPK gana en la provincia [sin controlar por pobla]:

binomial1=glm(ganaPPK ~ esperanza + secundaria + tiempoedu + percapitaf, data=idhElec, family = "binomial")
summary(binomial1)
## 
## Call:
## glm(formula = ganaPPK ~ esperanza + secundaria + tiempoedu + 
##     percapitaf, family = "binomial", data = idhElec)
## 
## Deviance Residuals: 
##    Min      1Q  Median      3Q     Max  
## -1.666  -1.080  -0.904   1.199   1.655  
## 
## Coefficients:
##               Estimate Std. Error z value Pr(>|z|)    
## (Intercept)  3.7432039  0.6927416   5.403 6.54e-08 ***
## esperanza   -0.0558598  0.0096419  -5.793 6.90e-09 ***
## secundaria   0.0140213  0.0032690   4.289 1.79e-05 ***
## tiempoedu   -0.1062897  0.0496310  -2.142   0.0322 *  
## percapitaf   0.0005724  0.0003128   1.830   0.0673 .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 2528.8  on 1833  degrees of freedom
## Residual deviance: 2473.6  on 1829  degrees of freedom
## AIC: 2483.6
## 
## Number of Fisher Scoring iterations: 4

Respondemos las alternativas:

  1. VERDADERO [Todas las variables tienen efecto estadísticamente significativo, a excepción de percapitaf]

Saquemos el Pseudo-R2:

library(DescTools)
PseudoR2(binomial1)
##   McFadden 
## 0.02185594
  1. VERDADERO [Nuestras variables explican el 2% de victorias de PPK]

  2. VERDADERO [Secundaria tiene un efecto estadísticamente significativo en PPK, pero es un efecto muy bajo: solo aumenta la probabilidad de que PPK gane en esa provincia en un 1%]

Saco el Odds Ratio:

exp(coef(binomial1))
## (Intercept)   esperanza  secundaria   tiempoedu  percapitaf 
##  42.2330861   0.9456717   1.0141201   0.8991641   1.0005726
  1. VERDADERO [Un aumento de una unidad en esperanza reduce el odds de victoria de PPK en un factor de 0.94]

  2. FALSO [Un aumento de una unidad en tiempoedu reduce el odds de victoria de PPK en un actor de 0.89]

Incluyamos pobla como variable de control:

binomial2=glm(ganaPPK ~ esperanza + secundaria + tiempoedu + percapitaf + pobla, data=idhElec, family = "binomial")
summary(binomial2)
## 
## Call:
## glm(formula = ganaPPK ~ esperanza + secundaria + tiempoedu + 
##     percapitaf + pobla, family = "binomial", data = idhElec)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -1.6648  -1.0770  -0.9055   1.2011   1.6549  
## 
## Coefficients:
##               Estimate Std. Error z value Pr(>|z|)    
## (Intercept)  3.718e+00  6.952e-01   5.349 8.84e-08 ***
## esperanza   -5.568e-02  9.651e-03  -5.769 7.98e-09 ***
## secundaria   1.400e-02  3.269e-03   4.282 1.85e-05 ***
## tiempoedu   -1.046e-01  4.979e-02  -2.101   0.0356 *  
## percapitaf   5.932e-04  3.168e-04   1.873   0.0611 .  
## pobla       -4.283e-07  1.025e-06  -0.418   0.6760    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 2528.8  on 1833  degrees of freedom
## Residual deviance: 2473.4  on 1828  degrees of freedom
## AIC: 2485.4
## 
## Number of Fisher Scoring iterations: 4
  1. VERDADERO [Controlando por pobla, el modelo sigue teniendo un efecto estadísticamente significativo y no se modifica el efecto de las variables]