LINK: http://rpubs.com/Brayan_Milla/553942
DATOS1=read.csv("https://docs.google.com/spreadsheets/d/e/2PACX-1vTeDXZ6uF0U5AABrxVZT8IjwM433MFavuDEXofzKtfzqs_lYFaNddy1xZNdYghCkUuktb0LO92ALR2d/pub?output=csv", stringsAsFactors = F,na.strings = '')
str(DATOS1)
## 'data.frame': 1834 obs. of 12 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 : chr "AMAZONAS" "AMAZONAS" "AMAZONAS" "AMAZONAS" ...
## $ prov : chr "BAGUA" "BAGUA" "BAGUA" "BAGUA" ...
## $ dist : chr "ARAMANGO" "BAGUA" "COPALLIN" "EL PARCO" ...
## $ pobla : int 11587 26067 6501 1443 23820 8020 349 282 922 883 ...
## $ esperanza : num 76.8 74.7 78 77.4 77.4 ...
## $ accesoedu : 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 ...
summary(DATOS1)
## ubiReg ubiProv ubiDis depa
## Min. : 10000 Min. : 10100 Min. : 10101 Length:1834
## 1st Qu.: 50000 1st Qu.: 50200 1st Qu.: 50205 Class :character
## Median :100000 Median :100450 Median :100452 Mode :character
## Mean :106390 Mean :106929 Mean :106937
## 3rd Qu.:150000 3rd Qu.:150800 3rd Qu.:150808
## Max. :250000 Max. :250400 Max. :250401
## prov dist pobla esperanza
## Length:1834 Length:1834 Min. : 181 Min. :51.72
## Class :character Class :character 1st Qu.: 1915 1st Qu.:70.02
## Mode :character Mode :character Median : 4564 Median :73.39
## Mean : 16432 Mean :72.67
## 3rd Qu.: 11485 3rd Qu.:76.45
## Max. :1025929 Max. :83.52
## accesoedu percapitaf PPK FP
## Min. : 2.030 Min. : 100.0 Min. : 0.0 Min. : 0.0
## 1st Qu.: 5.240 1st Qu.: 201.7 1st Qu.: 378.2 1st Qu.: 413.2
## Median : 6.500 Median : 317.8 Median : 945.5 Median : 929.5
## Mean : 6.825 Mean : 392.4 Mean : 4562.7 Mean : 4529.7
## 3rd Qu.: 8.178 3rd Qu.: 511.9 3rd Qu.: 2279.8 3rd Qu.: 2443.5
## Max. :14.250 Max. :1596.1 Max. :264607.0 Max. :318615.0
Lo han contratado para una investigación. La institucion que lo ha contratado supone que: 1. PPK tuvo más apoyo que FP mientras mejor acceso a la educación. 2. PPK tuvo más apoyo que FP mientras mayor era a la esperanza de vida. 3. PPK tuvo menos apoyo que FP mientras mayores ingresos.
No olvide controlar sus modelos inferenciales multivariados.
Usando la data, responda:
Cómo saber dónde ganó? Debo saber donde PPK sacó más votos que Keiko, eso se cacula así:
DATOS1$difvotos=DATOS1$PPK-DATOS1$FP
head(aggregate(difvotos ~ ubiProv, data = DATOS1, sum),20)
## ubiProv difvotos
## 1 10100 2061
## 2 10200 2064
## 3 10300 -2829
## 4 10400 2139
## 5 10500 -3084
## 6 10600 791
## 7 10700 -9371
## 8 20100 1604
## 9 20200 -397
## 10 20300 1681
## 11 20400 330
## 12 20500 -1757
## 13 20600 -3821
## 14 20700 610
## 15 20800 -8826
## 16 20900 -450
## 17 21000 5922
## 18 21100 -4390
## 19 21200 -10696
## 20 21300 3897
Entonces, si pido un summary y veo negativos, sabre que no ganó en todas las provincias:
ubiProv=aggregate(difvotos ~ ubiProv, data = DATOS1, sum)
summary(ubiProv$difvotos)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -79776.0 -6174.5 -364.0 309.7 3609.5 274149.0
………Aquí se en cuales:
ubiProv[ubiProv$difvotos>0,"ubiProv"]
## [1] 10100 10200 10400 10600 20100 20300 20400 20700 21000 21300
## [11] 21500 21600 21700 21800 21900 30100 30300 30500 30600 30700
## [21] 40100 40200 40400 40500 40600 40700 40800 50100 50200 50300
## [31] 51000 60300 60400 60600 60700 60800 60900 61200 70100 80100
## [41] 80200 80300 80400 80500 80600 80700 80800 81000 81100 81200
## [51] 81300 90100 90200 90300 90700 100300 100400 100500 100700 101000
## [61] 101100 110200 120100 120500 120800 120900 150100 160100 160200 160700
## [71] 180100 180200 180300 190100 190200 200200 200700 210100 210200 210300
## [81] 210400 210500 210600 210700 210800 210900 211100 211300 220900 230100
## [91] 230200 230300 230400
Cómo saber dónde ganó? Debo saber donde PPK sacó más votos que Keiko, eso se cacula así:
DATOS1$difvotos=DATOS1$PPK-DATOS1$FP
head(aggregate(difvotos ~ ubiReg, data = DATOS1, sum),20)
## ubiReg difvotos
## 1 10000 -8229
## 2 20000 -13433
## 3 30000 7173
## 4 40000 294889
## 5 50000 -6609
## 6 60000 1026
## 7 70000 3494
## 8 80000 192768
## 9 90000 23266
## 10 100000 -7211
## 11 110000 -27094
## 12 120000 -15287
## 13 130000 -217134
## 14 140000 -122775
## 15 150000 15687
## 16 160000 31347
## 17 170000 -19250
## 18 180000 38707
## 19 190000 1749
## 20 200000 -197642
Entonces, si pido un summary y veo negativos, sabre que no ganó en todas las provincias:
ubiReg=aggregate(difvotos ~ ubiReg, data = DATOS1, sum)
summary(ubiReg$difvotos)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -217134 -27094 -6609 2415 23266 294889
Aquí se en cuales:
ubiReg[ubiReg$difvotos>0,"ubiReg"]
## [1] 30000 40000 60000 70000 80000 90000 150000 160000 180000 190000
## [11] 210000 230000
Aqui se cuantas:
length(ubiReg[ubiReg$difvotos>=0,'ubiReg'])
## [1] 12
shapiro.test(DATOS1$difvotos)
##
## Shapiro-Wilk normality test
##
## data: DATOS1$difvotos
## W = 0.46253, p-value < 2.2e-16
No paramétrico
De ahí que voy por Spearman:
cor.test(DATOS1$difvotos,DATOS1$percapitaf, method = "spearman")
## Warning in cor.test.default(DATOS1$difvotos, DATOS1$percapitaf, method =
## "spearman"): Cannot compute exact p-value with ties
##
## Spearman's rank correlation rho
##
## data: DATOS1$difvotos and DATOS1$percapitaf
## S = 1112796710, p-value = 0.0004149
## alternative hypothesis: true rho is not equal to 0
## sample estimates:
## rho
## -0.08235373
Graficamente:
library(ggpubr)
## Loading required package: ggplot2
## Loading required package: magrittr
preg2=ggscatter(DATOS1,
x = "difvotos", y = "percapitaf",
cor.coef = TRUE,
cor.method = "spearman")
preg2
Para las siguientes preguntas, hacemos una regresión:
todasLasHipo=lm(difvotos~accesoedu+esperanza+percapitaf, data=DATOS1)
summary(todasLasHipo)
##
## Call:
## lm(formula = difvotos ~ accesoedu + esperanza + percapitaf, data = DATOS1)
##
## Residuals:
## Min 1Q Median 3Q Max
## -56261 -899 203 1095 68953
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 4963.1962 1775.0675 2.796 0.00523 **
## accesoedu 180.4656 100.0880 1.803 0.07154 .
## esperanza -105.1583 24.6980 -4.258 2.17e-05 ***
## percapitaf 3.7714 0.8052 4.684 3.02e-06 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 5310 on 1830 degrees of freedom
## Multiple R-squared: 0.05234, Adjusted R-squared: 0.05078
## F-statistic: 33.69 on 3 and 1830 DF, p-value: < 2.2e-16
H1:PPK tuvo más apoyo que FP mientras mejor acceso a la educación.
Se confirma la H1. La relación es directa y el coeficiente (180.47) es significativo al 0.1.
No se confirma la H3. La relación es directa y el coeficiente (3.77) es significativo al 0.001. # Se cumple la hipotesis 2? que nos puedes informar sobre esa hipotesis? H2:PPK tuvo más apoyo que FP mientras mayor era a la esperanza de vida.
No se confirma la H2. La relación es inversa y el coeficiente (-105.16) es significativo al 0.001.
H3:PPK tuvo menos apoyo que FP mientras mayores ingresos.
No se confirma la H3. La relación es directa y el coeficiente (3.77) es significativo al 0.001.
Columna donde 1 es gana y 0 es no gana:
DATOS1$ganaPPK=as.numeric(DATOS1$difvotos>0)
Calculo el promedio por grupo:
aggregate(percapitaf~ganaPPK, data = DATOS1, mean)
## ganaPPK percapitaf
## 1 0 386.2901
## 2 1 399.6531
El promedio parece mayor, pero veamos errores:
library(ggpubr)
ggerrorplot(data=DATOS1, x = "ganaPPK",
y = "percapitaf",
desc_stat = "mean_ci"
)
Como los errores se intersectan, hago prueba de contrastes:
Primero, verifico si la numerica (ingresos) es normal:
shapiro.test(DATOS1$percapitaf)
##
## Shapiro-Wilk normality test
##
## data: DATOS1$percapitaf
## W = 0.85858, p-value < 2.2e-16
Por lo anterior, corresponde la U de Mann Whitney
kruskal.test(percapitaf~ganaPPK,data=DATOS1)
##
## Kruskal-Wallis rank sum test
##
## data: percapitaf by ganaPPK
## Kruskal-Wallis chi-squared = 4.7159, df = 1, p-value = 0.02989
Con ese p-valor (0.02989) debo rechazar que las medias sean iguales. Eso contradice el gráfico anterior. Veamos el boxplot:
ggplot(data=DATOS1, aes(x=as.factor(ganaPPK), y=percapitaf)) + geom_boxplot(notch = T)
La presencia de atipicos confunde a la U de Mann Whitney, de hecho la mediana de Keiko es mas alta. En conclusión, por ambos gráficos podemos decir que la diferencia de promedios no es significativa.