Taller de Práctica: Análisis Factorial Completo 2^k

Maestría en Investigación Operativa y Estadística

Objetivo del Taller:

Actividades

Establece las hipótesis nulas y alternativas para los efectos principales y la interacción.

Calcula las medias de tiempo de secado para cada combinación de factores. Realiza gráficos adecuados (e.g., boxplots, gráficos de interacción).

Realiza un ANOVA factorial para evaluar los efectos de Temperatura, Velocidad del Aire y su interacción. Interpreta los resultados estadísticos.

Verifica la normalidad de los residuos y la homogeneidad de varianzas.

Construye un gráfico de interacción para visualizar cómo los factores interactúan.

Caso de Estudio 1: Optimización del Proceso de Secado de Madera

Contexto

Una empresa maderera desea optimizar su proceso de secado de madera para reducir el tiempo total sin comprometer la calidad. Dos factores clave se consideran críticos en el proceso:

  1. Temperatura de Secado (Factor A):
  • Bajo nivel: 50°C
  • Alto nivel: 70°C
  1. Velocidad del Aire (Factor B):
  • Bajo nivel: 2 m/s
  • Alto nivel: 4 m/s

El objetivo es determinar cómo estos factores y su interacción afectan el tiempo total de secado (en horas).

Datos

Los datos se encuentran en el archivo datos_taller2.xlsx en la hoja Caso1.

Actividades

  • ¿Qué combinación de factores recomendarías para minimizar el tiempo de secado?
  • Discute si la interacción entre factores es relevante en este contexto.

Lectura de datos

Formulación de Hipótesis

Establece las hipótesis nulas y alternativas para los efectos principales y la interacción.

Ho = La temperatura y la velocidad del aire no tienen incidencia en el tiempo de secado

H1= tanto la temperatura como la velocidad del aire sí tienen indicencia en el tiempo de secado

datos <- read_xlsx("datos_taller2.xlsx", sheet = "Caso1") %>% clean_names()
ftable(datos)

observacion

temperatura_c

velocidad_del_aire_m_s

tiempo_de_secado_horas

1

50

2

30

2

50

2

32

3

50

2

31

4

50

4

28

5

50

4

27

6

50

4

29

7

70

2

25

8

70

2

24

9

70

2

26

10

70

4

20

11

70

4

21

12

70

4

19

Conversión a factores

datos <- datos%>%
  mutate_at(vars("temperatura_c", "velocidad_del_aire_m_s"), ~ factor(.))

ftable(datos)

observacion

temperatura_c

velocidad_del_aire_m_s

tiempo_de_secado_horas

1

50

2

30

2

50

2

32

3

50

2

31

4

50

4

28

5

50

4

27

6

50

4

29

7

70

2

25

8

70

2

24

9

70

2

26

10

70

4

20

11

70

4

21

12

70

4

19

Análisis Exploratorio de Datos

Calcula las medias de tiempo de secado para cada combinación de factores. Realiza gráficos adecuados (e.g., boxplots, gráficos de interacción).

Medias

datos_media <- datos %>%
  group_by(temperatura_c, velocidad_del_aire_m_s) %>%
  summarise(tiempo_de_secado_horas_medio = mean(tiempo_de_secado_horas))
## `summarise()` has grouped output by 'temperatura_c'. You can override using the
## `.groups` argument.
ftable(datos_media)

temperatura_c

velocidad_del_aire_m_s

tiempo_de_secado_horas_medio

50

2

31

50

4

28

70

2

25

70

4

20

Análisis de factores

Tanto una mayor temperatura como una mayor velocidad del aire contribuyen a reducir el tiempo de secado. Esto indica inicialmente que ambos factores tienen un papel importante en el proceso, y que un ajuste de estos parámetros podría optimizar el tiempo de secado.

library(patchwork)


grafico_1 <- ggplot(datos_media, aes(x = temperatura_c, y = tiempo_de_secado_horas_medio, color = velocidad_del_aire_m_s, group = velocidad_del_aire_m_s)) +
  geom_point(size = 3) +                # Añadir puntos
  geom_line() +                         # Añadir líneas para cada grupo
  labs(
    title = "Gráfico de Interacción con Medias",
    x = "tratamiento temperatura_c",
    y = "tiempo de secado en horas medio")

