PRÁCTICA CALIFICADA 13

http://rpubs.com/Brayan_Milla/540323

EXPLORACIÓN BIVARIADA

  1. Carga de data:
library(rio)

linkGIT="https://github.com/JoseManuelMagallanes/Estadistica_Para_AnalisisPolitico/raw/master/hsb.sav"
estad=import(linkGIT)
str(estad,strict.width="cut",width=50)
## 'data.frame':    600 obs. of  15 variables:
##  $ ID    : num  1 2 3 4 5 6 7 8 9 10 ...
##   ..- attr(*, "format.spss")= chr "F5.0"
##  $ SEX   : num  2 1 2 2 2 1 1 2 1 2 ...
##   ..- attr(*, "format.spss")= chr "F5.0"
##  $ RACE  : num  2 2 2 2 2 2 2 2 2 2 ...
##   ..- attr(*, "format.spss")= chr "F5.0"
##  $ SES   : num  1 1 1 2 2 2 1 1 2 1 ...
##   ..- attr(*, "format.spss")= chr "F5.0"
##  $ SCTYP : num  1 1 1 1 1 1 1 1 1 1 ...
##   ..- attr(*, "format.spss")= chr "F5.0"
##  $ HSP   : num  3 2 2 3 3 2 1 1 1 1 ...
##   ..- attr(*, "format.spss")= chr "F5.0"
##  $ LOCUS : num  0.29 -0.42 0.71 0.06 0.22 0.46 0..
##   ..- attr(*, "format.spss")= chr "F5.2"
##  $ CONCPT: num  0.88 0.03 0.03 0.03 -0.28 0.03 -..
##   ..- attr(*, "format.spss")= chr "F5.2"
##  $ MOT   : num  0.67 0.33 0.67 0 0 0 0.33 1 0.33..
##   ..- attr(*, "format.spss")= chr "F5.2"
##  $ CAR   : num  10 2 9 15 1 11 10 9 9 11 ...
##   ..- attr(*, "format.spss")= chr "F5.0"
##  $ RDG   : num  33.6 46.9 41.6 38.9 36.3 49.5 62..
##   ..- attr(*, "format.spss")= chr "F5.2"
##  $ WRTG  : num  43.7 35.9 59.3 41.1 48.9 46.3 64..
##   ..- attr(*, "format.spss")= chr "F5.2"
##  $ MATH  : num  40.2 41.9 41.9 32.7 39.5 46.2 48..
##   ..- attr(*, "format.spss")= chr "F5.2"
##  $ SCI   : num  39 36.3 44.4 41.7 41.7 41.7 63.4..
##   ..- attr(*, "format.spss")= chr "F5.2"
##  $ CIV   : num  40.6 45.6 45.6 40.6 45.6 35.6 55..
##   ..- attr(*, "format.spss")= chr "F5.2"

EL SES DEBE SER CATEGÓRICA

Formatear: 2. Lea la metadata,y de formato:

estad$ID=as.character(estad$ID)

estad[,c(2,3,4,5,6,10)]=lapply(estad[,c(2,3,4,5,6,10)],as.factor)

estad$HSP=as.ordered(estad$HSP)

Ahora:

str(estad,strict.width="cut",width=50)
## 'data.frame':    600 obs. of  15 variables:
##  $ ID    : chr  "1" "2" "3" "4" ...
##  $ SEX   : Factor w/ 2 levels "1","2": 2 1 2 2 2..
##  $ RACE  : Factor w/ 4 levels "1","2","3","4": 2..
##  $ SES   : Factor w/ 3 levels "1","2","3": 1 1 1..
##  $ SCTYP : Factor w/ 2 levels "1","2": 1 1 1 1 1..
##  $ HSP   : Ord.factor w/ 3 levels "1"<"2"<"3": 3..
##  $ LOCUS : num  0.29 -0.42 0.71 0.06 0.22 0.46 0..
##   ..- attr(*, "format.spss")= chr "F5.2"
##  $ CONCPT: num  0.88 0.03 0.03 0.03 -0.28 0.03 -..
##   ..- attr(*, "format.spss")= chr "F5.2"
##  $ MOT   : num  0.67 0.33 0.67 0 0 0 0.33 1 0.33..
##   ..- attr(*, "format.spss")= chr "F5.2"
##  $ CAR   : Factor w/ 17 levels "1","2","3","4",...
##  $ RDG   : num  33.6 46.9 41.6 38.9 36.3 49.5 62..
##   ..- attr(*, "format.spss")= chr "F5.2"
##  $ WRTG  : num  43.7 35.9 59.3 41.1 48.9 46.3 64..
##   ..- attr(*, "format.spss")= chr "F5.2"
##  $ MATH  : num  40.2 41.9 41.9 32.7 39.5 46.2 48..
##   ..- attr(*, "format.spss")= chr "F5.2"
##  $ SCI   : num  39 36.3 44.4 41.7 41.7 41.7 63.4..
##   ..- attr(*, "format.spss")= chr "F5.2"
##  $ CIV   : num  40.6 45.6 45.6 40.6 45.6 35.6 55..
##   ..- attr(*, "format.spss")= chr "F5.2"

