PRÁCTICA DIRIGIDA 16

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:

1. PPK ganó le ganó a FP en todas las provincias?

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

PPK ganó le ganó a FP en todos los departamentos?

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

Existe correlación entre la ventaja que le sacó PPK a FP y nivel de ingresos? Qué coeficiente usó?

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

Se cumple la hipotesis 1? que nos puedes informar sobre esa hipotesis?

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.

Se cumple la hipotesis 3? que nos puedes informar sobre esa hipotesis?

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.

Sera cierto que el promedio de ingresos es mas alto donde gano PPK y perdio Keiko?

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.