grafico_2 <- ggplot(datos_media, aes(x = velocidad_del_aire_m_s, y = tiempo_de_secado_horas_medio, color = temperatura_c, group = temperatura_c)) +
  geom_point(size = 3) +                # Añadir puntos
  geom_line() +                         # Añadir líneas para cada grupo
  labs(
    title = "Gráfico de Interacción con Medias",
    x = "tratamiento velocidad_del_aire_m_s",
    y = "tiempo de secado en horas medio")

grafico_1/grafico_2

Análisis gráficos de interacción

Esta gráfica muestra la interacción entre dos factores (temperatura y velocidad del aire) en el tiempo de secado promedio en horas. Cada gráfico representa una interacción distinta:

Gráfico Temperatura - Tiempo de secado:

Este gráfico muestra el efecto de la temperatura (tratamiento temperatura_c) en el tiempo de secado para dos niveles de velocidad del aire (velocidad_del_aire_m_s). Observamos que, a medida que la temperatura aumenta de 50 a 70, el tiempo de secado disminuye en ambos niveles de velocidad del aire. La disminución del tiempo de secado es mayor cuando la velocidad del aire es de 4 (línea azul) en comparación con cuando es de 2 (línea roja). Esto sugiere que el efecto de aumentar la temperatura es más pronunciado cuando la velocidad del aire es mayor.

Gráfico Velocidad del aire - Tiempo de secado:

Este gráfico muestra el efecto de la velocidad del aire (tratamiento velocidad_del_aire_m_s) en el tiempo de secado para dos niveles de temperatura (temperatura_c). Al aumentar la velocidad del aire de 2 a 4, el tiempo de secado disminuye en ambos niveles de temperatura. La reducción del tiempo de secado es más notable cuando la temperatura es de 70 (línea azul) que cuando es de 50 (línea roja). Esto indica que el efecto de aumentar la velocidad del aire es más significativo a una temperatura más alta.

library(ggplot2)
library(patchwork)

# Gráfico 1: Boxplot de Tiempo de Secado por Temperatura con valor medio etiquetado
grafico2 <- ggplot(datos, aes(x = factor(temperatura_c), y = tiempo_de_secado_horas)) +
  geom_boxplot(aes(fill = factor(temperatura_c)), color = "black", alpha = 0.7) +
  geom_jitter(width = 0.2, color = "darkblue", alpha = 0.5, size = 2) +  # Puntos de dispersión
  stat_summary(fun = mean, geom = "point", shape = 18, size = 3, color = "red") +  # Punto del valor medio
  stat_summary(fun = mean, geom = "text", aes(label = round(..y.., 1)),  # Etiqueta del valor medio
               vjust = -0.5, color = "black", size = 3.5) +
  labs(x = "Temperatura (°C)", y = "Tiempo de Secado en Horas",
       title = "Tiempo de Secado por Temperatura") +
  scale_fill_brewer(palette = "Blues") +
  theme_minimal() +
  theme(legend.position = "none",
        plot.title = element_text(size = 12))  # Tamaño del título

# Gráfico 2: Boxplot de Tiempo de Secado por Velocidad del Viento con valor medio etiquetado
grafico3 <- ggplot(datos, aes(x = factor(velocidad_del_aire_m_s), y = tiempo_de_secado_horas)) +
  geom_boxplot(aes(fill = factor(velocidad_del_aire_m_s)), color = "black", alpha = 0.7) +
  geom_jitter(width = 0.2, color = "darkblue", alpha = 0.5, size = 2) +  # Puntos de dispersión
  stat_summary(fun = mean, geom = "point", shape = 18, size = 3, color = "black") +  # Punto del valor medio
  stat_summary(fun = mean, geom = "text", aes(label = round(..y.., 1)),  # Etiqueta del valor medio
               vjust = -0.5, color = "black", size = 3.5) +
  labs(x = "Velocidad del Viento (m/s)", y = "Tiempo de Secado en Horas",
       title = "Tiempo de Secado por Velocidad del Viento") +
  scale_fill_brewer(palette = "Greens") +
  theme_minimal() +
  theme(legend.position = "none",
        plot.title = element_text(size = 12))  # Tamaño del título

# Combina ambos gráficos usando patchwork
grafico2 + grafico3
## Warning: The dot-dot notation (`..y..`) was deprecated in ggplot2 3.4.0.
## ℹ Please use `after_stat(y)` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.

De los boxplot se pude inferir que un aumento en la temperatura o un aumento en la velocidad del aire, tienen como efecto una disminución en el tiempo de secado, sin embargo, esto implicaría un aumento en el consumo energético.

Modelo

modelo <- aov(tiempo_de_secado_horas ~ temperatura_c+velocidad_del_aire_m_s, data=datos)

