En un experimento consideran 3 especies de plantas y dos tipos de reactivos para activar el ciclo de florescencia de las plantas. Se mide el tiempo en dias en que aparece la flor hasta cuando presenta signos de marchitamiento. Los Resultados se indican en la siguiente tabla:
options(repos = c(CRAN = "https://cran.rstudio.com/"))
install.packages("readxl")
## Installing package into 'C:/Users/Claud/AppData/Local/R/win-library/4.3'
## (as 'lib' is unspecified)
## package 'readxl' successfully unpacked and MD5 sums checked
##
## The downloaded binary packages are in
## C:\Users\Claud\AppData\Local\Temp\Rtmp23Z98D\downloaded_packages
library(readxl)
Datosejercicio1<-read_excel("C:/Users/Claud/OneDrive/Escritorio/Séptimo/Diseño Experimental/Trabajo 3 ejercicios/Datos ejercicio 1.xlsx")
print(Datosejercicio1)
## # A tibble: 18 × 3
## Sobrevivencia Reactivo Especie
## <dbl> <chr> <chr>
## 1 12 R1 A
## 2 13 R1 A
## 3 15 R1 A
## 4 13 R1 B
## 5 15 R1 B
## 6 15 R1 B
## 7 16 R1 C
## 8 18 R1 C
## 9 20 R1 C
## 10 9 R2 A
## 11 8 R2 A
## 12 9 R2 A
## 13 10 R2 B
## 14 8 R2 B
## 15 9 R2 B
## 16 12 R2 C
## 17 10 R2 C
## 18 13 R2 C
Número de observaciones(replicas por tratamiento)
conteo_valores_tratamiento <- table(Datosejercicio1$Reactivo, Datosejercicio1$Especie)
print("Número de observaciones (réplicas) por tratamiento:")
## [1] "Número de observaciones (réplicas) por tratamiento:"
print(conteo_valores_tratamiento)
##
## A B C
## R1 3 3 3
## R2 3 3 3
Dado que el número de observaciones por tratamiento es el mismo, se puede concluir que es un diseño balanceado.
Medidas descriptivas de la variable dependiente(Sobrevivencia)
summarytools::descr(Datosejercicio1[,1])
## Descriptive Statistics
## Datosejercicio1$Sobrevivencia
## N: 18
##
## Sobrevivencia
## ----------------- ---------------
## Mean 12.50
## Std.Dev 3.50
## Min 8.00
## Q1 9.00
## Median 12.50
## Q3 15.00
## Max 20.00
## MAD 3.71
## IQR 5.75
## CV 0.28
## Skewness 0.43
## SE.Skewness 0.54
## Kurtosis -0.90
## N.Valid 18.00
## Pct.Valid 100.00
A partir de los resultados proporcionados, se puede concluir que el promedio de la variable sobrevivencia de la flor es de 12.50, con una desviación estándar de 3.50. El valor mínimo observado en esta variable es de 8.00, mientras que el valor máximo alcanza los 20.00. El 50% de las observaciones se sitúan en un rango que va desde 9.00 hasta 15.00, lo que refleja la mediana de 12.50 como medida central. De la misma manera, se observa una asimetría positiva leve, con un coeficiente de asimetría de 0.43. Además, el coeficiente de curtosis es de -0.90, lo que sugiere que la distribución de los datos es platicúrtica.
A continuación se llevará a cabo el ANOVA de un diseño factorial de un dos factores con interacción, el cual nos permite estudiar si existen diferencias significativas entre la aplicacion de dos factores y la interacción para entender las variaciones observadas en la variable respuesta.
Para el factor α, es decir, el Reactivo, la descripción de la hipotesis nula es que el promedio del tiempo de florecimiento de las plantas es igual tanto para el reactivo 1 como para el reactivo 2. Mientras que para la hipotesis alternativa es que el promedio del tiempo de florecimiento es diferente para algún reactivo.
Se plantearian de la siguiente forma:
\(H_0:α_1=α_2=0\)
\(H_a:Algún\) \(α_i ≠0\)
Para el factor β, es decir, la especie, la descripción de la hipotesis nula es que el promedio del tiempo de florecimiento de las plantas es igual tanto para la especie A como para la B,C y D. Mientras que para la hipotesis alternativa es que el promedio del tiempo de florecimiento es diferente para alguna especie.
Se plantearian de la siguiente forma:
\(H_0: β_A=β_B=β_C=β_D=0\)
\(H_a:Algún\) \(β_i ≠0\)
Para la interacción (αβ), es decir, reactivo y especie,la descripción de la hipotesis nula es que el uso de los reactivos y los diferentes tipos de especie no influye en el tiempo de florecimiento de las plantas. Mientras que para la hipotesis alternativa es que el promedio del tiempo de florecimiento se ve influenciado por el uso de algun reactivo y alguna especie.
Se plantearian de la siguiente forma:
\(H_0: (αβ)_ij= 0 Ɐ j\)
\(H_a:Algún (αβ)_ij ≠0\)
# Realizar el ANOVA
modelo_anova <- aov(Sobrevivencia ~ Reactivo * Especie, data = Datosejercicio1)
# Mostrar resumen del ANOVA
summary(modelo_anova)
## Df Sum Sq Mean Sq F value Pr(>F)
## Reactivo 1 133.39 133.39 70.618 2.26e-06 ***
## Especie 2 50.33 25.17 13.324 0.000896 ***
## Reactivo:Especie 2 2.11 1.06 0.559 0.586073
## Residuals 12 22.67 1.89
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
De acuerdo a lo obtenido en el ANOVA, se concluye que hay evidencia estadistica significativa para rechazar la hipotesis nula para el factor α, es decir, el promedio de tiempo de florecencia para el reactivo 1 es diferente del tiempo promedio para el reactivo 2 (p-valor<0.05).
En cuanto al factor β, hay evidencia significativa para rechazar la hipotesis nula, es decir, el promedio del tiempo de florecimiento es diferente para alguna especie (p-valor<0.05).
Finalmente para la interacción de factores, no hay evidencia significativa para rechazar la hipotesis nula, por tanto se acepta, es decir, el uso de los reactivos y los diferentes tipos de especie no influye en el tiempo de florecimiento de las plantas (p-valor>0.05).
# Crear un diagrama de cajas con interacción
boxplot(Datosejercicio1$Sobrevivencia ~ Datosejercicio1$Reactivo * Datosejercicio1$Especie,
main = "Diagrama de Cajas de Sobrevivencia",
xlab = "Combinacion de Reactivo y Especie",
ylab = "Sobrevivencia",
col = c("red", "yellow", "gray","green","pink","purple"))
En el diagrama de cajas se puede observar algunas diferencias significativas en la sobrevivencia de las flores de acuerdo al tipo de reactivo principalmente, evidenciando una mayor sobrevivencia de la flor para el reactivo 1 respecto al 2 que se encuentra en la mayoria de especies con valores promedio muy bajos, esto se observa por ejemplo viendo las graficas de R1:B y R1:A, R2:B y R2:A las cuales se translapan. Respecto a la especie, aquella que presenta una mayor sobrevivencia de la flor es la C junto con el reactivo 1, se podria decir que es en la que ha presentado un mejor resultado de acuerdo al diagrama de cajas.
modelo_anova <- aov(Sobrevivencia ~ Reactivo + Especie + Reactivo:Especie, data = Datosejercicio1)
LSD_result1 <- TukeyHSD(modelo_anova)
print(LSD_result1)
## Tukey multiple comparisons of means
## 95% family-wise confidence level
##
## Fit: aov(formula = Sobrevivencia ~ Reactivo + Especie + Reactivo:Especie, data = Datosejercicio1)
##
## $Reactivo
## diff lwr upr p adj
## R2-R1 -5.444444 -6.856061 -4.032827 2.3e-06
##
## $Especie
## diff lwr upr p adj
## B-A 0.6666667 -1.450262 2.783595 0.6862717
## C-A 3.8333333 1.716405 5.950262 0.0011057
## C-B 3.1666667 1.049738 5.283595 0.0047100
##
## $`Reactivo:Especie`
## diff lwr upr p adj
## R2:A-R1:A -4.6666667 -8.4359375 -0.8973958 0.0129801
## R1:B-R1:A 1.0000000 -2.7692709 4.7692709 0.9415283
## R2:B-R1:A -4.3333333 -8.1026042 -0.5640625 0.0214217
## R1:C-R1:A 4.6666667 0.8973958 8.4359375 0.0129801
## R2:C-R1:A -1.6666667 -5.4359375 2.1026042 0.6791464
## R1:B-R2:A 5.6666667 1.8973958 9.4359375 0.0029859
## R2:B-R2:A 0.3333333 -3.4359375 4.1026042 0.9995991
## R1:C-R2:A 9.3333333 5.5640625 13.1026042 0.0000291
## R2:C-R2:A 3.0000000 -0.7692709 6.7692709 0.1523873
## R2:B-R1:B -5.3333333 -9.1026042 -1.5640625 0.0048364
## R1:C-R1:B 3.6666667 -0.1026042 7.4359375 0.0582517
## R2:C-R1:B -2.6666667 -6.4359375 1.1026042 0.2380136
## R1:C-R2:B 9.0000000 5.2307291 12.7692709 0.0000421
## R2:C-R2:B 2.6666667 -1.1026042 6.4359375 0.2380136
## R2:C-R1:C -6.3333333 -10.1026042 -2.5640625 0.0011711
Gracias a este método es posible inferir que existe una diferencia significativa en la sobrevivencia de las flores entre los reactivos R1 y R2. Dado que el valor p es muy bajo siendo de 2.3e-06.
Por otro lado, entre las especies B y A no se encontro diferencia significativa dado que el p-valor dió como resultado 0.6862717 y este valor es mayor que el valor de significancia 0.05. Sin embargo, si se encontro una diferencia significativa entre las especies C y A asi como para C y B dado que los resultados del p-valor son mucho menores al valor de significancia, con esto se puede concluir que las especies A y B presentan resultados significativamente diferentes de la especie C en cuanto a la sobrevivencia de las flores.
En cuanto a la interacción de las combinaciones se encontraron diferencias significativas en la sobrevivencia de las flores en varias de estas.Las combinaciones significativamente diferentes de acuerdo a la sobrevivencia de las flores son R2:A y R1:A, R2:B y R1:A, R1:C y R1:A, R1:B y R2:A, R1:C y R2:A, R2:B y R1:B, R1:C y R2:B, R2:C y R1:C, con un p-valor < 0.05).
resultado_tukey1 <- TukeyHSD(modelo_anova)
print(resultado_tukey1)
## Tukey multiple comparisons of means
## 95% family-wise confidence level
##
## Fit: aov(formula = Sobrevivencia ~ Reactivo + Especie + Reactivo:Especie, data = Datosejercicio1)
##
## $Reactivo
## diff lwr upr p adj
## R2-R1 -5.444444 -6.856061 -4.032827 2.3e-06
##
## $Especie
## diff lwr upr p adj
## B-A 0.6666667 -1.450262 2.783595 0.6862717
## C-A 3.8333333 1.716405 5.950262 0.0011057
## C-B 3.1666667 1.049738 5.283595 0.0047100
##
## $`Reactivo:Especie`
## diff lwr upr p adj
## R2:A-R1:A -4.6666667 -8.4359375 -0.8973958 0.0129801
## R1:B-R1:A 1.0000000 -2.7692709 4.7692709 0.9415283
## R2:B-R1:A -4.3333333 -8.1026042 -0.5640625 0.0214217
## R1:C-R1:A 4.6666667 0.8973958 8.4359375 0.0129801
## R2:C-R1:A -1.6666667 -5.4359375 2.1026042 0.6791464
## R1:B-R2:A 5.6666667 1.8973958 9.4359375 0.0029859
## R2:B-R2:A 0.3333333 -3.4359375 4.1026042 0.9995991
## R1:C-R2:A 9.3333333 5.5640625 13.1026042 0.0000291
## R2:C-R2:A 3.0000000 -0.7692709 6.7692709 0.1523873
## R2:B-R1:B -5.3333333 -9.1026042 -1.5640625 0.0048364
## R1:C-R1:B 3.6666667 -0.1026042 7.4359375 0.0582517
## R2:C-R1:B -2.6666667 -6.4359375 1.1026042 0.2380136
## R1:C-R2:B 9.0000000 5.2307291 12.7692709 0.0000421
## R2:C-R2:B 2.6666667 -1.1026042 6.4359375 0.2380136
## R2:C-R1:C -6.3333333 -10.1026042 -2.5640625 0.0011711
Se evidencian resultados similares a los de la prueba LSD.
plot(resultado_tukey1)
Lo que se ha concluido en el apartado anterior, se confirma con la gráfica de la diferencia de medias(intervalos de confianza) en la interacción del tipo de reactivo con el tipo de especie especie.
La validez de los resultados obtenidos en cualquier análisis de varianza queda condicionado a que los supuestos del modelo se cumplan. Estos supuestos son: normalidad, varianza constante (igual varianza de los tratamientos) e independencia.
#P1 - normalidad
plot(modelo_anova)
Para confirmar de manera más sólida que los residuos siguen una distribución normal, se realiza la prueba de Shapiro-Wilk. Para la prueba Shapiro-Wilk para ratificar el cumplimiento del supuesto de normalidad de los residuos, evaluando las hipótesis:
H_0: Los residuos de la variable sobrevivencia de la flor se distribuyen normalmente con media cero y varianza constante.
H_a: Los residuos de la variable sobrevivencia de la flor no siguen una distribución normal.
shapiro.test(modelo_anova$residuals)
##
## Shapiro-Wilk normality test
##
## data: modelo_anova$residuals
## W = 0.9721, p-value = 0.8361
Dado que el p-valor(0.8361) > 0.05, se concluye que no hay evidencia estadística suficiente para rechazar la hipótesis nula (H_0). Es decir, que se acepta la hipótesis nula. Por lo tanto, se concluye que los residuos de la variable sobrevivencia de la flor están normalmente distribuidos con media cero y varianza constante, lo que se evidencia en algunas de las graficas anteriores.
# Boxplot de residuos por combinación de factores
boxplot(residuals(modelo_anova) ~ interaction(Datosejercicio1$Reactivo, Datosejercicio1$Especie),
xlab = "Combinación de Factores",
ylab = "Residuos",
main = "Boxplot de Residuos por Combinación de Factores")
En el diagrama de cajas se representan los valores predichos por el modelo para la variable sobrevivencia de la flor en función de la raíz cuadrada de los residuos estandarizados. En esta gráfica, no se observa ninguna tendencia aparente en la distribución de los valores, lo que sugiere que no hay evidencia de incumplimiento del supuesto de homogeneidad de varianzas.
modelo_anova <- lm(Sobrevivencia ~ Reactivo * Especie, data = Datosejercicio1)
residuos <- residuals(modelo_anova)
color_palette <- colorRampPalette(c("blue", "black", "blue"))
plot(residuos, main = "Prueba de independencia", pch = 20, cex = 2, col = color_palette(120), ylab = "Residuos", xlab = " ")
En la grafica anterior se observan dispersos los puntos sin seguir un patron, esto es un indicio de homogeneidad de varianzas (entre más dispersos menos correlacionados)
Sin embargo, para validar de manera más sólida la homogeneidad de varianzas, se llevó a cabo la prueba de bartlett.
Donde las hipotesis correspondientes son:
H_0: La varianza es constante en todos los grupos.
H_a: La varianza no es constante en al menos en un grupo.
# Prueba de homogeneidad de varianzas
residuos <- residuals(modelo_anova)
grupos <- with(Datosejercicio1, interaction(Reactivo, Especie))
# Prueba de Bartlett
resultado_bartlett <- bartlett.test(residuals(modelo_anova), grupos)
print(resultado_bartlett)
##
## Bartlett test of homogeneity of variances
##
## data: residuals(modelo_anova) and grupos
## Bartlett's K-squared = 2.5886, df = 5, p-value = 0.7631
De acuerdo al valor obtenido gracias a la prueba de bartlett, el p-valor (0.7631) es mayor a 0.05, por lo tanto, se acepta la hipótesis nula, por lo que existe homogeneidad de varianzas, llegando a la misma conclusión del gráfico de residuos.
H_0: Los residuos entre los tratamientos son independientes.
H_a:Los residuos entre los tratamientos no son independientes.
install.packages("lmtest")
## Installing package into 'C:/Users/Claud/AppData/Local/R/win-library/4.3'
## (as 'lib' is unspecified)
## package 'lmtest' successfully unpacked and MD5 sums checked
## Warning: cannot remove prior installation of package 'lmtest'
## Warning in file.copy(savedcopy, lib, recursive = TRUE): problema al copiar
## C:\Users\Claud\AppData\Local\R\win-library\4.3\00LOCK\lmtest\libs\x64\lmtest.dll
## a C:\Users\Claud\AppData\Local\R\win-library\4.3\lmtest\libs\x64\lmtest.dll:
## Permission denied
## Warning: restored 'lmtest'
##
## The downloaded binary packages are in
## C:\Users\Claud\AppData\Local\Temp\Rtmp23Z98D\downloaded_packages
library(lmtest)
## Loading required package: zoo
##
## Attaching package: 'zoo'
## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric
modelo_anova <- aov(Sobrevivencia ~ Reactivo * Especie, data = Datosejercicio1)
residuos <- residuals(modelo_anova)
resultado_durbin_watson <- dwtest(modelo_anova)
print(resultado_durbin_watson)
##
## Durbin-Watson test
##
## data: modelo_anova
## DW = 2.4902, p-value = 0.4146
## alternative hypothesis: true autocorrelation is greater than 0
En este caso para la prueba de Durbin-Watson se debe tener en cuenta que si el valor del estadístico Durbin Watson (DW) está próximo a 2 entonces los residuos no están autocorrelacionados. Teniendo en cuenta lo mencionado anteriormente y que el p-valor mucho mayor al valor de significancia (0.05), es de concluir que los residuos entre los tratamientos son independientes, es decir, que se acepta la hipotesis nula, ya que los residuos no están correlacionados.
modelo_anova=lm(Sobrevivencia~Reactivo+Especie,data=Datosejercicio1)
anova(modelo_anova)
## Analysis of Variance Table
##
## Response: Sobrevivencia
## Df Sum Sq Mean Sq F value Pr(>F)
## Reactivo 1 133.389 133.389 75.368 5.222e-07 ***
## Especie 2 50.333 25.167 14.220 0.0004251 ***
## Residuals 14 24.778 1.770
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
install.packages("agricolae")
## Installing package into 'C:/Users/Claud/AppData/Local/R/win-library/4.3'
## (as 'lib' is unspecified)
## package 'agricolae' successfully unpacked and MD5 sums checked
##
## The downloaded binary packages are in
## C:\Users\Claud\AppData\Local\Temp\Rtmp23Z98D\downloaded_packages
library(agricolae)
compara1=LSD.test(modelo_anova,"Especie")
compara1
## $statistics
## MSerror Df Mean CV t.value LSD
## 1.769841 14 12.5 10.64283 2.144787 1.647368
##
## $parameters
## test p.ajusted name.t ntr alpha
## Fisher-LSD none Especie 3 0.05
##
## $means
## Sobrevivencia std r se LCL UCL Min Max Q25 Q50
## A 11.00000 2.756810 6 0.5431147 9.835135 12.16487 8 15 9.00 10.5
## B 11.66667 3.076795 6 0.5431147 10.501802 12.83153 8 15 9.25 11.5
## C 14.83333 3.816630 6 0.5431147 13.668468 15.99820 10 20 12.25 14.5
## Q75
## A 12.75
## B 14.50
## C 17.50
##
## $comparison
## NULL
##
## $groups
## Sobrevivencia groups
## C 14.83333 a
## B 11.66667 b
## A 11.00000 b
##
## attr(,"class")
## [1] "group"
Lo anterior comprueba lo mencionado anteriormente y es que para la especie C se evidencia un mejor resultado respecto a la sobrevivencia.
compara2=LSD.test(modelo_anova,"Reactivo")
compara2
## $statistics
## MSerror Df Mean CV t.value LSD
## 1.769841 14 12.5 10.64283 2.144787 1.34507
##
## $parameters
## test p.ajusted name.t ntr alpha
## Fisher-LSD none Reactivo 2 0.05
##
## $means
## Sobrevivencia std r se LCL UCL Min Max Q25 Q50 Q75
## R1 15.222222 2.538591 9 0.4434513 14.271114 16.17333 12 20 13 15 16
## R2 9.777778 1.715938 9 0.4434513 8.826669 10.72889 8 13 9 9 10
##
## $comparison
## NULL
##
## $groups
## Sobrevivencia groups
## R1 15.222222 a
## R2 9.777778 b
##
## attr(,"class")
## [1] "group"
En cuanto a los reactivos es notable que el que presenta un mejor resultado es el 1 dado que las flores que fueron influenciadas por este factor presentaron mejores niveles de sobrevivencia.
En unos laboratorios se estan estudiando los factores que influyen en la resistencia de un tipo particular de fibra. Si se eligen al azar 4 máquinas 3 operarios y se realiza un experimento factorial usando fibras de un mismo lote de producción. Los resultados obtenidos se muestran en la siguiente tabla. Analizar los resultados y obtener las conclusiones apropiadas.
install.packages("readxl")
## Warning: package 'readxl' is in use and will not be installed
library(readxl)
Datosejercicio2 <-read_excel("C:/Users/Claud/OneDrive/Escritorio/Séptimo/Diseño Experimental/Trabajo 3 ejercicios/Datos ejercicio 2.xlsx")
print(Datosejercicio2)
## # A tibble: 24 × 3
## Resistencia Operario Maquina
## <dbl> <chr> <chr>
## 1 109 OP1 A
## 2 110 OP1 A
## 3 110 OP1 B
## 4 115 OP1 B
## 5 108 OP1 C
## 6 109 OP1 C
## 7 110 OP1 D
## 8 108 OP1 D
## 9 110 OP2 A
## 10 112 OP2 A
## # ℹ 14 more rows
Número de observaciones(replicas por tratamiento)
conteo_valores_tratamiento <- table(Datosejercicio2$Operario, Datosejercicio2$Maquina)
print("Número de observaciones (réplicas) por tratamiento:")
## [1] "Número de observaciones (réplicas) por tratamiento:"
print(conteo_valores_tratamiento)
##
## A B C D
## OP1 2 2 2 2
## OP2 2 2 2 2
## OP3 2 2 2 2
Dado que el número de observaciones por tratamiento es el mismo, se puede concluir que es un diseño balanceado.
summarytools::descr(Datosejercicio2 [,1])
## Descriptive Statistics
## Datosejercicio2$Resistencia
## N: 24
##
## Resistencia
## ----------------- -------------
## Mean 112.29
## Std.Dev 3.38
## Min 108.00
## Q1 110.00
## Median 111.50
## Q3 114.50
## Max 120.00
## MAD 3.71
## IQR 4.25
## CV 0.03
## Skewness 0.69
## SE.Skewness 0.47
## Kurtosis -0.60
## N.Valid 24.00
## Pct.Valid 100.00
Gracias a los resultados obtenidos, se determina que el promedio de la variable respuesta que es la resistencia es de 112.29, con una desviación estándar de 3.38. El valor mínimo observado en esta variable es de 108.00, mientras que el valor máximo alcanza los 120.00. El 50% de las observaciones se sitúan en un rango que va desde 110.00 hasta 114.50, lo que refleja la mediana de 111.50 como medida central. De la misma manera, se observa una asimetría positiva leve, con un coeficiente de asimetría de 0.69. Además, el coeficiente de curtosis es de -0.60, lo que sugiere que la distribución de los datos es platicúrtica.
Medidas descriptivas por Tratamientos
resultados_descriptivos <- aggregate(Resistencia ~ Operario + Maquina + Operario:Maquina, data = Datosejercicio2, summary)
print(resultados_descriptivos)
## Operario Maquina Resistencia.Min. Resistencia.1st Qu. Resistencia.Median
## 1 OP1 A 109.00 109.25 109.50
## 2 OP2 A 110.00 110.50 111.00
## 3 OP3 A 114.00 114.50 115.00
## 4 OP1 B 110.00 111.25 112.50
## 5 OP2 B 110.00 110.25 110.50
## 6 OP3 B 112.00 112.75 113.50
## 7 OP1 C 108.00 108.25 108.50
## 8 OP2 C 109.00 109.50 110.00
## 9 OP3 C 114.00 115.25 116.50
## 10 OP1 D 108.00 108.50 109.00
## 11 OP2 D 112.00 112.50 113.00
## 12 OP3 D 117.00 117.75 118.50
## Resistencia.Mean Resistencia.3rd Qu. Resistencia.Max.
## 1 109.50 109.75 110.00
## 2 111.00 111.50 112.00
## 3 115.00 115.50 116.00
## 4 112.50 113.75 115.00
## 5 110.50 110.75 111.00
## 6 113.50 114.25 115.00
## 7 108.50 108.75 109.00
## 8 110.00 110.50 111.00
## 9 116.50 117.75 119.00
## 10 109.00 109.50 110.00
## 11 113.00 113.50 114.00
## 12 118.50 119.25 120.00
A continuación se llevará a cabo el ANOVA de un diseño factorial de un dos factores con interacción, el cual nos permite estudiar si existen diferencias significativas entre la aplicacion de dos factores y la interacción para entender las variaciones observadas en la variable respuesta.
Para el factor α, es decir, el Operario, la descripción de la hipotesis nula es que el promedio de resistencia de la fibra es igual tanto para el caso del operario 1 como operario 2 y 3. Mientras que para la hipotesis alternativa es que el promedio de la resistencia de la fibra es diferente de acuerdo al operario.
Se plantearían de la siguiente forma:
\(H_0:α_1=α_2=α_3=0\)
\(H_a:Algún\) \(α_i ≠0\)
Para el factor β, es decir, la maquina, la descripción de la hipotesis nula es que el promedio de la resistencia de la fibra es igual tanto para cuando se usa la maquina A como para la B,C y D. Mientras que para la hipotesis alternativa es que el promedio de la resistencia de la fibra es diferente en el uso de algun tipo de maquina.
Se plantearían de la siguiente forma:
\(H_0: β_A=β_B=β_C=β_D=0\)
\(H_a:Algún\) \(β_i ≠0\)
Para la interacción (αβ), es decir, Operario y Maquina,la descripción de la hipotesis nula es que el uso de los distintos operarios y los tipos de maquina no influye en la resistencia de la fibra. Mientras que para la hipotesis alternativa el promedio de la resistecia de la fibra se ve influenciado por el uso de algun Operario y alguna maquina.
Se plantearían de la siguiente forma:
\(H_0: (αβ)_ij= 0 Ɐ j\)
\(H_a:Algún (αβ)_ij ≠0\)
# Realizar el ANOVA
modelo_anova2 <- aov(Resistencia ~ Operario * Maquina, data = Datosejercicio2)
# Mostrar resumen del ANOVA
summary(modelo_anova2)
## Df Sum Sq Mean Sq F value Pr(>F)
## Operario 2 160.33 80.17 21.143 0.000117 ***
## Maquina 3 12.46 4.15 1.095 0.388753
## Operario:Maquina 6 44.67 7.44 1.963 0.150681
## Residuals 12 45.50 3.79
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
De acuerdo a los resultados obtenidos, para el factor α es decir, para el operario, se concluye que hay evidencia significativa para rechazar la hipotesis nula, dado que como se indica el p-valor es menor a 0.05, por lo cual se acepta la hipotesis alternativa que indica que el promedio de la resistencia de la fibra es diferente de acuerdo al operario.
Para el factor β, es decir, la maquina, se concluye que no hay evidencia significativa para rechazar la hipotesis nula puesto que el p-valor es mayor al valor de significancia, con lo cual se dice que el promedio de la resistencia de la fibra es igual tanto para cuando se usa la maquina A como para la B,C y D.
En cuanto a la interaccion de factores (αβ), se concluye que No hay evidencia estadistica significativa que indique la decision de rechazar la hipotesis nula, por tanto se acepta y esto significa que no existe una interaccion entre los factores que afecte directamente a la resistencia de la fibra.
# Crear un diagrama de cajas con interacción
boxplot(Datosejercicio2$Resistencia ~ Datosejercicio2$Operario * Datosejercicio2$Maquina,
main = "Diagrama de Cajas de Resistencia",
xlab = "Combinacion de Operario y Maquina",
ylab = "Resistencia",
col = c("red", "yellow", "gray","green","pink","purple"))
En el grafico de cajas es posible evidenciar que el operario 1 presenta
una influencia negativa en la mayoria de los casos sobre la resistencia
de la fibra, mientras que el operario 3 es aquel que llega a producir un
efecto mas positivo sobre la resistencia dado que se presentan valores
mas elevados.
install.packages("agricolae")
## Warning: package 'agricolae' is in use and will not be installed
library(agricolae)
modelo_anova2 <- aov(Resistencia ~ Operario * Maquina, data = Datosejercicio2)
LSD_result1 <- TukeyHSD(modelo_anova2)
print(LSD_result1)
## Tukey multiple comparisons of means
## 95% family-wise confidence level
##
## Fit: aov(formula = Resistencia ~ Operario * Maquina, data = Datosejercicio2)
##
## $Operario
## diff lwr upr p adj
## OP2-OP1 1.25 -1.347459 3.847459 0.4302092
## OP3-OP1 6.00 3.402541 8.597459 0.0001330
## OP3-OP2 4.75 2.152541 7.347459 0.0010207
##
## $Maquina
## diff lwr upr p adj
## B-A 0.3333333 -3.004389 3.671055 0.9904645
## C-A -0.1666667 -3.504389 3.171055 0.9987710
## D-A 1.6666667 -1.671055 5.004389 0.4766928
## C-B -0.5000000 -3.837722 2.837722 0.9693945
## D-B 1.3333333 -2.004389 4.671055 0.6465008
## D-C 1.8333333 -1.504389 5.171055 0.3989736
##
## $`Operario:Maquina`
## diff lwr upr p adj
## OP2:A-OP1:A 1.5 -6.230766 9.230766 0.9993833
## OP3:A-OP1:A 5.5 -2.230766 13.230766 0.2769269
## OP1:B-OP1:A 3.0 -4.730766 10.730766 0.9013973
## OP2:B-OP1:A 1.0 -6.730766 8.730766 0.9999870
## OP3:B-OP1:A 4.0 -3.730766 11.730766 0.6575431
## OP1:C-OP1:A -1.0 -8.730766 6.730766 0.9999870
## OP2:C-OP1:A 0.5 -7.230766 8.230766 1.0000000
## OP3:C-OP1:A 7.0 -0.730766 14.730766 0.0898750
## OP1:D-OP1:A -0.5 -8.230766 7.230766 1.0000000
## OP2:D-OP1:A 3.5 -4.230766 11.230766 0.7937754
## OP3:D-OP1:A 9.0 1.269234 16.730766 0.0178460
## OP3:A-OP2:A 4.0 -3.730766 11.730766 0.6575431
## OP1:B-OP2:A 1.5 -6.230766 9.230766 0.9993833
## OP2:B-OP2:A -0.5 -8.230766 7.230766 1.0000000
## OP3:B-OP2:A 2.5 -5.230766 10.230766 0.9664165
## OP1:C-OP2:A -2.5 -10.230766 5.230766 0.9664165
## OP2:C-OP2:A -1.0 -8.730766 6.730766 0.9999870
## OP3:C-OP2:A 5.5 -2.230766 13.230766 0.2769269
## OP1:D-OP2:A -2.0 -9.730766 5.730766 0.9931505
## OP2:D-OP2:A 2.0 -5.730766 9.730766 0.9931505
## OP3:D-OP2:A 7.5 -0.230766 15.230766 0.0602463
## OP1:B-OP3:A -2.5 -10.230766 5.230766 0.9664165
## OP2:B-OP3:A -4.5 -12.230766 3.230766 0.5149555
## OP3:B-OP3:A -1.5 -9.230766 6.230766 0.9993833
## OP1:C-OP3:A -6.5 -14.230766 1.230766 0.1328994
## OP2:C-OP3:A -5.0 -12.730766 2.730766 0.3847296
## OP3:C-OP3:A 1.5 -6.230766 9.230766 0.9993833
## OP1:D-OP3:A -6.0 -13.730766 1.730766 0.1938021
## OP2:D-OP3:A -2.0 -9.730766 5.730766 0.9931505
## OP3:D-OP3:A 3.5 -4.230766 11.230766 0.7937754
## OP2:B-OP1:B -2.0 -9.730766 5.730766 0.9931505
## OP3:B-OP1:B 1.0 -6.730766 8.730766 0.9999870
## OP1:C-OP1:B -4.0 -11.730766 3.730766 0.6575431
## OP2:C-OP1:B -2.5 -10.230766 5.230766 0.9664165
## OP3:C-OP1:B 4.0 -3.730766 11.730766 0.6575431
## OP1:D-OP1:B -3.5 -11.230766 4.230766 0.7937754
## OP2:D-OP1:B 0.5 -7.230766 8.230766 1.0000000
## OP3:D-OP1:B 6.0 -1.730766 13.730766 0.1938021
## OP3:B-OP2:B 3.0 -4.730766 10.730766 0.9013973
## OP1:C-OP2:B -2.0 -9.730766 5.730766 0.9931505
## OP2:C-OP2:B -0.5 -8.230766 7.230766 1.0000000
## OP3:C-OP2:B 6.0 -1.730766 13.730766 0.1938021
## OP1:D-OP2:B -1.5 -9.230766 6.230766 0.9993833
## OP2:D-OP2:B 2.5 -5.230766 10.230766 0.9664165
## OP3:D-OP2:B 8.0 0.269234 15.730766 0.0401932
## OP1:C-OP3:B -5.0 -12.730766 2.730766 0.3847296
## OP2:C-OP3:B -3.5 -11.230766 4.230766 0.7937754
## OP3:C-OP3:B 3.0 -4.730766 10.730766 0.9013973
## OP1:D-OP3:B -4.5 -12.230766 3.230766 0.5149555
## OP2:D-OP3:B -0.5 -8.230766 7.230766 1.0000000
## OP3:D-OP3:B 5.0 -2.730766 12.730766 0.3847296
## OP2:C-OP1:C 1.5 -6.230766 9.230766 0.9993833
## OP3:C-OP1:C 8.0 0.269234 15.730766 0.0401932
## OP1:D-OP1:C 0.5 -7.230766 8.230766 1.0000000
## OP2:D-OP1:C 4.5 -3.230766 12.230766 0.5149555
## OP3:D-OP1:C 10.0 2.269234 17.730766 0.0080049
## OP3:C-OP2:C 6.5 -1.230766 14.230766 0.1328994
## OP1:D-OP2:C -1.0 -8.730766 6.730766 0.9999870
## OP2:D-OP2:C 3.0 -4.730766 10.730766 0.9013973
## OP3:D-OP2:C 8.5 0.769234 16.230766 0.0267714
## OP1:D-OP3:C -7.5 -15.230766 0.230766 0.0602463
## OP2:D-OP3:C -3.5 -11.230766 4.230766 0.7937754
## OP3:D-OP3:C 2.0 -5.730766 9.730766 0.9931505
## OP2:D-OP1:D 4.0 -3.730766 11.730766 0.6575431
## OP3:D-OP1:D 9.5 1.769234 17.230766 0.0119280
## OP3:D-OP2:D 5.5 -2.230766 13.230766 0.2769269
El previo análisis reveló varias diferencias significativas. Entre los operarios OP1 y OP3;entre OP2 Y OP3, hubo una diferencia significativa en la resistencia, con un valor de p de 0.0001330 y 0.0010207 respectivamente. En cuanto a la máquina, no se encontraron diferencias significativas entre las máquinas A, B, C y D, ya que los valores p ajustados para todas las comparaciones son elevados, combrobando lo obtenido en el ANOVA.
resultado_tukey1 <- TukeyHSD(modelo_anova2)
print(resultado_tukey1)
## Tukey multiple comparisons of means
## 95% family-wise confidence level
##
## Fit: aov(formula = Resistencia ~ Operario * Maquina, data = Datosejercicio2)
##
## $Operario
## diff lwr upr p adj
## OP2-OP1 1.25 -1.347459 3.847459 0.4302092
## OP3-OP1 6.00 3.402541 8.597459 0.0001330
## OP3-OP2 4.75 2.152541 7.347459 0.0010207
##
## $Maquina
## diff lwr upr p adj
## B-A 0.3333333 -3.004389 3.671055 0.9904645
## C-A -0.1666667 -3.504389 3.171055 0.9987710
## D-A 1.6666667 -1.671055 5.004389 0.4766928
## C-B -0.5000000 -3.837722 2.837722 0.9693945
## D-B 1.3333333 -2.004389 4.671055 0.6465008
## D-C 1.8333333 -1.504389 5.171055 0.3989736
##
## $`Operario:Maquina`
## diff lwr upr p adj
## OP2:A-OP1:A 1.5 -6.230766 9.230766 0.9993833
## OP3:A-OP1:A 5.5 -2.230766 13.230766 0.2769269
## OP1:B-OP1:A 3.0 -4.730766 10.730766 0.9013973
## OP2:B-OP1:A 1.0 -6.730766 8.730766 0.9999870
## OP3:B-OP1:A 4.0 -3.730766 11.730766 0.6575431
## OP1:C-OP1:A -1.0 -8.730766 6.730766 0.9999870
## OP2:C-OP1:A 0.5 -7.230766 8.230766 1.0000000
## OP3:C-OP1:A 7.0 -0.730766 14.730766 0.0898750
## OP1:D-OP1:A -0.5 -8.230766 7.230766 1.0000000
## OP2:D-OP1:A 3.5 -4.230766 11.230766 0.7937754
## OP3:D-OP1:A 9.0 1.269234 16.730766 0.0178460
## OP3:A-OP2:A 4.0 -3.730766 11.730766 0.6575431
## OP1:B-OP2:A 1.5 -6.230766 9.230766 0.9993833
## OP2:B-OP2:A -0.5 -8.230766 7.230766 1.0000000
## OP3:B-OP2:A 2.5 -5.230766 10.230766 0.9664165
## OP1:C-OP2:A -2.5 -10.230766 5.230766 0.9664165
## OP2:C-OP2:A -1.0 -8.730766 6.730766 0.9999870
## OP3:C-OP2:A 5.5 -2.230766 13.230766 0.2769269
## OP1:D-OP2:A -2.0 -9.730766 5.730766 0.9931505
## OP2:D-OP2:A 2.0 -5.730766 9.730766 0.9931505
## OP3:D-OP2:A 7.5 -0.230766 15.230766 0.0602463
## OP1:B-OP3:A -2.5 -10.230766 5.230766 0.9664165
## OP2:B-OP3:A -4.5 -12.230766 3.230766 0.5149555
## OP3:B-OP3:A -1.5 -9.230766 6.230766 0.9993833
## OP1:C-OP3:A -6.5 -14.230766 1.230766 0.1328994
## OP2:C-OP3:A -5.0 -12.730766 2.730766 0.3847296
## OP3:C-OP3:A 1.5 -6.230766 9.230766 0.9993833
## OP1:D-OP3:A -6.0 -13.730766 1.730766 0.1938021
## OP2:D-OP3:A -2.0 -9.730766 5.730766 0.9931505
## OP3:D-OP3:A 3.5 -4.230766 11.230766 0.7937754
## OP2:B-OP1:B -2.0 -9.730766 5.730766 0.9931505
## OP3:B-OP1:B 1.0 -6.730766 8.730766 0.9999870
## OP1:C-OP1:B -4.0 -11.730766 3.730766 0.6575431
## OP2:C-OP1:B -2.5 -10.230766 5.230766 0.9664165
## OP3:C-OP1:B 4.0 -3.730766 11.730766 0.6575431
## OP1:D-OP1:B -3.5 -11.230766 4.230766 0.7937754
## OP2:D-OP1:B 0.5 -7.230766 8.230766 1.0000000
## OP3:D-OP1:B 6.0 -1.730766 13.730766 0.1938021
## OP3:B-OP2:B 3.0 -4.730766 10.730766 0.9013973
## OP1:C-OP2:B -2.0 -9.730766 5.730766 0.9931505
## OP2:C-OP2:B -0.5 -8.230766 7.230766 1.0000000
## OP3:C-OP2:B 6.0 -1.730766 13.730766 0.1938021
## OP1:D-OP2:B -1.5 -9.230766 6.230766 0.9993833
## OP2:D-OP2:B 2.5 -5.230766 10.230766 0.9664165
## OP3:D-OP2:B 8.0 0.269234 15.730766 0.0401932
## OP1:C-OP3:B -5.0 -12.730766 2.730766 0.3847296
## OP2:C-OP3:B -3.5 -11.230766 4.230766 0.7937754
## OP3:C-OP3:B 3.0 -4.730766 10.730766 0.9013973
## OP1:D-OP3:B -4.5 -12.230766 3.230766 0.5149555
## OP2:D-OP3:B -0.5 -8.230766 7.230766 1.0000000
## OP3:D-OP3:B 5.0 -2.730766 12.730766 0.3847296
## OP2:C-OP1:C 1.5 -6.230766 9.230766 0.9993833
## OP3:C-OP1:C 8.0 0.269234 15.730766 0.0401932
## OP1:D-OP1:C 0.5 -7.230766 8.230766 1.0000000
## OP2:D-OP1:C 4.5 -3.230766 12.230766 0.5149555
## OP3:D-OP1:C 10.0 2.269234 17.730766 0.0080049
## OP3:C-OP2:C 6.5 -1.230766 14.230766 0.1328994
## OP1:D-OP2:C -1.0 -8.730766 6.730766 0.9999870
## OP2:D-OP2:C 3.0 -4.730766 10.730766 0.9013973
## OP3:D-OP2:C 8.5 0.769234 16.230766 0.0267714
## OP1:D-OP3:C -7.5 -15.230766 0.230766 0.0602463
## OP2:D-OP3:C -3.5 -11.230766 4.230766 0.7937754
## OP3:D-OP3:C 2.0 -5.730766 9.730766 0.9931505
## OP2:D-OP1:D 4.0 -3.730766 11.730766 0.6575431
## OP3:D-OP1:D 9.5 1.769234 17.230766 0.0119280
## OP3:D-OP2:D 5.5 -2.230766 13.230766 0.2769269
plot(resultado_tukey1)
Lo que se ha mencionado anteriormente se confirma con la gráfica de la diferencia de medias(intervalos de confianza) en la interacción de el operador con el tipo de máquina.
La validez de los resultados obtenidos en cualquier análisis de varianza queda condicionado a que los supuestos del modelo se cumplan. Estos supuestos son: normalidad, varianza constante (igual varianza de los tratamientos) e independencia.
# Realizar ANOVA con interacción
modelo_anova2 <- aov(Resistencia ~ Operario * Maquina, data = Datosejercicio2)
# Obtener los residuos del modelo
residuos <- residuals(modelo_anova2)
# Boxplot de residuos
boxplot(residuos, col = "lightgreen",
main = "Boxplot de Residuos",
xlab = "Combinación de Operario y Maquina",
ylab = "Residuos")
Se procede a realizar el test de Shapiro-Wilk. Este análisis se lleva a
cabo con el fin de verificar si los residuos cumplen con la suposición
de una distribución normal, y para ello, se evalúan las hipótesis
correspondientes.
H_0: Los residuos de la variable resistencia de la fibra se distribuyen normalmente con media cero y varianza constante.
H_a: Los residuos de la variable resistencia de la fibra no siguen la distribución normal.
shapiro.test(residuals(modelo_anova2))
##
## Shapiro-Wilk normality test
##
## data: residuals(modelo_anova2)
## W = 0.94926, p-value = 0.2611
Se concluye que no hay evidencia estadística suficiente para rechazar la hipótesis nula. Es decir, que se acepta la hipótesis nula, ya que el valor de p (p-value = 0.2611) es mayor que el valor del nivel de significancia (α = 0.05). Por lo tanto, los residuos de la variable de resistencia de la fibra están normalmente distribuidos con media cero y varianza constante.
boxplot(residuos ~ Datosejercicio2$Operario:Datosejercicio2$Maquina,
col = "violet",
xlab = "Combinación de Operario y Maquina",
ylab = "Residuos",
main = "Boxplot de Residuos por Combinación de Operario y Maquina")
En este gráfico se representan los valores predichos por el modelo para
la variable resistencia de la fibra en función de la raíz cuadrada de
los residuos estandarizados. No se observa ninguna tendencia aparente en
la distribución de los valores, lo que sugiere que no hay evidencia de
incumplimiento del supuesto de homogeneidad de varianzas.
color_palette <- colorRampPalette(c("pink", "black", "pink"))
plot(residuos, main = "Prueba de independencia", pch = 20, cex = 2, col = color_palette(120), ylab = "Residuos", xlab = " ")
En la gráfica anterior, los puntos se presentan dispersos y no siguen un
patrón claro, lo cual sugiere indicios de homogeneidad de varianzas
(mayor dispersión implica una menor correlación entre los puntos).
Se procede a realizar la prueba de Bartlett, donde se evalúan las hipótesis pertinentes:
Se plantean las siguientes hipotesis:
\(H_0\): La varianza es constante en todos los grupos.
\(H_a\): La varianza no es constante en al menos en un grupo.
grupos <- with(Datosejercicio2, interaction(Operario, Maquina))
resultado_bartlett <- bartlett.test(residuals(modelo_anova2), grupos)
print(resultado_bartlett)
##
## Bartlett test of homogeneity of variances
##
## data: residuals(modelo_anova2) and grupos
## Bartlett's K-squared = 4.8106, df = 11, p-value = 0.94
Según el resultado de la prueba de Bartlett, donde se obtiene un valor de p igual a 0.94, que es mayor que el nivel de significancia de 0.05, se concluye que se acepta la hipótesis nula. Esto confirma la presencia de homogeneidad de varianzas, coincidiendo con lo inferido anteriormente de acuerdo al gráfico.
\(H_0\): Los residuos entre los tratamientos son independientes.
\(H_a\):Los residuos entre los tratamientos no son independientes.
install.packages("lmtest")
## Warning: package 'lmtest' is in use and will not be installed
library(lmtest)
resultado_durbin_watson <- dwtest(modelo_anova2)
print(resultado_durbin_watson)
##
## Durbin-Watson test
##
## data: modelo_anova2
## DW = 3.011, p-value = 0.6366
## alternative hypothesis: true autocorrelation is greater than 0
La prueba de Durbin-Watson indica que no existe correlación significativa entre los residuos. Esto se respalda por el valor del estadístico Durbin-Watson (DW), que se aproxima a 2 (DW = 3.011), y el valor p (p-value) de 0.6366, superando el nivel de significancia (α = 0.05). En consecuencia, se concluye que los residuos son independientes en el modelo, lo que indica la ausencia de autocorrelación significativa en los mismos.
modelo_anova2=lm(Resistencia~Operario+Maquina,data=Datosejercicio2)
anova(modelo_anova2)
## Analysis of Variance Table
##
## Response: Resistencia
## Df Sum Sq Mean Sq F value Pr(>F)
## Operario 2 160.333 80.167 16.004 0.0001014 ***
## Maquina 3 12.458 4.153 0.829 0.4950978
## Residuals 18 90.167 5.009
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
install.packages("agricolae")
## Warning: package 'agricolae' is in use and will not be installed
library(agricolae)
compara1=LSD.test(modelo_anova2,"Maquina")
compara1
## $statistics
## MSerror Df Mean CV t.value LSD
## 5.009259 18 112.2917 1.993147 2.100922 2.714789
##
## $parameters
## test p.ajusted name.t ntr alpha
## Fisher-LSD none Maquina 4 0.05
##
## $means
## Resistencia std r se LCL UCL Min Max Q25 Q50
## A 111.8333 2.714160 6 0.9137158 109.9137 113.7530 109 116 110.00 111.0
## B 112.1667 2.316607 6 0.9137158 110.2470 114.0863 110 115 110.25 111.5
## C 111.6667 4.179314 6 0.9137158 109.7470 113.5863 108 119 109.00 110.0
## D 113.5000 4.460942 6 0.9137158 111.5804 115.4196 108 120 110.50 113.0
## Q75
## A 113.50
## B 114.25
## C 113.25
## D 116.25
##
## $comparison
## NULL
##
## $groups
## Resistencia groups
## D 113.5000 a
## B 112.1667 a
## A 111.8333 a
## C 111.6667 a
##
## attr(,"class")
## [1] "group"
Gracias a esta comparación se evidencia una diferencia respecto al uso de las distintas maquinas puesto que la maquina D presenta una influencia mas positiva en cuanto a la variable respuesta mientras que con la maquina C sucede lo contrario, sin embargo, las diferencias no llegan a ser tan significativas.
compara2=LSD.test(modelo_anova2,"Operario")
compara2
## $statistics
## MSerror Df Mean CV t.value LSD
## 5.009259 18 112.2917 1.993147 2.100922 2.351076
##
## $parameters
## test p.ajusted name.t ntr alpha
## Fisher-LSD none Operario 3 0.05
##
## $means
## Resistencia std r se LCL UCL Min Max Q25 Q50
## OP1 109.875 2.232071 8 0.7913011 108.2125 111.5375 108 115 108.75 109.5
## OP2 111.125 1.552648 8 0.7913011 109.4625 112.7875 109 114 110.00 111.0
## OP3 115.875 2.695896 8 0.7913011 114.2125 117.5375 112 120 114.00 115.5
## Q75
## OP1 110.0
## OP2 112.0
## OP3 117.5
##
## $comparison
## NULL
##
## $groups
## Resistencia groups
## OP3 115.875 a
## OP2 111.125 b
## OP1 109.875 b
##
## attr(,"class")
## [1] "group"
Gracias a los resultados obtenidos es claro evidenciar que el operario 3 al hacer la comparacion de la resistencia que se obtiene, es aquel que presenta una mejor influencia en la variable respuesta, mientras que el operario 1 no genera unos resultados tan favorables.
Una empresa dedicada a la fabricación de baterías está interesada en diseñar una batería que sea relativamente insensible a la temperatura ambiente. Para ello decide probar con tres materiales distintos: M1, M2, y M3. Para estudiar el efecto del material y la temperatura se diseña el siguiente experimento: comprobar la duración de las baterías en horas, fabricando baterías con los tres materiales y trabajando las baterías a tres niveles de temperatura: Baja, Media y Alta. El experimento se replicaba cuatro veces y los resultados obtenidos son los de la tabla adjunta:
install.packages("readxl")
## Warning: package 'readxl' is in use and will not be installed
library(readxl)
Datosejercicio3<-read_excel("C:/Users/Claud/OneDrive/Escritorio/Séptimo/Diseño Experimental/Trabajo 3 ejercicios/Datos ejercicio 3.xlsx")
print(Datosejercicio3)
## # A tibble: 36 × 3
## Duracion Material Temperatura
## <dbl> <chr> <chr>
## 1 130 M1 Baja
## 2 155 M1 Baja
## 3 74 M1 Baja
## 4 180 M1 Baja
## 5 34 M1 Media
## 6 40 M1 Media
## 7 80 M1 Media
## 8 75 M1 Media
## 9 20 M1 Alta
## 10 70 M1 Alta
## # ℹ 26 more rows
Número de observaciones(replicas por tratamiento)
conteo_valores_tratamiento <- table(Datosejercicio3$Material, Datosejercicio3$Temperatura)
print("Número de observaciones (réplicas) por tratamiento:")
## [1] "Número de observaciones (réplicas) por tratamiento:"
print(conteo_valores_tratamiento)
##
## Alta Baja Media
## M1 4 4 4
## M2 4 4 4
## M3 4 4 4
Dado que el número de observaciones por tratamiento es el mismo, se puede concluir que es un diseño balanceado.
Medidas descriptivas de la variable dependiente(Duración)
summarytools::descr(Datosejercicio3[,1])
## Descriptive Statistics
## Datosejercicio3$Duracion
## N: 36
##
## Duracion
## ----------------- ----------
## Mean 105.53
## Std.Dev 47.10
## Min 20.00
## Q1 70.00
## Median 108.00
## Q3 144.50
## Max 188.00
## MAD 56.34
## IQR 71.75
## CV 0.45
## Skewness -0.06
## SE.Skewness 0.39
## Kurtosis -1.18
## N.Valid 36.00
## Pct.Valid 100.00
Gracias a los resultados obtenidos, se determina que el promedio de la variable respuesta que es la Duración es de 105.53, con una desviación estándar de 47.10. El valor mínimo observado en esta variable es de 20.00, mientras que el valor máximo alcanza los 188.00. El 50% de las observaciones se sitúan en un rango que va desde 70.00 hasta 144.50, lo que refleja la mediana de 108.00 como medida central. De la misma manera, se observa una asimetría negativa, con un coeficiente de asimetría de -0.06. Además, el coeficiente de curtosis es de -1.18, lo que sugiere que la distribución de los datos es platicúrtica.
resultados_descriptivos <- aggregate(Duracion~ Temperatura, data = Datosejercicio3, summary)
print(resultados_descriptivos)
## Temperatura Duracion.Min. Duracion.1st Qu. Duracion.Median Duracion.Mean
## 1 Alta 20.00000 54.75000 65.00000 64.16667
## 2 Baja 74.00000 129.00000 152.50000 144.83333
## 3 Media 34.00000 78.75000 117.50000 107.58333
## Duracion.3rd Qu. Duracion.Max.
## 1 82.00000 104.00000
## 2 162.00000 188.00000
## 3 136.75000 174.00000
A continuación se llevará a cabo el ANOVA de un diseño factorial de un dos factores con interacción, el cual nos permite estudiar si existen diferencias significativas entre la aplicacion de dos factores y la interacción para entender las variaciones observadas en la variable respuesta.
Para el factor α, es decir, el Material, la descripción de la hipotesis nula es que el promedio del tiempo de Duracion de la bateria es igual tanto si se utiliza el Material 1 como el 2 y 3. Mientras que para la hipotesis alternativa es que el promedio de duracion de la bateria es diferente para algún Material.
Se plantearían de la siguiente forma:
\(H_0:α_1=α_2=α_3=0\)
\(H_a:Algún\) \(α_i ≠0\)
Para el factor β, es decir, la Temperatura, la descripción de la hipotesis nula es que el promedio de duracion de la bateria es igual tanto para la temperatura baja como para media y alta. Mientras que para la hipotesis alternativa es que el promedio de duracion de la bateria es diferente para alguna temperatura.
Se plantearían de la siguiente forma:
\(H_0: β_Baja=β_Media_=β_Alta_=β_D=0\)
\(H_a:Algún\) \(β_i ≠0\)
Para la interacción (αβ), es decir, Material y temperatura,la descripción de la hipotesis nula es que el uso de diferentes materiales y grados de temperatura no influye en el tiempo de duracion de la bateria. Mientras que para la hipotesis alternativa es que el promedio del de duracion de la bateria se ve influenciado por el uso de algun material y temperatura.
Se plantearian de la siguiente forma:
\(H_0: (αβ)_ij= 0 Ɐ j\)
\(H_a:Algún (αβ)_ij ≠0\)
# Realizar el ANOVA
modelo_anova3 <- aov(Duracion ~ Material * Temperatura, data = Datosejercicio3)
# Mostrar resumen del ANOVA
summary(modelo_anova3)
## Df Sum Sq Mean Sq F value Pr(>F)
## Material 2 10684 5342 7.911 0.00198 **
## Temperatura 2 39119 19559 28.968 1.91e-07 ***
## Material:Temperatura 4 9614 2403 3.560 0.01861 *
## Residuals 27 18231 675
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Con la realización de un ANOVA de interacción hay evidencia significativa para rechazar la hipotesis nula, con lo cual es posible concluir que tanto el factor α, β y la interacción αβ, presentan influencia sobre la variable respuesta que es la duración de la bateria, dado que los p-valor de cada uno se encuentra por debajo del nivel de significancia.
# Crear un diagrama de cajas con interacción
boxplot(Datosejercicio3$Duracion ~ Datosejercicio3$Material * Datosejercicio3$Temperatura,
main = "Diagrama de Cajas de Duración de la bateria",
xlab = "Combinacion de Material y Temperatura",
ylab = "Duracion",
col = c("red", "yellow", "gray","green","pink","purple"))
De acuerdo al gráfico de cajas, se observan diferencias significativas
entre los diferentes tratamientos, siendo el material 3 el que presenta
mejores resultados incluso en la temperatura alta, mientras que el
material 1 solo presenta buen rendimiento en una temperatura baja, y el
material 2 presenta un buen desempeño tanto en la temperatura baja como
en la media, pero al llegar a la temperatura alta incluso presenta una
influencia mas negativa que la del material 1. Respecto a las
temperaturas, la baja es la mas ideal para todos los tipos de
materiales, sin embargo, se conserva una buena duración de la bateria en
la temperatura media para el caso del material 2 y 3.
install.packages("agricolae")
## Warning: package 'agricolae' is in use and will not be installed
library(agricolae)
modelo_anova3 <- aov(Duracion ~ Material + Temperatura + Material:Temperatura, data = Datosejercicio3)
LSD_result1 <- TukeyHSD(modelo_anova3)
print(LSD_result1)
## Tukey multiple comparisons of means
## 95% family-wise confidence level
##
## Fit: aov(formula = Duracion ~ Material + Temperatura + Material:Temperatura, data = Datosejercicio3)
##
## $Material
## diff lwr upr p adj
## M2-M1 25.16667 -1.135677 51.46901 0.0627571
## M3-M1 41.91667 15.614323 68.21901 0.0014162
## M3-M2 16.75000 -9.552344 43.05234 0.2717815
##
## $Temperatura
## diff lwr upr p adj
## Baja-Alta 80.66667 54.36432 106.96901 0.0000001
## Media-Alta 43.41667 17.11432 69.71901 0.0009787
## Media-Baja -37.25000 -63.55234 -10.94766 0.0043788
##
## $`Material:Temperatura`
## diff lwr upr p adj
## M2:Alta-M1:Alta -8.00 -69.823184 53.82318 0.9999508
## M3:Alta-M1:Alta 28.00 -33.823184 89.82318 0.8347331
## M1:Baja-M1:Alta 77.25 15.426816 139.07318 0.0067471
## M2:Baja-M1:Alta 98.25 36.426816 160.07318 0.0003574
## M3:Baja-M1:Alta 86.50 24.676816 148.32318 0.0018765
## M1:Media-M1:Alta -0.25 -62.073184 61.57318 1.0000000
## M2:Media-M1:Alta 62.25 0.426816 124.07318 0.0474675
## M3:Media-M1:Alta 88.25 26.426816 150.07318 0.0014679
## M3:Alta-M2:Alta 36.00 -25.823184 97.82318 0.5819453
## M1:Baja-M2:Alta 85.25 23.426816 147.07318 0.0022351
## M2:Baja-M2:Alta 106.25 44.426816 168.07318 0.0001152
## M3:Baja-M2:Alta 94.50 32.676816 156.32318 0.0006078
## M1:Media-M2:Alta 7.75 -54.073184 69.57318 0.9999614
## M2:Media-M2:Alta 70.25 8.426816 132.07318 0.0172076
## M3:Media-M2:Alta 96.25 34.426816 158.07318 0.0004744
## M1:Baja-M3:Alta 49.25 -12.573184 111.07318 0.2016535
## M2:Baja-M3:Alta 70.25 8.426816 132.07318 0.0172076
## M3:Baja-M3:Alta 58.50 -3.323184 120.32318 0.0742711
## M1:Media-M3:Alta -28.25 -90.073184 33.57318 0.8281938
## M2:Media-M3:Alta 34.25 -27.573184 96.07318 0.6420441
## M3:Media-M3:Alta 60.25 -1.573184 122.07318 0.0604247
## M2:Baja-M1:Baja 21.00 -40.823184 82.82318 0.9616404
## M3:Baja-M1:Baja 9.25 -52.573184 71.07318 0.9998527
## M1:Media-M1:Baja -77.50 -139.323184 -15.67682 0.0065212
## M2:Media-M1:Baja -15.00 -76.823184 46.82318 0.9953182
## M3:Media-M1:Baja 11.00 -50.823184 72.82318 0.9994703
## M3:Baja-M2:Baja -11.75 -73.573184 50.07318 0.9991463
## M1:Media-M2:Baja -98.50 -160.323184 -36.67682 0.0003449
## M2:Media-M2:Baja -36.00 -97.823184 25.82318 0.5819453
## M3:Media-M2:Baja -10.00 -71.823184 51.82318 0.9997369
## M1:Media-M3:Baja -86.75 -148.573184 -24.92682 0.0018119
## M2:Media-M3:Baja -24.25 -86.073184 37.57318 0.9165175
## M3:Media-M3:Baja 1.75 -60.073184 63.57318 1.0000000
## M2:Media-M1:Media 62.50 0.676816 124.32318 0.0460388
## M3:Media-M1:Media 88.50 26.676816 150.32318 0.0014173
## M3:Media-M2:Media 26.00 -35.823184 87.82318 0.8822881
En cuanto a los distintos materiales, los que presentan una diferencia significativa son el 3 y el 1 con un p-valor de 0.0014162 < 0.05, como se confirma con la grafica anterior. Para el caso de las temperaturas todas evidencian una diferencia significativa, sin embargo, la mayor diferencia se presenta entre la temperatura alta y baja con un p-valor de 0.0000001. De acuerdo a las interacciones, se presentan varias diferencias significativas pero la mas relevante es la de M2:Baja-M2:Alta con un p-valor de 0.0001152.
resultado_tukey3 <- TukeyHSD(modelo_anova3)
print(resultado_tukey3)
## Tukey multiple comparisons of means
## 95% family-wise confidence level
##
## Fit: aov(formula = Duracion ~ Material + Temperatura + Material:Temperatura, data = Datosejercicio3)
##
## $Material
## diff lwr upr p adj
## M2-M1 25.16667 -1.135677 51.46901 0.0627571
## M3-M1 41.91667 15.614323 68.21901 0.0014162
## M3-M2 16.75000 -9.552344 43.05234 0.2717815
##
## $Temperatura
## diff lwr upr p adj
## Baja-Alta 80.66667 54.36432 106.96901 0.0000001
## Media-Alta 43.41667 17.11432 69.71901 0.0009787
## Media-Baja -37.25000 -63.55234 -10.94766 0.0043788
##
## $`Material:Temperatura`
## diff lwr upr p adj
## M2:Alta-M1:Alta -8.00 -69.823184 53.82318 0.9999508
## M3:Alta-M1:Alta 28.00 -33.823184 89.82318 0.8347331
## M1:Baja-M1:Alta 77.25 15.426816 139.07318 0.0067471
## M2:Baja-M1:Alta 98.25 36.426816 160.07318 0.0003574
## M3:Baja-M1:Alta 86.50 24.676816 148.32318 0.0018765
## M1:Media-M1:Alta -0.25 -62.073184 61.57318 1.0000000
## M2:Media-M1:Alta 62.25 0.426816 124.07318 0.0474675
## M3:Media-M1:Alta 88.25 26.426816 150.07318 0.0014679
## M3:Alta-M2:Alta 36.00 -25.823184 97.82318 0.5819453
## M1:Baja-M2:Alta 85.25 23.426816 147.07318 0.0022351
## M2:Baja-M2:Alta 106.25 44.426816 168.07318 0.0001152
## M3:Baja-M2:Alta 94.50 32.676816 156.32318 0.0006078
## M1:Media-M2:Alta 7.75 -54.073184 69.57318 0.9999614
## M2:Media-M2:Alta 70.25 8.426816 132.07318 0.0172076
## M3:Media-M2:Alta 96.25 34.426816 158.07318 0.0004744
## M1:Baja-M3:Alta 49.25 -12.573184 111.07318 0.2016535
## M2:Baja-M3:Alta 70.25 8.426816 132.07318 0.0172076
## M3:Baja-M3:Alta 58.50 -3.323184 120.32318 0.0742711
## M1:Media-M3:Alta -28.25 -90.073184 33.57318 0.8281938
## M2:Media-M3:Alta 34.25 -27.573184 96.07318 0.6420441
## M3:Media-M3:Alta 60.25 -1.573184 122.07318 0.0604247
## M2:Baja-M1:Baja 21.00 -40.823184 82.82318 0.9616404
## M3:Baja-M1:Baja 9.25 -52.573184 71.07318 0.9998527
## M1:Media-M1:Baja -77.50 -139.323184 -15.67682 0.0065212
## M2:Media-M1:Baja -15.00 -76.823184 46.82318 0.9953182
## M3:Media-M1:Baja 11.00 -50.823184 72.82318 0.9994703
## M3:Baja-M2:Baja -11.75 -73.573184 50.07318 0.9991463
## M1:Media-M2:Baja -98.50 -160.323184 -36.67682 0.0003449
## M2:Media-M2:Baja -36.00 -97.823184 25.82318 0.5819453
## M3:Media-M2:Baja -10.00 -71.823184 51.82318 0.9997369
## M1:Media-M3:Baja -86.75 -148.573184 -24.92682 0.0018119
## M2:Media-M3:Baja -24.25 -86.073184 37.57318 0.9165175
## M3:Media-M3:Baja 1.75 -60.073184 63.57318 1.0000000
## M2:Media-M1:Media 62.50 0.676816 124.32318 0.0460388
## M3:Media-M1:Media 88.50 26.676816 150.32318 0.0014173
## M3:Media-M2:Media 26.00 -35.823184 87.82318 0.8822881
plot(resultado_tukey3)
La validez de los resultados obtenidos en cualquier análisis de varianza queda condicionado a que los supuestos del modelo se cumplan. Estos supuestos son: normalidad, varianza constante (igual varianza de los tratamientos) e independencia.
modelo <- lm(Duracion ~ Material * Temperatura, data = Datosejercicio3)
residuos<-residuals(modelo_anova3)
# Boxplot de residuos
boxplot(residuos, col = "lightgreen",
main = "Boxplot de Residuos",
xlab = "Combinación de Material y Temperatura",
ylab = "Residuos")
Para fortalecer la evidencia de que los residuos siguen una distribución
normal, se lleva a cabo el test de Shapiro-Wilk. Esta prueba se emplea
para corroborar la adecuación de los residuos al supuesto de normalidad
y evaluar las hipótesis correspondientes.
\(H_0\): Los residuos de la variable duración de la batería se distribuyen normalmente con media cero y varianza constante.
\(H_a\): Los residuos de la variable duración de la batería no siguen la distribución normal.
shapiro.test(residuals(modelo_anova3))
##
## Shapiro-Wilk normality test
##
## data: residuals(modelo_anova3)
## W = 0.97606, p-value = 0.6117
Por lo tanto, no hay evidencia estadística suficiente para rechazar la hipótesis nula. En otras palabras, se acepta la hipótesis nula, ya que el valor de p (p-value = 0.6117) es mayor que el valor del nivel de significancia (α = 0.05). Por lo tanto, se concluye que los residuos de la variable resistencia del caucho están normalmente distribuidos con media cero y varianza constante.
boxplot(residuos ~ Datosejercicio3$Material:Datosejercicio3$Temperatura,
col = "blue",
xlab = "Combinación de Material y Temperatura",
ylab = "Residuos",
main = "Boxplot de Residuos por Combinación de Material y Temperatura")
En esta gráfica, se observa una tendencia aparente en la distribución de
los valores, lo que sugiere que hay evidencia de incumplimiento del
supuesto de homogeneidad de varianzas.
Gráfico de residuos:
color_palette <- colorRampPalette(c("blue", "black", "blue"))
plot(residuos, main = "Prueba de independencia", pch = 20, cex = 2, col = color_palette(120), ylab = "Residuos", xlab = " ")
En la gráfica anterior se observan dispersos los puntos sin seguir un
patrón, esto es un indicio de homogeneidad de varianzas (entre más
dispersos menos correlacionados).
Sin embargo, para validar de manera más sólida la homogeneidad de varianzas, se realiza la prueba de bartlett.Donde las hipótesis correspondientes son:
\(H_0\): La varianza es constante en todos los grupos.
\(H_a\): La varianza no es constante en al menos en un grupo.
grupos <- with(Datosejercicio3, interaction(Material, Temperatura))
resultado_bartlett <- bartlett.test(residuals(modelo_anova3), grupos)
print(resultado_bartlett)
##
## Bartlett test of homogeneity of variances
##
## data: residuals(modelo_anova3) and grupos
## Bartlett's K-squared = 5.2354, df = 8, p-value = 0.7321
De acuerdo al valor arrojado por la prueba de bartlett, valor de p (0.7321) mayor a 0.05 se acepta la hipótesis nula, por lo que existe homogeneidad de varianzas, evidenciando que esta prueba es mas precisa que el gráfico anterior.
H_0: Los residuos entre los tratamientos son independientes.
H_a:Los residuos entre los tratamientos no son independientes.
install.packages("lmtest")
## Warning: package 'lmtest' is in use and will not be installed
library(lmtest)
resultado_durbin_watson <- dwtest(modelo_anova3)
print(resultado_durbin_watson)
##
## Durbin-Watson test
##
## data: modelo_anova3
## DW = 2.7135, p-value = 0.8175
## alternative hypothesis: true autocorrelation is greater than 0
La prueba de independencia de residuos para la resistencia revela que los residuos no están correlacionados. Con un valor de Durbin-Watson (DW) cercano a 2 (DW = 2.7135) y un p-valor de 0.8175 (superior por mucho a α = 0.05), se concluye que los residuos son independientes.
modelo_anova3=lm(Duracion~Material+Temperatura,data=Datosejercicio3)
anova(modelo_anova3)
## Analysis of Variance Table
##
## Response: Duracion
## Df Sum Sq Mean Sq F value Pr(>F)
## Material 2 10684 5341.9 5.9472 0.006515 **
## Temperatura 2 39119 19559.4 21.7759 1.239e-06 ***
## Residuals 31 27845 898.2
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
plot(modelo_anova3)
install.packages("agricolae")
## Warning: package 'agricolae' is in use and will not be installed
library(agricolae)
compara1=LSD.test(modelo_anova3,"Temperatura")
compara1
## $statistics
## MSerror Df Mean CV t.value LSD
## 898.2106 31 105.5278 28.40026 2.039513 24.95399
##
## $parameters
## test p.ajusted name.t ntr alpha
## Fisher-LSD none Temperatura 3 0.05
##
## $means
## Duracion std r se LCL UCL Min Max Q25 Q50
## Alta 64.16667 25.67218 12 8.65164 46.52153 81.8118 20 104 54.75 65.0
## Baja 144.83333 31.69409 12 8.65164 127.18820 162.4785 74 188 129.00 152.5
## Media 107.58333 42.88347 12 8.65164 89.93820 125.2285 34 174 78.75 117.5
## Q75
## Alta 82.00
## Baja 162.00
## Media 136.75
##
## $comparison
## NULL
##
## $groups
## Duracion groups
## Baja 144.83333 a
## Media 107.58333 b
## Alta 64.16667 c
##
## attr(,"class")
## [1] "group"
En cuanto a las temperaturas se comprueba que la baja es aquella que permite una mayor duración de la bateria.
compara2=LSD.test(modelo_anova3,"Material")
compara2
## $statistics
## MSerror Df Mean CV t.value LSD
## 898.2106 31 105.5278 28.40026 2.039513 24.95399
##
## $parameters
## test p.ajusted name.t ntr alpha
## Fisher-LSD none Material 3 0.05
##
## $means
## Duracion std r se LCL UCL Min Max Q25 Q50 Q75
## M1 83.16667 48.58888 12 8.65164 65.52153 100.8118 20 180 53.5 74.5 94.0
## M2 108.33333 49.47237 12 8.65164 90.68820 125.9785 25 188 67.0 118.5 139.5
## M3 125.08333 35.76555 12 8.65164 107.43820 142.7285 60 174 102.0 129.0 152.5
##
## $comparison
## NULL
##
## $groups
## Duracion groups
## M3 125.08333 a
## M2 108.33333 a
## M1 83.16667 b
##
## attr(,"class")
## [1] "group"
De acuerdo al uso de distintos materiales se infiere que el material 3 presenta una mejor influencia sobre la duración de la batería.