## =================================================================================
# Análisis de diseño factoriales completo
# Incluye paquete de visualización phia
# Dr. Carlos Téllez Martínez
# Julio de 2020
## =================================================================================
# Problema a analizar:
# Se desea seleccionar un material para un producto de manera
# que la afectación a los cambios de temperatura sea la menor posible.
# Para esto se analizaron 3 materiales a 3 temperaturas diferentes
# donde la respuesta es el tiempo de duración del producto a las
# condiciones dadas.
# Lectura de datos
library(readxl)
Duracion <- read_excel("Duracion.xlsx")
attach(Duracion)
names(Duracion)
## [1] "Material" "Temperatura" "Tiempo_duracion"
str(Duracion)
## tibble [36 × 3] (S3: tbl_df/tbl/data.frame)
## $ Material : chr [1:36] "Material1" "Material1" "Material1" "Material2" ...
## $ Temperatura : num [1:36] 15 80 125 15 80 125 15 80 125 15 ...
## $ Tiempo_duracion: num [1:36] 155 34 20 150 126 25 138 174 96 130 ...
# Cambio de variables
FactorA_Material <- factor(Material)
FactorB_Temperatura <- factor(Temperatura)
Respuesta_Tiempo_duracion <- Duracion$Tiempo_duracion
# Cálculo de la tabla ANOVA
Modelo <- lm(Respuesta_Tiempo_duracion ~ (FactorA_Material + FactorB_Temperatura)^2)
ANOVA <- aov(Modelo)
summary(ANOVA)
## Df Sum Sq Mean Sq F value Pr(>F)
## FactorA_Material 2 10633 5317 7.983 0.00189 **
## FactorB_Temperatura 2 39083 19542 29.344 1.69e-07 ***
## FactorA_Material:FactorB_Temperatura 4 9438 2359 3.543 0.01897 *
## Residuals 27 17981 666
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# Gráficas de efectos principales e interacciones
library(phia)
## Loading required package: car
## Loading required package: carData
Grafica <- interactionMeans(Modelo)
plot(Grafica)
par(mfrow=c(1,1))
# Análisis de la idoneidad del modelo
# Normalidad de residuos
shapiro.test(rstandard(Modelo))
##
## Shapiro-Wilk normality test
##
## data: rstandard(Modelo)
## W = 0.9777, p-value = 0.6672
# No hay observaciones anormales
# Prueba de homocedasticidad o igualdad de varianzas
library(car)
ncvTest(Modelo)
## Non-constant Variance Score Test
## Variance formula: ~ fitted.values
## Chisquare = 0.8336819, Df = 1, p = 0.36121
# No tenemos problemas con la igualdad de varianzas
# Recuerde:
# Un modelo predictivo presenta homocedasticidad cuando la varianza
# del error condicional a las variables explicativas es constante
# a lo largo de las observaciones.
# Para hacer predicciones
# Se hace la predicción con los valores que salen del análisis
FactorA_Material2 <- factor(c("Material1", "Material2" ,"Material3"))
FactorB_Temperatura2 <- factor(c(15,15,15))
predict(object = Modelo,
newdata = data.frame(FactorA_Material=FactorA_Material2,
FactorB_Temperatura=FactorB_Temperatura2),
interval = "confidence")
## fit lwr upr
## 1 134.75 108.2751 161.2249
## 2 155.75 129.2751 182.2249
## 3 144.00 117.5251 170.4749
## La predicción para Material 2 con Temperatura de 15 es de 155.75 de duración
# Para probar el material más homogéneo
# Se aprecia que el material 3 es el más homogéneo
FactorA_Material2 <- factor(c("Material3", "Material3" ,"Material3"))
FactorB_Temperatura2 <- factor(c(15,80, 125))
predict(object = Modelo,
newdata = data.frame(FactorA_Material=FactorA_Material2,
FactorB_Temperatura=FactorB_Temperatura2),
interval = "confidence")
## fit lwr upr
## 1 144.00 117.52515 170.4749
## 2 145.75 119.27515 172.2249
## 3 85.50 59.02515 111.9749
# Es homogéneo a temperatura baja y media, baja a alta temperatura
# El mejor material es el 3.
# ============================