summary (modelo)
##                        Df Sum Sq Mean Sq F value   Pr(>F)    
## temperatura_c           1    147  147.00  120.27 1.65e-06 ***
## velocidad_del_aire_m_s  1     48   48.00   39.27 0.000147 ***
## Residuals               9     11    1.22                     
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Supuestos

residuos <- residuals(modelo)

#Normalidad de los residuals
# p > 0.05: No se rechaza la normalidad.
# p ≤ 0.05: Se rechaza la normalidad.

shapiro_test <- shapiro.test(residuos)
print(shapiro_test)
## 
##  Shapiro-Wilk normality test
## 
## data:  residuos
## W = 0.90561, p-value = 0.1874
qqnorm(residuos)
qqline(residuos)

Homogeneidad de Varianzas

# Test de Levene Interpretación:
  
# p > 0.05: No se rechaza la homogeneidad de varianzas.
# p ≤ 0.05: Se rechaza la homogeneidad de varianzas.

test_levene <- leveneTest(tiempo_de_secado_horas ~ temperatura_c*velocidad_del_aire_m_s, data = datos)
print(test_levene)
## Levene's Test for Homogeneity of Variance (center = median)
##       Df F value Pr(>F)
## group  3       0      1
##        8
plot(modelo$residuals)

Pruebas post Hoc

tukey <- TukeyHSD(modelo)
print(tukey)
##   Tukey multiple comparisons of means
##     95% family-wise confidence level
## 
## Fit: aov(formula = tiempo_de_secado_horas ~ temperatura_c + velocidad_del_aire_m_s, data = datos)
## 
## $temperatura_c
##       diff     lwr     upr   p adj
## 70-50   -7 -8.4439 -5.5561 1.7e-06
## 
## $velocidad_del_aire_m_s
##     diff     lwr     upr     p adj
## 4-2   -4 -5.4439 -2.5561 0.0001467
plot(tukey, las = 1)

Modelo Lineal

modelo_lineal <- lm(tiempo_de_secado_horas ~ temperatura_c+velocidad_del_aire_m_s,  data=datos)
summary(modelo_lineal)
## 
## Call:
## lm(formula = tiempo_de_secado_horas ~ temperatura_c + velocidad_del_aire_m_s, 
##     data = datos)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
##   -1.5   -0.5    0.0    0.5    1.5 
## 
## Coefficients:
##                         Estimate Std. Error t value Pr(>|t|)    
## (Intercept)              31.5000     0.5528  56.986 7.94e-13 ***
## temperatura_c70          -7.0000     0.6383 -10.967 1.65e-06 ***
## velocidad_del_aire_m_s4  -4.0000     0.6383  -6.267 0.000147 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.106 on 9 degrees of freedom
## Multiple R-squared:  0.9466, Adjusted R-squared:  0.9347 
## F-statistic: 79.77 on 2 and 9 DF,  p-value: 1.879e-06

Conclusiones Modelo Caso 1

Tanto la temperatura (temperatura_c) como la velocidad del aire (velocidad_del_aire_m_s) tienen un efecto estadísticamente significativo en el tiempo de secado (medido en horas) con niveles de significancia altos de forma independiente. Dado que, para la prueba de normalidad p-value < 0.05 y Pr(>F) = 1, para el modelo: Tiempo_secado ~ Temperatura*Velocidad_Aire puede concluirse que no existe evidencia estadística con la cual poder afirmar que los residuos tienen un comportamiento normal y son heterocedásticos. Por otro lado, dado que Pr(>F) = 0.121503 > 0.05 para el ANOVA, puede afirmarse que el factor temperatura y el factor velocidad del aire no presentan interacción.

Para el modelo: Tiempo_secado ~ Temperatura + Velocidad_Aire puede concluirse que existe evidencia estadística con la cual poder afirmar que los residuos tienen un comportamiento normal (p-value = 0.1874) y son homocedásticos Pr(>F) = 1 > 0.05.

El modelo lineal explica el 94.66% de la variabilidad en el tiempo de secado, como lo indica el R-cuadrado, lo que sugiere un buen ajuste del modelo a los datos. El error estándar de los residuos es relativamente bajo (1.106), lo que indica que las predicciones del modelo son bastante precisas. Además, el valor de F es muy significativo (p < 0.001), lo que respalda la validez del modelo.

Caso de Estudio 2: Mejora de la Resistencia de un Material Compuesto

Contexto

