TAREA 2: MÉTODOS DE CONTRASTE DE HIPÓTESIS Y DISEÑO DE EXPERIMENTOS.

EJERCICIO 1. Lee el fichero dieta.csv en el que se recogen las siguientes variables y resuelve los apartados propuestos:

dieta <- read.table ("dieta.csv", head= TRUE, sep = ";")
  1. Convierte en factor las variables tipoDiet y edad.
dieta$tipoDiet <- factor (dieta$tipoDiet)
dieta$edad <- factor (dieta$edad)
  1. Comprueba si hay diferencias en la media de los pesos antes de comenzar la dieta (Variable peso0) según el grupo de edad al que pertenece y encuentra en qué grupos están las diferencias.

-> H0: no hay diferencias entre las medias del peso inicial según el grupo de edad; H1: al menos una de las medias es distinta.

#  Comprobamos la normalidad para cada uno de los grupos que queremos comparar:
shapiro.test (dieta$peso0 [dieta$edad == "1"])
## 
##  Shapiro-Wilk normality test
## 
## data:  dieta$peso0[dieta$edad == "1"]
## W = 0.853, p-value = 0.1022
shapiro.test (dieta$peso0 [dieta$edad == "2"])
## 
##  Shapiro-Wilk normality test
## 
## data:  dieta$peso0[dieta$edad == "2"]
## W = 0.83071, p-value = 0.06038
shapiro.test (dieta$peso0 [dieta$edad == "3"])
## 
##  Shapiro-Wilk normality test
## 
## data:  dieta$peso0[dieta$edad == "3"]
## W = 0.92652, p-value = 0.4849
## Para todos los grupos de edad, la variable que recoge las medidas de peso inicial sigue una distribución normal (p > 0.05).

# Comprobamos la hvo
bartlett.test(dieta$peso0 ~ dieta$edad)
## 
##  Bartlett test of homogeneity of variances
## 
## data:  dieta$peso0 by dieta$edad
## Bartlett's K-squared = 0.43715, df = 2, p-value = 0.8037
## Existe homogeneidad de varianzas (p> 0.05)

# Al cumplirse los supuesto de normalidad y homocedasticidad podemos aplicar el test ANOVA de una vía:
anova <- aov( peso0 ~ edad, data = dieta )
summary (anova)
##             Df Sum Sq Mean Sq F value   Pr(>F)    
## edad         2   2544  1272.0   13.46 0.000173 ***
## Residuals   21   1985    94.5                     
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## Datos los p-valores del test ANOVA (p< 0.05), se rechaza la hipótesis nula, lo que lleva a afirmar que al menos una de las medias es diferente.

# Para conocer en qué grupos existen estas diferencias realizamos las comparaciones post-hoc:
pairwise.t.test( dieta$peso0, dieta$edad, p.adj = "bonferroni")
## 
##  Pairwise comparisons using t tests with pooled SD 
## 
## data:  dieta$peso0 and dieta$edad 
## 
##   1       2      
## 2 0.33973 -      
## 3 0.00015 0.00751
## 
## P value adjustment method: bonferroni
pairwise.t.test( dieta$peso0, dieta$edad, p.adj = "holm")
## 
##  Pairwise comparisons using t tests with pooled SD 
## 
## data:  dieta$peso0 and dieta$edad 
## 
##   1       2      
## 2 0.11324 -      
## 3 0.00015 0.00501
## 
## P value adjustment method: holm
## Con ambos test, vemos que existen diferencias estadísticamente significativas (p< 0.05) entre el grupo de edad 1-3 y 2-3, por lo que se podría decir que los individuos del grupo 3 de edad tuvieron un peso inicial diferente al resto de grupos.
  1. Comprueba si hay diferencias significativas en el peso final (peso2) según la interacción del grupo de edad al que pertenece el sujeto y el tipo de dieta al que se somete. Representa el gráfico de interacción con la edad en el eje x y el tipoDiet en tres líneas diferentes.

-> H0: no hay diferencias entre las medias del peso inicial según el grupo de edad, el tipo de dieta o la interacción entre éstas; H1: al menos una de las medias es distinta.

