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:
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:
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:
Saquemos el Pseudo-R2:
library(DescTools)
PseudoR2(binomial1)
## McFadden
## 0.02185594
VERDADERO [Nuestras variables explican el 2% de victorias de PPK]
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
VERDADERO [Un aumento de una unidad en esperanza reduce el odds de victoria de PPK en un factor de 0.94]
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