En el libro Design and Analysis of Experiments with R de John Lawson se encuentra un ejemplo de un experimento que se realizó para determinar si el tiempo de reposo influía en el crecimiento de masas de panes.
A continuación se presentan los resultados de dicho experimento:
library(readxl)
pan <- read_excel("crecim_pan2.xlsx")
pan$Tiempo <- factor(pan$Tiempo)
str(pan)
## Classes 'tbl_df', 'tbl' and 'data.frame': 12 obs. of 4 variables:
## $ Idmasa: num 1 2 3 4 5 6 7 8 9 10 ...
## $ Tiempo: Factor w/ 3 levels "35","40","45": 1 1 1 1 2 2 2 2 3 3 ...
## $ Altura: num 4.5 5 5.5 6.75 6.5 6.5 10.5 9.5 9.75 8.75 ...
## $ orden : num 8 12 11 1 9 10 7 5 4 6 ...
library(ggplot2)
ggplot(pan, aes(Tiempo, Altura)) +
geom_jitter(width = 0.1, height = 0) +
labs(title = "Relación del tiempo de reposo con la altura alcanzada por el pan",
x = "Tiempo (minutos)",
y = "Altura (cm)") +
scale_x_discrete(breaks = c("35","40","45")) +
scale_y_continuous(breaks = seq(3,12)) +
stat_summary(fun.y = "mean", geom = "point", col = "red",
shape = 21, stroke = 2) +
stat_summary(fun.y = "mean", geom = "line", col = "red",
linetype = 2, aes(group = 1))
library(dplyr)
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
pan %>%
summarise(mediaA = mean(Altura), dsA = sd(Altura), numExp = n())
## # A tibble: 1 x 3
## mediaA dsA numExp
## <dbl> <dbl> <int>
## 1 7.33 1.97 12
pan %>%
group_by(Tiempo) %>%
summarise(mediaA = mean(Altura), dsA = sd(Altura), numExp = n())
## # A tibble: 3 x 4
## Tiempo mediaA dsA numExp
## <fct> <dbl> <dbl> <int>
## 1 35 5.44 0.966 4
## 2 40 8.25 2.06 4
## 3 45 8.31 1.36 4
\[ y_{ij} = \mu_i + \epsilon_{ij} \] Donde: \[ \epsilon_{ij} \sim \mathcal{N}(0, \sigma^2) \quad i.i.d. \]
\[ \begin{eqnarray*} y_{ij} & = & \mu + \alpha_i + \epsilon_{ij} \\ \textrm{Dónde:} && \\ \epsilon_{ij} & \sim & \mathcal{N}(0, \sigma^2) \quad i.i.d. \end{eqnarray*} \]
modelo1aov <- aov(Altura ~ Tiempo, data = pan)
summary(modelo1aov)
## Df Sum Sq Mean Sq F value Pr(>F)
## Tiempo 2 21.57 10.786 4.602 0.042 *
## Residuals 9 21.09 2.344
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
modelo1lm <- lm(Altura ~ Tiempo, data = pan)
summary(modelo1lm)
##
## Call:
## lm(formula = Altura ~ Tiempo, data = pan)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.812 -1.141 0.000 1.266 2.250
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 5.4375 0.7655 7.104 5.65e-05 ***
## Tiempo40 2.8125 1.0825 2.598 0.0288 *
## Tiempo45 2.8750 1.0825 2.656 0.0262 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.531 on 9 degrees of freedom
## Multiple R-squared: 0.5056, Adjusted R-squared: 0.3958
## F-statistic: 4.602 on 2 and 9 DF, p-value: 0.042
model.tables(modelo1aov, type = "mean", se = TRUE)
## Tables of means
## Grand mean
##
## 7.333333
##
## Tiempo
## Tiempo
## 35 40 45
## 5.438 8.250 8.313
##
## Standard errors for differences of means
## Tiempo
## 1.083
## replic. 4
model.tables(modelo1aov, type = "effects", se = TRUE)
## Tables of effects
##
## Tiempo
## Tiempo
## 35 40 45
## -1.8958 0.9167 0.9792
##
## Standard errors of effects
## Tiempo
## 0.7655
## replic. 4
plot(modelo1lm)
library(car)
##
## Attaching package: 'car'
## The following object is masked from 'package:dplyr':
##
## recode
id <- qqPlot(modelo1lm, id.n = 12, reps = 10000)
shapiro.test(rstudent(modelo1lm))
##
## Shapiro-Wilk normality test
##
## data: rstudent(modelo1lm)
## W = 0.94141, p-value = 0.5166
bartlett.test(Altura ~ Tiempo, data = pan)
##
## Bartlett test of homogeneity of variances
##
## data: Altura by Tiempo
## Bartlett's K-squared = 1.4732, df = 2, p-value = 0.4787
library(car)
leveneTest(modelo1lm)
## Levene's Test for Homogeneity of Variance (center = median)
## Df F value Pr(>F)
## group 2 2.7992 0.1134
## 9
fligner.test(Altura ~ Tiempo, data = pan)
##
## Fligner-Killeen test of homogeneity of variances
##
## data: Altura by Tiempo
## Fligner-Killeen:med chi-squared = 3.9103, df = 2, p-value = 0.1415
library(HH)
## Loading required package: lattice
## Loading required package: grid
## Loading required package: latticeExtra
## Loading required package: RColorBrewer
##
## Attaching package: 'latticeExtra'
## The following object is masked from 'package:ggplot2':
##
## layer
## Loading required package: multcomp
## Loading required package: mvtnorm
## Loading required package: survival
## Loading required package: TH.data
## Loading required package: MASS
##
## Attaching package: 'MASS'
## The following object is masked from 'package:dplyr':
##
## select
##
## Attaching package: 'TH.data'
## The following object is masked from 'package:MASS':
##
## geyser
## Loading required package: gridExtra
##
## Attaching package: 'gridExtra'
## The following object is masked from 'package:dplyr':
##
## combine
##
## Attaching package: 'HH'
## The following objects are masked from 'package:car':
##
## logit, vif
hov(Altura ~ Tiempo, data = pan)
##
## hov: Brown-Forsyth
##
## data: Altura
## F = 2.7992, df:Tiempo = 2, df:Residuals = 9, p-value = 0.1134
## alternative hypothesis: variances are not identical
with(pan, plot(rstudent(modelo1lm) ~ orden, pch = 19,
main = "Gráfica del orden de corrida",
xlab = "Orden de corrida",
ylab = "Residuales estandarizados",
xlim = c(-1, 12),
ylim = c(-2.1, 2.1)))
with(pan, text(orden, rstudent(modelo1lm),
labels = paste(Idmasa, "t=", Tiempo), adj = 1,
pos = 3, cex = 0.7))
abline(h = 0, col = "red", lty = 2)
library(lmtest)
## Loading required package: zoo
##
## Attaching package: 'zoo'
## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric
dwtest(modelo1lm, order.by = ~orden, data = pan, alternative = "two.sided")
##
## Durbin-Watson test
##
## data: modelo1lm
## DW = 1.5841, p-value = 0.3484
## alternative hypothesis: true autocorrelation is not 0
Las compraraciones pareadas se dividen en dos clases:
Control de la tasa de error de experimento jucio en inglés Family-wise Error Rate (FWER) y se define como la probabilidad de al menos un falso positivo.
Proporción esperada de falsos positivos entre las prueba que fueron significativs o en inglés False Discovery Rate (FDR).
Los métodos de Holm, Hochberg, Hommel y Bonferroni pertenecen a FWER. Intentan limitar la probabilidad de un falso positivo (cometer el error tipo I, rechazar Ho cuando en realidad es correcta), por lo tanto son conservadoras o muy estrictas.
Los métodos que pertenecen a FDR controlan el valor esperado de la proporción de falsos descubrimientos.
La mayoría de los métodos solo utilizan las probabilidades, sin embargo las pruebas de Tukey y Dunnet también utilizan la variabilidad de los datos. Las pruebas de Tukey y Dunnet se consideran métodos FWER.
No existe un consejo definitivo para determinar el ajuste a utilizar. En general se deberá escojer un método que le sea familiar a su audiencia de su campo de estudio. También se puede tener un poco de lógica a la hora de escoger algún tipo prueba, por ejemplo si es un estudio inicial, novedoso y preliminar se preferirían métodos que muestren significancia potencial para futuros estudios, si por el otro lado se tratan de estudios que exigen un algo grado de evidencia y que involucren vidas humanas como en caso médico se prefieren pruebas muy extrictas y conservadoras.
La prueba más liberal o más laxa es la que no hace ningún tipo de corrección y puede rechazar la hipótesis nula donde en realidad es cierta.
Por el otro lado la prueba más conservadora es la corrección de Bomferroni.
Entre estos dos extremos se encuentran diversas pruebas de comparación de medias.
La prueba de Tukey se considera dentro de las pruebas conservadoras.
pairwise.t.test(x = pan$Altura, g = pan$Tiempo, p.adjust.method = "none")
##
## Pairwise comparisons using t tests with pooled SD
##
## data: pan$Altura and pan$Tiempo
##
## 35 40
## 40 0.029 -
## 45 0.026 0.955
##
## P value adjustment method: none
pairwise.t.test(x = pan$Altura, g = pan$Tiempo, p.adjust.method = "bonferroni")
##
## Pairwise comparisons using t tests with pooled SD
##
## data: pan$Altura and pan$Tiempo
##
## 35 40
## 40 0.086 -
## 45 0.079 1.000
##
## P value adjustment method: bonferroni
pairwise.t.test(x = pan$Altura, g = pan$Tiempo, p.adjust.method = "hommel")
##
## Pairwise comparisons using t tests with pooled SD
##
## data: pan$Altura and pan$Tiempo
##
## 35 40
## 40 0.058 -
## 45 0.052 0.955
##
## P value adjustment method: hommel
TukeyHSD(modelo1aov)
## Tukey multiple comparisons of means
## 95% family-wise confidence level
##
## Fit: aov(formula = Altura ~ Tiempo, data = pan)
##
## $Tiempo
## diff lwr upr p adj
## 40-35 2.8125 -0.2099347 5.834935 0.0676257
## 45-35 2.8750 -0.1474347 5.897435 0.0618204
## 45-40 0.0625 -2.9599347 3.084935 0.9981643