Un equipo de ingenieros está desarrollando un nuevo material compuesto y desea maximizar su resistencia a la tracción. Dos factores de proceso son críticos:

  1. Presión de Moldeo (Factor A):
  • Bajo nivel: 100 MPa
  • Alto nivel: 150 MPa
  1. Tiempo de Curado (Factor B):
  • Bajo nivel: 2 horas
  • Alto nivel: 4 horas

El objetivo es evaluar cómo estos factores afectan la resistencia (medida en megapascales, MPa) del material.

Datos

Los datos se encuentran en el archivo datos_taller2.xlsx en la hoja Caso2.

Actividades

  • ¿Cuál es la mejor combinación de presión y tiempo para maximizar la resistencia?
  • Sugiere posibles mejoras o consideraciones adicionales para el proceso.

Lectura de datos

Formulación de Hipótesis

Ho = La presión ejercida sobre el material y el tiempo NO afectan la resitencia a la tracción del material

H1= tanto la presión ejercida como el tiempo SÍ afectan la resistencia a la tracción del material

datos <- read_xlsx("datos_taller2.xlsx", sheet = "Caso2") %>% clean_names()
ftable(datos)

observacion

presion_m_pa

tiempo_horas

resistencia_m_pa

1

100

2

200

2

100

2

198

3

100

2

201

4

100

4

205

5

100

4

207

6

100

4

206

7

150

2

210

8

150

2

212

9

150

2

211

10

150

4

220

11

150

4

218

12

150

4

219

Conversión a factores

datos <- datos%>%
  mutate_at(vars("presion_m_pa", "tiempo_horas"), ~ factor(.))

ftable(datos)

observacion

presion_m_pa

tiempo_horas

resistencia_m_pa

1

100

2

200

2

100

2

198

3

100

2

201

4

100

4

205

5

100

4

207

6

100

4

206

7

150

2

210

8

150

2

212

9

150

2

211

10

150

4

220

11

150

4

218

12

150

4

219

datos_media <- datos %>%
  group_by(presion_m_pa, tiempo_horas) %>%
  summarise(resistencia_m_pa = mean(resistencia_m_pa))
## `summarise()` has grouped output by 'presion_m_pa'. You can override using the
## `.groups` argument.
ftable(datos_media)

presion_m_pa

tiempo_horas

resistencia_m_pa

100

2

199.6667

100

4

206.0000

150

2

211.0000

150

4

219.0000

Análisis de Factores

Tanto una mayor presión como un mayor tiempo de curado contribuyen a maximizar ela resistencia del material. Esto indica inicialmente que ambos factores tienen un papel importante en el proceso, y que un ajuste de estos parámetros podría maximizar la resistencia mecánica del material.

library(patchwork)


grafico_1 <- ggplot(datos_media, aes(x = presion_m_pa, y = resistencia_m_pa, color = tiempo_horas, group = tiempo_horas)) +
  geom_point(size = 3) +                # Añadir puntos
  geom_line() +                         # Añadir líneas para cada grupo
  labs(
    title = "Gráfico de Interacción con Medias",
    x = "tratamiento presion_m_pa",
    y = "resistencia_m_pao")

grafico_2 <- ggplot(datos_media, aes(x = tiempo_horas, y = resistencia_m_pa, color = presion_m_pa, group = presion_m_pa)) +
  geom_point(size = 3) +                # Añadir puntos
  geom_line() +                         # Añadir líneas para cada grupo
  labs(
    title = "Gráfico de Interacción con Medias",
    x = "tratamiento tiempo_horas",
    y = "resistencia_m_pao")

grafico_1/grafico_2

### Análisis de gráficos de interacción

Esta gráfica muestra la interacción entre dos factores (presión y tiempo de curado) en la resistencia a la tracción del material. Cada gráfico representa una interacción distinta:

Resistencia - Presión:

Este gráfico muestra el efecto de la presión (tratamiento presión) en la resistencia del material para dos niveles de tiempo de curado (tiempo de curado (horas)). Observemos que, a medida que la presión aumenta de 100 a 150 Mpa, la resistencia del material aumenta en ambos niveles de tiempo de curado.

Gráfico Resistencia - Tiempo de curado:

Este gráfico muestra el efecto del tiempo de curado en la resistencia del material para dos niveles de presión. Al aumentar lel tiempo de curado de 2 a 4 horas, la resistencia del material aumenta en ambos niveles de presión.

library(ggplot2)
library(patchwork)

