4.En un experimento para estudiar el efecto de la cantidad de polvo de hornear en una masa de galleta sobre la altura de elevación de las galletas, se probaron cuatro niveles de polvo de hornear y se hicieron cuatro galletas repetidas con cada nivel en un orden aleatorio. Los resultados se muestran en la tabla de abajo.
Es la altura de elevación de las galletas
Realice el análisis de varianza para probar la hipótesis de no tratamiento efecto.
Formule un contraste para probar la hipótesis de que el aumento de la altura de elevación es una función lineal del aumento de polvo de hornear en la masa, y prueba esta hipótesis.
contrste media altura en funcion de la levadura
.25 tsp .5 tsp .75 tsp 1 tsp 11.4 27.8 47.6 61.6 11.0 29.2 47.0 62.4 11.3 26.8 47.3 63.0 9.5 26.0 45.5 63.9
library(readxl)
Actividad4 <- read_excel("C:/Users/juanc/OneDrive/Escritorio/2021-1/Actividad4.xlsx")
Actividad4
## # A tibble: 16 x 2
## niveles respuesta
## <chr> <dbl>
## 1 tsp,25 11.4
## 2 tsp,25 11
## 3 tsp,25 11.3
## 4 tsp,25 9.5
## 5 tsp,5 27.8
## 6 tsp,5 29.2
## 7 tsp,5 26.8
## 8 tsp,5 26
## 9 tsp,75 47.6
## 10 tsp,75 47
## 11 tsp,75 47.3
## 12 tsp,75 45.5
## 13 tsp1 61.6
## 14 tsp1 62.4
## 15 tsp1 63
## 16 tsp1 63.9
## ANOVA
respuesta= Actividad4$respuesta
niveles= Actividad4$niveles
ANOVA = aov(respuesta~niveles,Actividad4)
summary(ANOVA)
## Df Sum Sq Mean Sq F value Pr(>F)
## niveles 3 6146 2048.6 1823 3.23e-16 ***
## Residuals 12 13 1.1
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
res = ANOVA$residuals
res
## 1 2 3 4 5 6 7 8 9 10 11
## 0.600 0.200 0.500 -1.300 0.350 1.750 -0.650 -1.450 0.750 0.150 0.450
## 12 13 14 15 16
## -1.350 -1.125 -0.325 0.275 1.175
library(collapsibleTree)
df = Actividad4
collapsibleTreeSummary(df, hierarchy = c('niveles', 'respuesta'))
Data_normalidad=shapiro.test(res)
Data_normalidad
##
## Shapiro-Wilk normality test
##
## data: res
## W = 0.93838, p-value = 0.3297
ifelse(Data_normalidad$p.value<0.05,"Datos no normal","Normalidad")
## [1] "Normalidad"
Prueba_varianzas= bartlett.test(res ~ Actividad4$niveles)
Prueba_varianzas
##
## Bartlett test of homogeneity of variances
##
## data: res by Actividad4$niveles
## Bartlett's K-squared = 0.71323, df = 3, p-value = 0.8701
ifelse(Prueba_varianzas$p.value<0.05,"Heterocedasticidad","Homocedasticidad")
## [1] "Homocedasticidad"
TukeyHSD(ANOVA, 'niveles')
## Tukey multiple comparisons of means
## 95% family-wise confidence level
##
## Fit: aov(formula = respuesta ~ niveles, data = Actividad4)
##
## $niveles
## diff lwr upr p adj
## tsp,5-tsp,25 16.650 14.42436 18.87564 0
## tsp,75-tsp,25 36.050 33.82436 38.27564 0
## tsp1-tsp,25 51.925 49.69936 54.15064 0
## tsp,75-tsp,5 19.400 17.17436 21.62564 0
## tsp1-tsp,5 35.275 33.04936 37.50064 0
## tsp1-tsp,75 15.875 13.64936 18.10064 0
agricolae::duncan.test(ANOVA, 'niveles', console = TRUE)
##
## Study: ANOVA ~ "niveles"
##
## Duncan's new multiple range test
## for respuesta
##
## Mean Square Error: 1.123958
##
## niveles, means
##
## respuesta std r Min Max
## tsp,25 10.800 0.8831761 4 9.5 11.4
## tsp,5 27.450 1.3796135 4 26.0 29.2
## tsp,75 46.850 0.9327379 4 45.5 47.6
## tsp1 62.725 0.9708244 4 61.6 63.9
##
## Alpha: 0.05 ; DF Error: 12
##
## Critical Range
## 2 3 4
## 1.633353 1.709652 1.755880
##
## Means with the same letter are not significantly different.
##
## respuesta groups
## tsp1 62.725 a
## tsp,75 46.850 b
## tsp,5 27.450 c
## tsp,25 10.800 d
Todas las medias son diferentes
#Histograma de los resuduales, se puede observar una distribución normal
hist(res)
plot(res)
library(lattice)
bwplot(respuesta ~ niveles, df)
# Datos atipicos
Valores_atipicos= outliers::grubbs.test(res)
Valores_atipicos
##
## Grubbs test for one outlier
##
## data: res
## G.6 = 1.8455, U = 0.7578, p-value = 0.4225
## alternative hypothesis: highest value 1.75 is an outlier
ifelse(Valores_atipicos$p.value<0.05,"Hay Valores atipicos","No hay valores atipicos")
## 6
## "No hay valores atipicos"