Tarea Final Contraste de hipotesis
Mercedes Marcela Pincay Pilay
1 de mayo de 2018
1. Lee el fichero dieta.csv en el que se recogen las siguientes variables y resuelve los apartados propuestos:
dieta<- read.table("dieta.csv", header = TRUE, sep = ";")a.Convierte en factor las variables tipoDiet y edad.
dieta$tipoDiet <- factor(dieta$tipoDiet)
dieta$edad <- factor (dieta$edad)
str(dieta)## 'data.frame': 24 obs. of 6 variables:
## $ id : int 1 2 3 4 5 6 7 8 9 10 ...
## $ edad : Factor w/ 3 levels "1","2","3": 3 3 2 2 1 2 3 1 2 1 ...
## $ tipoDiet: Factor w/ 3 levels "1","2","3": 1 1 3 3 1 1 1 1 2 3 ...
## $ peso0 : num 122 140.9 110.5 120.7 82.7 ...
## $ peso1 : num 108.6 89.2 115.4 106.2 96.5 ...
## $ peso2 : num 90.9 88.9 100.4 105.3 91.9 ...b. 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.
Comprobar Normalidad
shapiro.test(dieta$peso0[dieta$edad==1])##
## Shapiro-Wilk normality test
##
## data: dieta$peso0[dieta$edad == 1]
## W = 0.853, p-value = 0.1022shapiro.test(dieta$peso0[dieta$edad==2])##
## Shapiro-Wilk normality test
##
## data: dieta$peso0[dieta$edad == 2]
## W = 0.83071, p-value = 0.06038shapiro.test(dieta$peso0[dieta$edad==3])##
## Shapiro-Wilk normality test
##
## data: dieta$peso0[dieta$edad == 3]
## W = 0.92652, p-value = 0.4849se ha compobado que hay normalidad en la variables peso en los tres grupo de edad, su valor p>0,05
Comprobar Homocedasticidad
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.8037Existe homocedasticidad p-value>0,05 No se rechaza la hipotesis nula.
peso0_Edad <- aov(dieta$peso0 ~ dieta$edad)
summary (peso0_Edad)## Df Sum Sq Mean Sq F value Pr(>F)
## dieta$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 ' ' 1p-value < 0.05, existe diferencia significativa
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: holmExiste diferencia en el grupo 3 vs 1 y grup 3 vs. 2
c. 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.
Se comprueba normalidad
shapiro.test(dieta$peso2[dieta$edad==1])##
## Shapiro-Wilk normality test
##
## data: dieta$peso2[dieta$edad == 1]
## W = 0.91981, p-value = 0.4284shapiro.test(dieta$peso2[dieta$edad==2])##
## Shapiro-Wilk normality test
##
## data: dieta$peso2[dieta$edad == 2]
## W = 0.9739, p-value = 0.9267shapiro.test(dieta$peso2[dieta$edad==3])##
## Shapiro-Wilk normality test
##
## data: dieta$peso2[dieta$edad == 3]
## W = 0.91386, p-value = 0.382p-value > 0.05 por lo tanto hay normalidad.
A continuación demostramos homocedasticidad
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.1797Existe homocedasticidad
shapiro.test(dieta$peso2[dieta$tipoDiet==1])##
## Shapiro-Wilk normality test
##
## data: dieta$peso2[dieta$tipoDiet == 1]
## W = 0.90802, p-value = 0.3403shapiro.test(dieta$peso2[dieta$tipoDiet==2])##
## Shapiro-Wilk normality test
##
## data: dieta$peso2[dieta$tipoDiet == 2]
## W = 0.91767, p-value = 0.4113shapiro.test(dieta$peso2[dieta$tipoDiet==3])##
## Shapiro-Wilk normality test
##
## data: dieta$peso2[dieta$tipoDiet == 3]
## W = 0.96944, p-value = 0.8936Valor p>0.05 existe normalidad en los datos relacionado al peso 2 y el tipo de de dieta
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.4568Existe Homedastidad
peso2_edad_tipodieta <- aov( dieta$peso2 ~ dieta$edad * dieta$tipoDiet )
summary(peso2_edad_tipodieta)## Df Sum Sq Mean Sq F value Pr(>F)
## dieta$edad 2 84.2 42.1 1.320 0.296
## dieta$tipoDiet 2 1391.1 695.5 21.823 3.62e-05 ***
## dieta$edad:dieta$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 ' ' 1p-value < 0.001 e rechaza a la hipótesis nula, es decir,
tiene un efecto significativo en el experimento.
interaction.plot( dieta$edad, dieta$tipoDiet, dieta$peso2,
col = c( "blue", "red","green" ),
lty = c( 1,12 , 9 ),
lwd = 3,
ylab = "media del valor antes",
xlab = "Edad", trace.label = "Tipo de Dieta")
help("interaction.plot")## starting httpd help server ... doneComprueba 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.
library( reshape2 )## Warning: package 'reshape2' was built under R version 3.4.4dieta_Rest <- melt( dieta, id = c( "id", "edad", "tipoDiet" ),
measure = c( "peso0", "peso1", "peso2" ),
variable.name = "periodo",
value.name = "peso" )
head( dieta_Rest )## id edad tipoDiet periodo peso
## 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.06524shapiro.test( dieta$peso0 ) ##
## Shapiro-Wilk normality test
##
## data: dieta$peso0
## W = 0.98105, p-value = 0.9144shapiro.test( dieta$peso1 ) ##
## Shapiro-Wilk normality test
##
## data: dieta$peso1
## W = 0.97138, p-value = 0.7012shapiro.test( dieta$peso2 ) ##
## Shapiro-Wilk normality test
##
## data: dieta$peso2
## W = 0.96016, p-value = 0.4417p-value >0,05, existe normalidd
library(ez)## Warning: package 'ez' was built under R version 3.4.4options( contrasts = c( "contr.sum", "contr.poly" ) )
ezANOVA( data = dieta_Rest, dv = peso,
wid = id, within = periodo,
type = 3 )## Warning: Converting "id" to factor for ANOVA.## $ANOVA
## Effect DFn DFd F p p<.05 ges
## 2 periodo 2 46 9.007468 0.0004999883 * 0.2143998
##
## $`Mauchly's Test for Sphericity`
## Effect W p p<.05
## 2 periodo 0.9348576 0.4766505
##
## $`Sphericity Corrections`
## Effect GGe p[GG] p[GG]<.05 HFe p[HF] p[HF]<.05
## 2 periodo 0.9388416 0.0006806327 * 1.019405 0.0004999883 *Podemos asumir que existe esfericidad
pairwise.t.test( dieta_Rest$peso, dieta_Rest$periodo, p.adj = "holm")##
## Pairwise comparisons using t tests with pooled SD
##
## data: dieta_Rest$peso and dieta_Rest$periodo
##
## peso0 peso1
## peso1 0.04112 -
## peso2 0.00015 0.05374
##
## P value adjustment method: holmPodemos concluir que hay diferencias entre el peso del comienzo de la dieta con la mitad y con el final de la dieta; sin embargo no hay diferencia entre la mitad y el final de las dietas.
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ías 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”)
william <- read.table("william.csv", header = TRUE, sep = ";")Comprueba la normalidad de la variable explicativa (salario) y calcula la correlación entre salario y ausencias.
shapiro.test(william$salario)##
## Shapiro-Wilk normality test
##
## data: william$salario
## W = 0.93541, p-value = 0.3281Existe Normalidad
cor.test(william$ausencias, william$salario)##
## Pearson's product-moment correlation
##
## data: william$ausencias and william$salario
## 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.9006674Correlación inversa
plot(william$ausencias, william$salario)
# b. Realiza el ajuste del modelo.
nuev_modelo<-lm(william$salario ~ william$ausencias)
nuev_modelo##
## Call:
## lm(formula = william$salario ~ william$ausencias)
##
## Coefficients:
## (Intercept) william$ausencias
## 14.1778 -0.2696plot(william$ausencias, william$salario)
abline(nuev_modelo)
#Estudia la bondad de ajuste con la función anova() y explica el significado de los coeficientes obtenidos en la recta de regresión.
summary(nuev_modelo)##
## Call:
## lm(formula = william$salario ~ william$ausencias)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.2126 -0.8257 0.3698 0.7134 1.6743
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 14.17778 0.99927 14.188 2.74e-09 ***
## william$ausencias -0.26956 0.03607 -7.474 4.67e-06 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.285 on 13 degrees of freedom
## Multiple R-squared: 0.8112, Adjusted R-squared: 0.7967
## F-statistic: 55.86 on 1 and 13 DF, p-value: 4.672e-06anova(nuev_modelo)## Analysis of Variance Table
##
## Response: william$salario
## Df Sum Sq Mean Sq F value Pr(>F)
## william$ausencias 1 92.261 92.261 55.857 4.672e-06 ***
## Residuals 13 21.473 1.652
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Ecuación ..Salario=-027*ausencias +14.18 # Nótese que el salario es inversamente proporcional a las ausencias.
d. Realiza el diagnóstico del modelo.
# Normalidad de los residuos, homogeneidad de varianzas e # incorrelación de los residuos.
william$fitted.nuev_modelo <- fitted( nuev_modelo )
william$residuals.nuev_modelo <- residuals( nuev_modelo )
william$rstudent.nuev_modelo <- rstudent( nuev_modelo )
shapiro.test(william$rstudent.nuev_modelo)##
## Shapiro-Wilk normality test
##
## data: william$rstudent.nuev_modelo
## W = 0.94304, p-value = 0.4222library(lmtest)## Warning: package 'lmtest' was built under R version 3.4.4## Loading required package: zoo## Warning: package 'zoo' was built under R version 3.4.4##
## Attaching package: 'zoo'## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numericlibrary(zoo)
bptest(nuev_modelo)##
## studentized Breusch-Pagan test
##
## data: nuev_modelo
## BP = 0.25945, df = 1, p-value = 0.6105dwtest(william$salario ~ william$ausencias, alternative = "two.sided", data = william)##
## Durbin-Watson test
##
## data: william$salario ~ william$ausencias
## DW = 2.2983, p-value = 0.5582
## alternative hypothesis: true autocorrelation is not 0Hay incorrelación de los residuos
sessionInfo()## R version 3.4.3 (2017-11-30)
## Platform: x86_64-w64-mingw32/x64 (64-bit)
## Running under: Windows 7 x64 (build 7601) Service Pack 1
##
## Matrix products: default
##
## locale:
## [1] LC_COLLATE=Spanish_Ecuador.1252 LC_CTYPE=Spanish_Ecuador.1252
## [3] LC_MONETARY=Spanish_Ecuador.1252 LC_NUMERIC=C
## [5] LC_TIME=Spanish_Ecuador.1252
##
## attached base packages:
## [1] stats graphics grDevices utils datasets methods base
##
## other attached packages:
## [1] lmtest_0.9-36 zoo_1.8-1 ez_4.4-0 reshape2_1.4.3
##
## loaded via a namespace (and not attached):
## [1] Rcpp_0.12.15 nloptr_1.0.4 compiler_3.4.3
## [4] pillar_1.2.1 cellranger_1.1.0 plyr_1.8.4
## [7] forcats_0.3.0 tools_3.4.3 lme4_1.1-17
## [10] digest_0.6.15 gtable_0.2.0 evaluate_0.10.1
## [13] tibble_1.4.2 nlme_3.1-131 lattice_0.20-35
## [16] mgcv_1.8-22 rlang_0.2.0 openxlsx_4.0.17
## [19] Matrix_1.2-12 curl_3.2 yaml_2.1.18
## [22] haven_1.1.1 rio_0.5.10 stringr_1.3.0
## [25] knitr_1.20 rprojroot_1.3-2 grid_3.4.3
## [28] data.table_1.10.4-3 readxl_1.0.0 foreign_0.8-69
## [31] rmarkdown_1.9 minqa_1.2.4 carData_3.0-1
## [34] ggplot2_2.2.1 car_3.0-0 magrittr_1.5
## [37] MASS_7.3-47 splines_3.4.3 scales_0.5.0
## [40] backports_1.1.2 htmltools_0.3.6 abind_1.4-5
## [43] colorspace_1.3-2 stringi_1.1.6 lazyeval_0.2.1
## [46] munsell_0.4.3