# Gráfico 1: Boxplot de Resistencia por tiempo (horas) con valor medio etiquetado
grafico2 <- ggplot(datos, aes(x = factor(tiempo_horas), y = resistencia_m_pa)) +
  geom_boxplot(aes(fill = factor(tiempo_horas)), color = "black", alpha = 0.7) +
  geom_jitter(width = 0.2, color = "darkblue", alpha = 0.5, size = 2) +  # Puntos de dispersión
  stat_summary(fun = mean, geom = "point", shape = 18, size = 3, color = "red") +  # Punto del valor medio
  stat_summary(fun = mean, geom = "text", aes(label = round(..y.., 1)),  # Etiqueta del valor medio
               vjust = -0.5, color = "black", size = 3.5) +
  labs(x = "Tiempo (horas)", y = "Resistencia del material (m_pao)",
       title = "Resistencia vs Tiempo (horas)") +
  scale_fill_brewer(palette = "Blues") +
  theme_minimal() +
  theme(legend.position = "none",
        plot.title = element_text(size = 12))  # Tamaño del título

# Gráfico 2: Boxplot de Resistencia por presión con valor medio etiquetado
grafico3 <- ggplot(datos, aes(x = factor(presion_m_pa), y = resistencia_m_pa)) +
  geom_boxplot(aes(fill = factor(presion_m_pa)), color = "black", alpha = 0.7) +
  geom_jitter(width = 0.2, color = "darkblue", alpha = 0.5, size = 2) +  # Puntos de dispersión
  stat_summary(fun = mean, geom = "point", shape = 18, size = 3, color = "red") +  # Punto del valor medio
  stat_summary(fun = mean, geom = "text", aes(label = round(..y.., 1)),  # Etiqueta del valor medio
               vjust = -0.5, color = "black", size = 3.5) +
  labs(x = "Presión (mPa)", y = "Resistencia del material (m_pao)",
       title = "Resistencia vs Presión") +
  scale_fill_brewer(palette = "Greens") +
  theme_minimal() +
  theme(legend.position = "none",
        plot.title = element_text(size = 12))  # Tamaño del título

# Combina ambos gráficos usando patchwork
grafico2 / grafico3

De los boxplot se pude inferir que un aumento en la presión o un aumento en el tiempo de curado, tienen como efecto un aumento en la resistencia del material.

Modelo

modelo <- aov(resistencia_m_pa ~ presion_m_pa*tiempo_horas, data=datos)

summary (modelo)
##                           Df Sum Sq Mean Sq F value   Pr(>F)    
## presion_m_pa               1  444.1   444.1 333.062 8.36e-08 ***
## tiempo_horas               1  154.1   154.1 115.562 4.93e-06 ***
## presion_m_pa:tiempo_horas  1    2.1     2.1   1.563    0.247    
## Residuals                  8   10.7     1.3                     
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Supuestos

residuos <- residuals(modelo)

#Normalidad de los residuals
# p > 0.05: No se rechaza la normalidad.
# p ≤ 0.05: Se rechaza la normalidad.

shapiro_test <- shapiro.test(residuos)
print(shapiro_test)
## 
##  Shapiro-Wilk normality test
## 
## data:  residuos
## W = 0.91556, p-value = 0.2513
qqnorm(residuos)
qqline(residuos)

Homogeneidad de Varianzas

# Test de Levene Interpretación:
  
# p > 0.05: No se rechaza la homogeneidad de varianzas.
# p ≤ 0.05: Se rechaza la homogeneidad de varianzas.

test_levene <- leveneTest(resistencia_m_pa  ~ presion_m_pa*tiempo_horas, data = datos)
print(test_levene)
## Levene's Test for Homogeneity of Variance (center = median)
##       Df F value Pr(>F)
## group  3  0.1667 0.9159
##        8
plot(modelo$residuals)

Pruebas post Hoc

tukey <- TukeyHSD(modelo)
print(tukey)
##   Tukey multiple comparisons of means
##     95% family-wise confidence level
## 
## Fit: aov(formula = resistencia_m_pa ~ presion_m_pa * tiempo_horas, data = datos)
## 
## $presion_m_pa
##             diff      lwr    upr p adj
## 150-100 12.16667 10.62933 13.704 1e-07
## 
## $tiempo_horas
##         diff      lwr      upr   p adj
## 4-2 7.166667 5.629331 8.704003 4.9e-06
## 
## $`presion_m_pa:tiempo_horas`
##                  diff       lwr       upr     p adj
## 150:2-100:2 11.333333  8.314127 14.352540 0.0000099
## 100:4-100:2  6.333333  3.314127  9.352540 0.0006820
## 150:4-100:2 19.333333 16.314127 22.352540 0.0000001
## 100:4-150:2 -5.000000 -8.019206 -1.980794 0.0032137
## 150:4-150:2  8.000000  4.980794 11.019206 0.0001318
## 150:4-100:4 13.000000  9.980794 16.019206 0.0000035
plot(tukey, las = 1)