Preguntas bivariadas

a. Tipo 1: WRITING-SEX - Si tenemos que estos son los promedios de matematicas para hombres y mujeres:

f1=formula(WRTG ~ SEX)
aggregate(f1, estad, mean)
##   SEX     WRTG
## 1   1 49.78608
## 2   2 54.55443

Podemos inferir que a los hombres les va mejor en WRITING? Se puede afirmar que NO, porque tienen menor rendimiento que las mujeres.

b. Tipo 2: WRITING-NIVEL SOCIECON. Si tenemos que estos son los promedios de matematicas según programa escolar:

f2=formula(WRTG ~ SES)
aggregate(f2, estad,mean) 
##   SES     WRTG
## 1   1 48.70288
## 2   2 52.35853
## 3   3 55.59259

Podemos inferir que a los de clase alta les va mal en WRITING, a comparación de la clase media y loa clase baja que es la de mayor rendimiento.

Probando Hipótesis Las hipótesis se prueban siguiendo camino paramétrico o NO paramétrico.

Tipo 1:

Decidiendo si es no no paramétrico

library(knitr)
tablag= aggregate(f1, estad,
          FUN = function(x) {y <- shapiro.test(x); c(y$statistic, y$p.value)})

library(knitr)

shapiroTest=as.data.frame(tablag[,2])
names(shapiroTest)=c("W","Prob")

kable(cbind(tablag[1],shapiroTest))
SEX W Prob
1 0.9643550 2.8e-06
2 0.9445193 0.0e+00
Se obs erva que no son paramétricas, pues el Prob es menor a 0.05 en los dos sexos. 
library(knitr)
tablag= aggregate(f2, estad,
          FUN = function(x) {y <- shapiro.test(x); c(y$statistic, y$p.value)})

library(knitr)

shapiroTest=as.data.frame(tablag[,2])
names(shapiroTest)=c("W","Prob")

kable(cbind(tablag[1],shapiroTest))
SES W Prob
1 0.9673549 0.0020755
2 0.9517413 0.0000000
3 0.9249929 0.0000002

Se observa que no son paramétricas, pues el Prob es menor a 0.05 en las tres clases sociales

Prueba gráfica de la paramétrica:

library(ggpubr)
## Loading required package: ggplot2
## Loading required package: magrittr
ggqqplot(data=estad,x="WRTG") + facet_grid(. ~ SEX)

library(ggpubr)

ggqqplot(data=estad,x="WRTG") + facet_grid(. ~ SES)

Probemos normalidad de la variable, ¿que significa eso? No hay normalidad, por eso se irá por el camino de la paramétrica.

La curva normal es una distribución estadística importante:

wilcox.test(f1,estad)
## 
##  Wilcoxon rank sum test with continuity correction
## 
## data:  WRTG by SEX
## W = 32624, p-value = 1.255e-08
## alternative hypothesis: true location shift is not equal to 0

El p-value es menor a 0.05, entonces, hay diferenciación

Visualmente:

ggplot(data=estad, aes(x=SEX, y=WRTG)) + geom_boxplot(notch = T)

ggplot(data=estad, aes(x=SES, y=WRTG)) + geom_boxplot(notch = T)

Cuando los datos que tienes tienen una distribución parecida a esa curva, se puede aplicar un tipo de técnicas conocidas como las paramétricas.

Esta gráfica compara el histograma de las notas de matematica, y muestra la curva normal:

library(ggplot2)
ggplot(estad,aes(x=WRTG)) + geom_histogram(aes(y = ..density..),bins = 20, fill='green') +
        stat_function(fun = dnorm, colour = "red",
                      args = list(mean = mean(estad$WRTG, na.rm = TRUE),
                                 sd = sd(estad$WRTG, na.rm = TRUE))) + facet_grid(~SEX) + coord_flip()

¿Podrias afirmar que tu variable wrtg se distribuye normalmente en cada caso?

Otra alternativa gráfica es:

library(ggpubr)
ggqqplot(data=estad,x="WRTG") + facet_grid(. ~ SEX)

Si los puntos se alejan mucho de la diagonal, se aleja de la normalidad.

Como es dificil hacerlo visualmente siempre, podemos usar el test de Shapiro-Wilk, que nos reporta la probabilidad que los datos tengan esa distribución.

normalidadTest=function(x) {y =shapiro.test(x); 
                            c(y$statistic, y$p.value)}

resultado= aggregate(f1, estad,
                     FUN = normalidadTest) 

library(knitr)

shapiroTest=as.data.frame(resultado[,2])
names(shapiroTest)=c("SW_Statistic","Probabilidad")
kable(cbind(resultado[1],shapiroTest))
SEX SW_Statistic Probabilidad
1 0.9643550 2.8e-06
2 0.9445193 0.0e+00

El test nos dice que la probabilidad que la variable WTNG se comporte como la curva normal es muy baja (considera bajo si es menor a 0.05).

Opcion Paramétrica para dicotómica: Si hay normalidad usa la prueba t:

t.test(f1, estad)
## 
##  Welch Two Sample t-test
## 
## data:  WRTG by SEX
## t = -6.0807, df = 540.78, p-value = 2.264e-09
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -6.308770 -3.227937
## sample estimates:
## mean in group 1 mean in group 2 
##        49.78608        54.55443

Esta prueba informa la probabilidad que la media de wtrng sea la misma en ambos grupos de SEX.

Opcion No Paramétrica para dicotómica: Si no hay normalidad usa la prueba Mann-Whitney:

wilcox.test(f1,estad)
## 
##  Wilcoxon rank sum test with continuity correction
## 
## data:  WRTG by SEX
## W = 32624, p-value = 1.255e-08
## alternative hypothesis: true location shift is not equal to 0

tipo 2:

Queremos saber si hay normalidad de la numerica en cada grupo de la categorica:

resultado= aggregate(f2, estad,
                     FUN = normalidadTest) 

library(knitr)

shapiroTest=as.data.frame(resultado[,2])
names(shapiroTest)=c("SW_Statistic","Probabilidad")
kable(cbind(resultado[1],shapiroTest))
SES SW_Statistic Probabilidad
1 0.9673549 0.0020755
2 0.9517413 0.0000000
3 0.9249929 0.0000002

Como al menos una tiene probabilidad menor a 0.05, debemos ir por el camino no paramétrico.

Opcion Paramétrica para politomica:

summary(aov(f2, data=estad))
##              Df Sum Sq Mean Sq F value   Pr(>F)    
## SES           2   3552    1776   19.96 4.07e-09 ***
## Residuals   597  53116      89                     
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Los astericos indican que la probabilidad de que todas las medias sean iguales es menor a 0.05. De ahi que al menos una difiere de las demás. Tratemos de detectar las diferencias:

library(ggpubr)
ggerrorplot(estad, x = "SES", 
            y = "WRTG", 
            desc_stat = "mean_ci"
            )

El nivel 1 se diferenciaría de los demás.

Opcion No Paramétrica para politomica: Aquí puedes usar la prueba de Kruskal-Wallis:

kruskal.test(f2,estad)
## 
##  Kruskal-Wallis rank sum test
## 
## data:  WRTG by SES
## Kruskal-Wallis chi-squared = 37.037, df = 2, p-value = 9.069e-09

Aqui no muestra asteriscos, pero la probabilidad (p-value) es también MAYOR a 0.05.

Visualmente:

ggplot(data=estad, aes(x=SES, y=WRTG)) + geom_boxplot(notch = T)

En este caso, se ha puesto un ‘notch’ al boxplot. Si los notches se intersectan, se asume igualdad de medianas, de ahí que la opcion 1 es diferente a las demás.