#  Comprobamos la normalidad para cada uno de los grupos que queremos comparar:
shapiro.test (dieta$peso2 [dieta$tipoDiet == "1"])
## 
##  Shapiro-Wilk normality test
## 
## data:  dieta$peso2[dieta$tipoDiet == "1"]
## W = 0.90802, p-value = 0.3403
shapiro.test (dieta$peso2 [dieta$tipoDiet == "2"])
## 
##  Shapiro-Wilk normality test
## 
## data:  dieta$peso2[dieta$tipoDiet == "2"]
## W = 0.91767, p-value = 0.4113
shapiro.test (dieta$peso2 [dieta$tipoDiet == "3"])
## 
##  Shapiro-Wilk normality test
## 
## data:  dieta$peso2[dieta$tipoDiet == "3"]
## W = 0.96944, p-value = 0.8936
shapiro.test (dieta$peso2 [dieta$edad == "1"])
## 
##  Shapiro-Wilk normality test
## 
## data:  dieta$peso2[dieta$edad == "1"]
## W = 0.91981, p-value = 0.4284
shapiro.test (dieta$peso2 [dieta$edad == "2"])
## 
##  Shapiro-Wilk normality test
## 
## data:  dieta$peso2[dieta$edad == "2"]
## W = 0.9739, p-value = 0.9267
shapiro.test (dieta$peso2 [dieta$edad == "3"])
## 
##  Shapiro-Wilk normality test
## 
## data:  dieta$peso2[dieta$edad == "3"]
## W = 0.91386, p-value = 0.382
## Para todos los grupos de edad y de tipo de dieta la variable que recoge el peso final sigue una distribución normal.

# Comprobamos la hvo
bartlett.test(dieta$peso2 ~ dieta$edad)
## 
##  Bartlett test of homogeneity of variances
## 
## data:  dieta$peso2 by dieta$edad
## Bartlett's K-squared = 3.4329, df = 2, p-value = 0.1797
bartlett.test(dieta$peso2 ~ dieta$tipoDiet)
## 
##  Bartlett test of homogeneity of variances
## 
## data:  dieta$peso2 by dieta$tipoDiet
## Bartlett's K-squared = 1.5668, df = 2, p-value = 0.4568
## En los dos casos estudiados se cumple el supuesto de homogeneidad de varianzas.

# Test ANOVA de dos vías
anova2 <- aov (peso2 ~ edad*tipoDiet, data = dieta)
library (car)
## Loading required package: carData
Anova (anova2, type= "III")
## Anova Table (Type III tests)
## 
## Response: peso2
##               Sum Sq Df   F value    Pr(>F)    
## (Intercept)    32638  1 1024.0372 3.202e-15 ***
## edad              18  2    0.2776 0.7613983    
## tipoDiet         875  2   13.7306 0.0004081 ***
## edad:tipoDiet    160  4    1.2550 0.3305195    
## Residuals        478 15                        
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
summary (anova2)
##               Df Sum Sq Mean Sq F value   Pr(>F)    
## edad           2   84.2    42.1   1.320    0.296    
## tipoDiet       2 1391.1   695.5  21.823 3.62e-05 ***
## edad:tipoDiet  4  160.0    40.0   1.255    0.331    
## Residuals     15  478.1    31.9                     
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## Según los p-valores obtenidos en el test, existen diferencias estadísticamente significativas en la media del peso final ("peso2") según el tipo de dieta (p< 0.05). No se encontraron diferencias por grupos de edad o por la interacción de "edad*tipodieta".

# Gráfico:

interaction.plot (dieta$edad, dieta$tipoDiet, dieta$peso2,
                  col = c ("orange", "blue", "green"), lty = c (1,3,12), lwd = 2, ylab = "media de peso final", xlab = "edad", trace.label = "tipo de dieta")

  1. Comprueba si la media de los pesos difieren dependiendo del momento de la dieta que se está. Reestructura el data frame con la función melt() del paquete reshape2. En caso de que difieran, encuentra en qué grupos están las diferencias.