Modelo Lineal

modelo_lineal <- lm(resistencia_m_pa  ~ presion_m_pa*tiempo_horas,  data=datos)
summary(modelo_lineal)
## 
## Call:
## lm(formula = resistencia_m_pa ~ presion_m_pa * tiempo_horas, 
##     data = datos)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
## -1.667 -1.000  0.000  1.000  1.333 
## 
## Coefficients:
##                               Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                   199.6667     0.6667 299.500  < 2e-16 ***
## presion_m_pa150                11.3333     0.9428  12.021 2.12e-06 ***
## tiempo_horas4                   6.3333     0.9428   6.718  0.00015 ***
## presion_m_pa150:tiempo_horas4   1.6667     1.3333   1.250  0.24663    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.155 on 8 degrees of freedom
## Multiple R-squared:  0.9825, Adjusted R-squared:  0.976 
## F-statistic: 150.1 on 3 and 8 DF,  p-value: 2.271e-07

Conclusiones MOdelo Caso 2

Tanto la presión como el tiempo de curado tienen un efecto estadísticamente significativo en la resistencia del material con niveles de significancia altos de forma independiente. Dado que, para la prueba de normalidad p-value = 0.2513 y para la prueba de homocedasticidad Pr(>F) = 0.9159, en el modelo: resistencia del material ~ presión*tiempo de curado, puede concluirse que existe evidencia estadística con la cual poder afirmar que los residuos tienen un comportamiento normal y son homocedásticos. Por otro lado, dado que Pr(>F) = 0.247 > 0.05 para el ANOVA, puede afirmarse que el factor presión y el factor tiempo de curado no presentan interacción.

El modelo lineal explica el 97.6% de la variabilidad de la resistencia del material, como lo indica el R-cuadrado, lo que sugiere un buen ajuste del modelo a los datos. El error estándar de los residuos es relativamente bajo (1.155), lo que indica que las predicciones del modelo son bastante precisas. Además, el valor de F es muy significativo (p = 2.271e-07, p < 0.001), lo que respalda la validez del modelo.

Caso de Estudio 3: Optimización de la Eficiencia Energética en Hornos Industriales

Contexto

Una planta industrial quiere optimizar el consumo de energía en sus hornos. Dos variables de operación son clave:

  1. Aislamiento Térmico (Factor A):
  • Bajo nivel: Aislamiento Estándar
  • Alto nivel: Aislamiento Mejorado
  1. Velocidad del Ventilador (Factor B):
  • Bajo nivel: 1000 RPM
  • Alto nivel: 1500 RPM

El objetivo es evaluar el efecto de estos factores en el consumo energético (kWh) del horno durante un ciclo de operación.

Datos

Los datos se encuentran en el archivo datos_taller2.xlsx en la hoja Caso3.

Actividades

  • ¿Qué configuración reduce más el consumo energético?
  • Considera aspectos económicos y prácticos en tus recomendaciones.

Lectura de datos

Formulación de Hipótesis

Ho = La velocidad del motor en rpm y el tipo de aislamiento NO condicionan el consumo energético.

H1= La velocidad del motor en rpm y el tipo de aislamieno SÍ condicionan el consumo energético.

datos <- read_xlsx("datos_taller2.xlsx", sheet = "Caso3") %>% clean_names()
ftable(datos)

observacion

aislamiento

velocidad_rpm

consumo_energetico_k_wh

1

Estándar

1,000

500

2

Estándar

1,000

510

3

Estándar

1,000

505

4

Estándar

1,500

520

5

Estándar

1,500

525

6

Estándar

1,500

530

7

Mejorado

1,000

470

8

Mejorado

1,000

475

9

Mejorado

1,000

480

10

Mejorado

1,500

450

11

Mejorado

1,500

455

12

Mejorado

1,500

460

Conversión a factores

datos <- datos%>%
  mutate_at(vars("aislamiento", "velocidad_rpm"), ~ factor(.))

ftable(datos)

observacion

aislamiento

velocidad_rpm

consumo_energetico_k_wh

1

Estándar

1000

500

2

Estándar

1000

510

3

Estándar

1000

505

4

Estándar

1500

520

5

