# Datos
t3 <- data.frame(
tratamiento = rep(c("Premuda", "Ayuno", "Salvado60", "Salvado80", "Malta"), each = 5),
valor = c(
94.09, 90.45, 99.38, 73.56, 74.39,
98.81, 103.55, 115.23, 129.06, 117.61,
197.18, 207.31, 177.50, 226.05, 222.74,
102.93, 117.51, 119.92, 112.01, 101.10,
83.14, 89.59, 87.76, 96.43, 82.94
)
)
# ANOVA
modelo <- aov(valor ~ tratamiento, data = t3)
summary(modelo)
## Df Sum Sq Mean Sq F value Pr(>F)
## tratamiento 4 48569 12142 78.08 6.48e-12 ***
## Residuals 20 3110 156
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
TukeyHSD(modelo)
## Tukey multiple comparisons of means
## 95% family-wise confidence level
##
## Fit: aov(formula = valor ~ tratamiento, data = t3)
##
## $tratamiento
## diff lwr upr p adj
## Malta-Ayuno -24.880 -48.480671 -1.279329 0.0357276
## Premuda-Ayuno -26.478 -50.078671 -2.877329 0.0232343
## Salvado60-Ayuno 93.304 69.703329 116.904671 0.0000000
## Salvado80-Ayuno -2.158 -25.758671 21.442671 0.9986602
## Premuda-Malta -1.598 -25.198671 22.002671 0.9995895
## Salvado60-Malta 118.184 94.583329 141.784671 0.0000000
## Salvado80-Malta 22.722 -0.878671 46.322671 0.0626613
## Salvado60-Premuda 119.782 96.181329 143.382671 0.0000000
## Salvado80-Premuda 24.320 0.719329 47.920671 0.0414321
## Salvado80-Salvado60 -95.462 -119.062671 -71.861329 0.0000000
# Supongamos diferencia mínima de interés = 25, varianza residual estimada del modelo
# Varianza entre grupos (usamos la varianza de las medias de grupo)
between_var <- var(tapply(t3$valor, t3$tratamiento, mean))
# Varianza residual (dentro de grupo)
within_var <- summary(modelo)[[1]][["Mean Sq"]][2]
# Parámetros
z_alpha <- 1.96 # para 5% de significancia bilateral
z_beta <- 0.84 # para 80% de potencia
sigma2 <- 156 # varianza residual estimada
delta <- 25 # diferencia mínima de interés
# Cálculo de n por grupo
n <- (2 * (z_alpha + z_beta)^2 * sigma2) / (delta^2)
n
## [1] 3.913728
kruskal.test(valor ~ tratamiento, data = t3)
##
## Kruskal-Wallis rank sum test
##
## data: valor by tratamiento
## Kruskal-Wallis chi-squared = 20.418, df = 4, p-value = 0.0004128
# Crear los datos
blancura <- c(55, 49, 50, 47, 37, # Lavomatic
43, 44, 57, 38, 35, # Ajax
NA, 52, 49, 49, NA) # Rindex
detergente <- rep(c("Lavomatic", "Ajax", "Rindex"), each = 5)
lavadora <- rep(c("Centrales", "Icasa", "LG", "Whirpool", "Mabe"), 3)
# Crear data frame
dbca <- data.frame(blancura, detergente = factor(detergente), lavadora = factor(lavadora))
# Eliminar NA para el ANOVA inicial
modelo_completo <- aov(blancura ~ detergente + lavadora, data = dbca, na.action = na.omit)
# Ver tabla ANOVA
summary(modelo_completo)
## Df Sum Sq Mean Sq F value Pr(>F)
## detergente 2 90.83 45.42 1.739 0.254
## lavadora 4 309.67 77.42 2.964 0.114
## Residuals 6 156.73 26.12
## 2 observations deleted due to missingness
# Modelo sin bloques (como DCA)
modelo_dca <- aov(blancura ~ detergente, data = dbca, na.action = na.omit)
# Eficiencia relativa
CM_error_dca <- summary(modelo_dca)[[1]][["Mean Sq"]][2]
CM_error_dbca <- summary(modelo_completo)[[1]][["Mean Sq"]][3]
eficiencia_relativa <- CM_error_dca / CM_error_dbca
eficiencia_relativa
## [1] 1.785453
# Residuales
res <- residuals(modelo_completo)
# Normalidad: prueba de Shapiro-Wilk
shapiro.test(res)
##
## Shapiro-Wilk normality test
##
## data: res
## W = 0.94647, p-value = 0.5459
# Homogeneidad: gráfico y prueba de Bartlett
plot(fitted(modelo_completo), res,
main = "Residuos vs Valores ajustados",
xlab = "Valores ajustados", ylab = "Residuos")
abline(h = 0, col = "red")
# También prueba de Bartlett
bartlett.test(blancura ~ detergente, data = dbca)
##
## Bartlett test of homogeneity of variances
##
## data: blancura by detergente
## Bartlett's K-squared = 3.5141, df = 2, p-value = 0.1726
# Calcular promedios
media_total <- mean(dbca$blancura, na.rm = TRUE)
prom_detergente <- tapply(dbca$blancura, dbca$detergente, mean, na.rm = TRUE)
prom_lavadora <- tapply(dbca$blancura, dbca$lavadora, mean, na.rm = TRUE)
# Estimación para detergente = Rindex, lavadora = LG
est <- prom_detergente["Rindex"] + prom_lavadora["LG"] - media_total
est
## Rindex
## 55.46154
# Datos de medición: 9 piezas × 2 operadores × 3 repeticiones
piezas <- factor(rep(1:9, each = 6))
operadores <- factor(rep(rep(1:2, each = 3), 9))
replicacion <- factor(rep(1:3, times = 18))
# Mediciones dadas
mediciones <- c(
50, 49, 50, 50, 48, 51,
52, 52, 51, 51, 51, 51,
53, 50, 50, 54, 52, 51,
49, 51, 50, 48, 50, 51,
48, 49, 48, 48, 49, 48,
52, 50, 50, 52, 50, 50,
51, 51, 51, 51, 50, 50,
52, 50, 49, 53, 48, 50,
50, 51, 50, 51, 48, 49
)
# Crear data frame
datos <- data.frame(pieza = piezas, operador = operadores, y = mediciones)
# Ajustar modelo cruzado con repeticiones
modelo <- aov(y ~ operador * pieza + Error(pieza:operador), data = datos)
## Warning in aov(y ~ operador * pieza + Error(pieza:operador), data = datos):
## Error() model is singular
# Ver tabla ANOVA
summary(modelo)
##
## Error: pieza:operador
## Df Sum Sq Mean Sq
## operador 1 0.30 0.296
## pieza 8 47.37 5.921
## operador:pieza 8 5.37 0.671
##
## Error: Within
## Df Sum Sq Mean Sq F value Pr(>F)
## Residuals 36 53.33 1.482
# Instalar y cargar paquete necesario
if (!require("nlme")) install.packages("nlme")
## Cargando paquete requerido: nlme
library(nlme)
# Preparar los factores
piezas <- factor(rep(1:9, each = 6))
operadores <- factor(rep(rep(1:2, each = 3), 9))
replicacion <- factor(rep(1:3, times = 18))
# Datos de medición
mediciones <- c(
50, 49, 50, 50, 48, 51,
52, 52, 51, 51, 51, 51,
53, 50, 50, 54, 52, 51,
49, 51, 50, 48, 50, 51,
48, 49, 48, 48, 49, 48,
52, 50, 50, 52, 50, 50,
51, 51, 51, 51, 50, 50,
52, 50, 49, 53, 48, 50,
50, 51, 50, 51, 48, 49
)