-> H0: no hay diferencias entre las medias de pesos según el momento de la medición; H1: al menos una de las medias de pesos es diferente.

Realizamos un test ANOVA de medidas repetidas, para el cual se debe cumplir el supuesto de esfericidad. Para ello se debe reestructuras del data frame:

library( reshape2 )
dietaRe <- melt (dieta, id = c ("id", "edad", "tipoDiet"), measure = c ("peso0","peso1","peso2"), variable.name = "peso", value.name= "medicion")
head (dietaRe)
##   id edad tipoDiet  peso  medicion
## 1  1    3        1 peso0 122.01756
## 2  2    3        1 peso0 140.86780
## 3  3    2        3 peso0 110.52651
## 4  4    2        3 peso0 120.74844
## 5  5    1        1 peso0  82.73085
## 6  6    2        1 peso0 118.06524
# Test ANOVA para medidas repetidas
library (ez)
options( contrasts = c( "contr.sum", "contr.poly" ) )
ezANOVA( data = dietaRe, dv = medicion,
wid = id, within = peso,
type = 3 )
## Warning: Converting "id" to factor for ANOVA.
## $ANOVA
##   Effect DFn DFd        F            p p<.05       ges
## 2   peso   2  46 9.007468 0.0004999883     * 0.2143998
## 
## $`Mauchly's Test for Sphericity`
##   Effect         W         p p<.05
## 2   peso 0.9348576 0.4766505      
## 
## $`Sphericity Corrections`
##   Effect       GGe        p[GG] p[GG]<.05      HFe        p[HF] p[HF]<.05
## 2   peso 0.9388416 0.0006806327         * 1.019405 0.0004999883         *
## El test de Mauchly´s no da significativo (p>0.05), por lo que podemos asumir la esfericidad. El test ANOVA nos devuelve un p-valor significativo (p= 0.0005), por lo que rechazamos la hipótesis nula de igualdad de medias. De esta manera, sabemos que al menos una de las medias es distinta y para conocer exactamente dónde se encuentran estas diferencias debemos realizar las comparaciones post-hoc:
pairwise.t.test( dietaRe$medicion, dietaRe$peso, p.adj = "bonferroni")
## 
##  Pairwise comparisons using t tests with pooled SD 
## 
## data:  dietaRe$medicion and dietaRe$peso 
## 
##       peso0   peso1  
## peso1 0.06168 -      
## peso2 0.00015 0.16121
## 
## P value adjustment method: bonferroni
pairwise.t.test( dietaRe$medicion, dietaRe$peso, p.adj = "holm")
## 
##  Pairwise comparisons using t tests with pooled SD 
## 
## data:  dietaRe$medicion and dietaRe$peso 
## 
##       peso0   peso1  
## peso1 0.04112 -      
## peso2 0.00015 0.05374
## 
## P value adjustment method: holm
## Existen diferencias estadísticamente significativas entre las mediciones iniciales y finales ("peso0" y "peso2"). Así mismo, se cree también que las medias del peso al inicio y a la mitad de la dieta son diferente, pero este resultado varia según la correción utilizada en el test.

EJERCICIO 2: Una empresa quiere saber si existe relación entre el salario de un trabajador y las ausencias del mismo al trabajo. Para el estudio se dividió el salario en distintas categorís y se eligió aleatoriamente un grupo de trabajadores para determinar el número de días que habían faltado en los últimos tres años. ¿Se puede construir un modelo que relacione la categoría del salario y las ausencias en el trabajo? (Trabaja con el fichero “william.csv”)

# Cargamos el data frame:
willi <- read.table ("william.csv", head = TRUE, sep = ";")
  1. Comprueba la normalidad de la variable explicativa (salario) y calcula la correlación entre salario y ausencias.
# Normalidad de la variable explicativa:
shapiro.test(willi$salario)
## 
##  Shapiro-Wilk normality test
## 
## data:  willi$salario
## W = 0.93541, p-value = 0.3281
## La variable explicativa sigue una distribución normal (p= 0.33)