Estándar

1500

525

6

Estándar

1500

530

7

Mejorado

1000

470

8

Mejorado

1000

475

9

Mejorado

1000

480

10

Mejorado

1500

450

11

Mejorado

1500

455

12

Mejorado

1500

460

datos_media <- datos %>%
  group_by(aislamiento, velocidad_rpm) %>%
  summarise(consumo_energetico_k_wh = mean(consumo_energetico_k_wh))
## `summarise()` has grouped output by 'aislamiento'. You can override using the
## `.groups` argument.
ftable(datos_media)

aislamiento

velocidad_rpm

consumo_energetico_k_wh

Estándar

1000

505

Estándar

1500

525

Mejorado

1000

475

Mejorado

1500

455

Análisis de Factores

Una mejora en el aislamiento del horno, contribuye en mayor grado en la disminución del consumo energético en comparación al aumento de las RPM del motor del ventilador.

library(patchwork)

grafico_1 <- ggplot(datos_media, aes(x = velocidad_rpm, y = consumo_energetico_k_wh, 
color = factor(aislamiento), group = aislamiento)) +
  geom_point(size = 3) +                # Añadir puntos
  geom_line() +                         # Añadir líneas para cada grupo de aislamiento
  labs(
    title = "Consumo Energético según Velocidad RPM y Tipo de Aislamiento",
    x = "Velocidad (RPM)",
    y = "Consumo Energético (kWh)",
    color = "Tipo de Aislamiento"
  ) +
  theme_minimal()

# Gráfico 2: Interacción de Consumo Energético y Aislamiento para cada Nivel de Velocidad RPM
grafico_2 <- ggplot(datos_media, aes(x = factor(aislamiento), y = consumo_energetico_k_wh, color = factor(velocidad_rpm), group = velocidad_rpm)) +
  geom_point(size = 3) +                # Añadir puntos
  geom_line() +                         # Añadir líneas para cada grupo de velocidad RPM
  labs(
    title = "Consumo Energético según Aislamiento y Velocidad RPM",
    x = "Tipo de Aislamiento",
    y = "Consumo Energético (kWh)",
    color = "Velocidad (RPM)"
  ) +
  theme_minimal()

# Combina ambos gráficos con patchwork
grafico_1 / grafico_2

## Análisis de gráficos de interacción

Un aislamiento mejorado garantiza un menor consumo energético a ambas velocidades.

library(patchwork)

grafico_aislamiento <- ggplot(datos_media, aes(x = factor(aislamiento), y = consumo_energetico_k_wh)) +
  geom_boxplot(aes(fill = factor(aislamiento)), color = "black", alpha = 0.7) +
  geom_jitter(width = 0.2, color = "darkblue", alpha = 0.5, size = 2) +  # Puntos de dispersión
  stat_summary(fun = mean, geom = "point", shape = 18, size = 3, color = "red") +  # Punto del valor medio
  stat_summary(fun = mean, geom = "text", aes(label = round(..y.., 1)),  # Etiqueta del valor medio
               vjust = -0.5, color = "black", size = 3.5) +
  labs(
    x = "Tipo de Aislamiento",
    y = "Consumo Energético (kWh)",
    title = "Consumo Energético por Tipo de Aislamiento"
  ) +
  scale_fill_brewer(palette = "Blues") +
  theme_minimal() +
  theme(
    legend.position = "none",
    plot.title = element_text(size = 14, face = "bold")
  )

# Gráfico 2: Boxplot de Consumo energético por Velocidad (rpm)
grafico_velocidad <- ggplot(datos_media, aes(x = factor(velocidad_rpm), y = consumo_energetico_k_wh)) +
  geom_boxplot(aes(fill = factor(velocidad_rpm)), color = "black", alpha = 0.7) +
  geom_jitter(width = 0.2, color = "darkblue", alpha = 0.5, size = 2) +  # Puntos de dispersión
  stat_summary(fun = mean, geom = "point", shape = 18, size = 3, color = "red") +  # Punto del valor medio
  stat_summary(fun = mean, geom = "text", aes(label = round(..y.., 1)),  # Etiqueta del valor medio
               vjust = -0.5, color = "black", size = 3.5) +
  labs(
    x = "Velocidad (rpm)",
    y = "Consumo Energético (kWh)",
    title = "Consumo Energético por Velocidad (rpm)"
  ) +
  scale_fill_brewer(palette = "Greens") +
  theme_minimal() +
  theme(
    legend.position = "none",
    plot.title = element_text(size = 14, face = "bold")
  )

# Combina ambos gráficos usando patchwork
grafico_aislamiento / grafico_velocidad

Se confirma que un aislamiento mejorado garantiza un menor consumo energético.

Modelo

modelo <- aov(consumo_energetico_k_wh ~ velocidad_rpm+aislamiento, data=datos)

summary (modelo)
##               Df Sum Sq Mean Sq F value   Pr(>F)    
## velocidad_rpm  1      0       0    0.00        1    
## aislamiento    1   7500    7500   48.21 6.73e-05 ***
## Residuals      9   1400     156                     
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Supuestos

residuos <- residuals(modelo)

#Normalidad de los residuals
# p > 0.05: No se rechaza la normalidad.
# p ≤ 0.05: Se rechaza la normalidad.

shapiro_test <- shapiro.test(residuos)
print(shapiro_test)
## 
##  Shapiro-Wilk normality test
## 
## data:  residuos
## W = 0.89998, p-value = 0.1585
qqnorm(residuos)
qqline(residuos)

Homogeneidad de Varianzas

# Test de Levene Interpretación:
  
# p > 0.05: No se rechaza la homogeneidad de varianzas.
# p ≤ 0.05: Se rechaza la homogeneidad de varianzas.

test_levene <- leveneTest(consumo_energetico_k_wh ~ velocidad_rpm*aislamiento, data = datos)
print(test_levene)
## Levene's Test for Homogeneity of Variance (center = median)
##       Df F value Pr(>F)
## group  3       0      1
##        8
plot(modelo$residuals)

Pruebas post Hoc

tukey <- TukeyHSD(modelo)
print(tukey)
##   Tukey multiple comparisons of means
##     95% family-wise confidence level
## 
## Fit: aov(formula = consumo_energetico_k_wh ~ velocidad_rpm + aislamiento, data = datos)
## 
## $velocidad_rpm
##                    diff       lwr      upr p adj
## 1500-1000 -1.136868e-13 -16.28939 16.28939     1
## 
## $aislamiento
##                   diff       lwr       upr    p adj
## Mejorado-Estándar  -50 -66.28939 -33.71061 6.73e-05
plot(tukey, las = 1)

Modelo Lineal

modelo_lineal <- lm(consumo_energetico_k_wh ~ velocidad_rpm*aislamiento,  data=datos)
summary(modelo_lineal)
## 
## Call:
## lm(formula = consumo_energetico_k_wh ~ velocidad_rpm * aislamiento, 
##     data = datos)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
##     -5     -5      0      5      5 
## 
## Coefficients:
##                                       Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                            505.000      2.887 174.937 1.28e-15 ***
## velocidad_rpm1500                       20.000      4.082   4.899 0.001195 ** 
## aislamientoMejorado                    -30.000      4.082  -7.348 8.01e-05 ***
## velocidad_rpm1500:aislamientoMejorado  -40.000      5.774  -6.928 0.000121 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 5 on 8 degrees of freedom
## Multiple R-squared:  0.9775, Adjusted R-squared:  0.9691 
## F-statistic:   116 on 3 and 8 DF,  p-value: 6.219e-07

Conclusiones Caso 3

El tipo de aislamiento y la interacción aislamiento * velocidad de rotación para el mmodelo consumo_energetico_k_wh ~ velocidad_rpm*aislamiento, tiene un efecto significativo en el consumo energético con niveles de significancia altos de forma independiente, sin embargo, no se cumple la prueba de hipótesis de la normalidad de los residuos. Si bien, la ANOVA indica que existe interacción entre los factores aislamiento y velocidad del motor, se decide plantear un modelo consumo_energetico_k_wh ~ velocidad_rpm + aislamiento, en el entendido de que tal interacción no puede ser modelada garantizando el supuesto de normalidad de los residuos.

Dado que, para la prueba de normalidad p-value = 0.1585 y para la prueba de homocedasticidad Pr(>F) = 1, en el modelo: consumo energético ~ aislamiento +velocidad del motor, puede concluirse que existe evidencia estadística con la cual poder afirmar que los residuos tienen un comportamiento normal y son homocedásticos.

El modelo lineal explica el 96.91% de la variabilidad del consumo energético, como lo indica el R-cuadrado, lo que sugiere un buen ajuste del modelo a los datos. El error estándar de los residuos es relativamente bajo (5), lo que indica que las predicciones del modelo son bastante precisas. Además, el valor de F es muy significativo (p = 6.219e-07, p < 0.001), lo que respalda la validez del modelo.