# Correlación entre "salario" y "ausencias":
cor.test (willi$salario, willi$ausencias)
## 
##  Pearson's product-moment correlation
## 
## data:  willi$salario and willi$ausencias
## t = -7.4737, df = 13, p-value = 4.672e-06
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  -0.9668476 -0.7211085
## sample estimates:
##        cor 
## -0.9006674
## Según el índice de correlación las variables a estudio están relacionadas significativamente (cor= -0.9; p-valor< 0.001; IC95%: [-0.97, -0.72]).
  1. Realiza el ajuste del modelo.
modelo <- lm (ausencias ~ salario, data= willi)
modelo
## 
## Call:
## lm(formula = ausencias ~ salario, data = willi)
## 
## Coefficients:
## (Intercept)      salario  
##      47.600       -3.009
## El modelo de regresión lineal simple nos devuelve la recta de regresión: ausencias= 47.6 + (-3.01 * salario).
  1. Estudia la bondad de ajuste con la función anova() y explica el significado de los coeficientes obtenidos en la recta de regresión.
# En primer lugar, para aplicar la función ANOVA debemos convertir la variable "salario" a factor y comprobar los supuestos de normalidad y homocedasticidad.
willi$salario<- factor (willi$salario)
shapiro.test (willi$ausencias)
## 
##  Shapiro-Wilk normality test
## 
## data:  willi$ausencias
## W = 0.94095, p-value = 0.3945
## Como hemos visto anteriormente (apartado 2a) la variable "salario" sigue una distribución normal. Igualmente, "ausencias" sigue una distribución normal (p= 0.39), según el test de Shapiro-Wilk.
# Homocedasticidad
library (car)
leveneTest(willi$ausencias ~ willi$salario)
## Levene's Test for Homogeneity of Variance (center = median)
##       Df F value Pr(>F)
## group  8  0.8083 0.6205
##        6
## Según el test de Levene, las varianzas de "ausencias" y "salario" son homogéneas.

# Test ANOVA para estudiar la bondad de ajuste:
anova3 <- aov (ausencias ~ salario, data = willi)
summary (anova3)
##             Df Sum Sq Mean Sq F value  Pr(>F)   
## salario      8   1187  148.34   10.72 0.00481 **
## Residuals    6     83   13.83                   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## El modelo de regresión lineal creado tiene significativa capacidad predictiva (p<0.001).
## Por tanto, podemos decir que la recta de regresión que explica nuestros datos tendrá como ordenada en el origen 47.6, que es el punto de corte con el eje Y ("ausencias"), y la pendiente de la recta es -3.01.
  1. Realiza el diagnóstico del modelo. Normalidad de los residuos, homogeneidad de varianzas e incorrelación de los residuos.
# Normalidad de los residuos:
willi$fitted.modelo <- fitted( modelo )
willi$residuals.modelo <- residuals( modelo )
willi$rstudent.modelo <- rstudent( modelo)
shapiro.test (willi$rstudent.modelo)
## 
##  Shapiro-Wilk normality test
## 
## data:  willi$rstudent.modelo
## W = 0.91538, p-value = 0.1637
## Los residuos tipificados siguen una distribución normal según el test de Shapiro Wilk (p=0.16)

# Homocedasticidad de los residuos:
library (lmtest)
## Loading required package: zoo
## 
## Attaching package: 'zoo'
## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric
bptest (modelo)
## 
##  studentized Breusch-Pagan test
## 
## data:  modelo
## BP = 0.52916, df = 1, p-value = 0.467
## Los residuos cumplen el supuesto de homogeneidad de varianzas según el test de Breusch-Pagan (p=0.47)

# Incorrelación de los residuos:
dwtest (ausencias~salario, alternative= "t", data= willi)
## 
##  Durbin-Watson test
## 
## data:  ausencias ~ salario
## DW = 1.4548, p-value = 0.3794
## alternative hypothesis: true autocorrelation is not 0
## Se rechaza la hipótesis nula, por lo que los residuos no estan correlacionados (p=0.38).