El experimento corresponde a un diseño factorial 3 × 2 × 2,
con tres factores experimentales:
T.Susp: Tipo de
suspensión.
A.Malla: Abertura de la malla.
T.Cicla: Temperatura de ciclaje.
La variable de respuesta es Vol.Sedimentacion. El
objetivo práctico del experimento es minimizar el volumen de
sedimentación.
# ============================================================
# Carga del archivo
# Coloca el archivo Excel en la misma carpeta de este RMarkdown.
# El script busca ambos nombres posibles.
# ============================================================
opciones_archivo <- c("FFD_con_respuestas.xlsx", "FFD_Con_Respuestas.xlsx")
archivo <- opciones_archivo[file.exists(opciones_archivo)][1]
if (is.na(archivo)) {
message("No encontré el archivo Excel en la carpeta del RMarkdown. Selecciónalo manualmente.")
archivo <- file.choose()
}
datos_original <- readxl::read_excel(archivo, sheet = "FFD")
# Renombramiento limpio de columnas.
# Se conservan las convenciones originales en las etiquetas de análisis.
datos <- datos_original %>%
rename(
TSusp = `T.Susp.`,
AMalla = `A.Malla`,
TCicla = `T.Cicla.`,
Bloque = `Blocks`,
Corrida = `run.no`,
VolSed = `Vol.Sedimentacion`
) %>%
mutate(
TSusp = factor(TSusp, levels = c("A1", "A2", "A3")),
AMalla = factor(AMalla, levels = c("B1", "B2")),
TCicla = factor(TCicla, levels = c("C1", "C2")),
Bloque = factor(Bloque),
VolSed = as.numeric(VolSed),
Grupo = interaction(TSusp, AMalla, TCicla, sep = ":"),
Orden = row_number()
)
# Vista interactiva de la matriz experimental con respuestas.
DT::datatable(
datos %>% select(Orden, Corrida, TSusp, AMalla, TCicla, Bloque, VolSed),
filter = "top",
rownames = FALSE,
options = list(
pageLength = 12,
scrollX = TRUE,
dom = "Bfrtip"
),
caption = "Matriz del diseño factorial con la variable de respuesta Volumen de Sedimentación"
)resumen_combinaciones <- datos %>%
group_by(TSusp, AMalla, TCicla) %>%
summarise(
n = n(),
media = mean(VolSed, na.rm = TRUE),
sd = sd(VolSed, na.rm = TRUE),
minimo = min(VolSed, na.rm = TRUE),
maximo = max(VolSed, na.rm = TRUE),
.groups = "drop"
) %>%
arrange(media)
DT::datatable(
resumen_combinaciones,
rownames = FALSE,
options = list(pageLength = 12, scrollX = TRUE),
caption = "Resumen por combinación factorial, ordenado de menor a mayor volumen promedio"
) %>%
DT::formatRound(columns = c("media", "sd", "minimo", "maximo"), digits = 3)mejor <- resumen_combinaciones %>% slice_min(media, n = 1)
peor <- resumen_combinaciones %>% slice_max(media, n = 1)
cat(
'<div class="good-box">',
'<b>Mejor combinación observada para minimizar la respuesta:</b> ',
'T.Susp = ', as.character(mejor$TSusp), ', ',
'A.Malla = ', as.character(mejor$AMalla), ', ',
'T.Cicla = ', as.character(mejor$TCicla), '. ',
'Promedio observado = ', round(mejor$media, 3), '.',
'<br><br>',
'<b>Combinación con mayor volumen promedio:</b> ',
'T.Susp = ', as.character(peor$TSusp), ', ',
'A.Malla = ', as.character(peor$AMalla), ', ',
'T.Cicla = ', as.character(peor$TCicla), '. ',
'Promedio observado = ', round(peor$media, 3), '.',
'</div>',
sep = ""
)resumen_combinaciones <- resumen_combinaciones %>%
mutate(
combinacion = paste("T.Susp", TSusp, "| A.Malla", AMalla, "| T.Cicla", TCicla),
combinacion = factor(combinacion, levels = combinacion),
hover = paste0(
"Combinación: ", combinacion,
"<br>Media: ", round(media, 3),
"<br>Desv. estándar: ", round(sd, 3),
"<br>n: ", n
)
)
p_ranking <- ggplot(
resumen_combinaciones,
aes(x = combinacion, y = media, fill = media, text = hover)
) +
geom_col(width = 0.72, color = "white") +
coord_flip() +
scale_fill_viridis_c(option = "C", direction = -1) +
labs(
title = "Ranking de combinaciones factoriales",
subtitle = "La barra más corta es la condición más conveniente porque se busca minimizar Vol.Sedimentacion",
x = "Combinación experimental",
y = "Volumen promedio de sedimentación",
fill = "Media"
) +
tema_grafico
plotly::ggplotly(p_ranking, tooltip = "text") %>%
plotly::layout(legend = list(orientation = "h", x = 0.1, y = -0.2))resumen_combinaciones <- resumen_combinaciones %>%
mutate(
hover_heat = paste0(
"T.Susp: ", TSusp,
"<br>A.Malla: ", AMalla,
"<br>T.Cicla: ", TCicla,
"<br>Media: ", round(media, 3),
"<br>SD: ", round(sd, 3)
)
)
p_heat <- ggplot(
resumen_combinaciones,
aes(x = AMalla, y = TSusp, fill = media, text = hover_heat)
) +
geom_tile(color = "white", linewidth = 1.3) +
geom_text(aes(label = round(media, 1)), color = "white", fontface = "bold", size = 5) +
facet_wrap(~ TCicla) +
scale_fill_viridis_c(option = "C", direction = -1) +
labs(
title = "Mapa de calor del volumen promedio",
subtitle = "Valores menores son mejores para el objetivo del experimento",
x = "Abertura de malla (A.Malla)",
y = "Tipo de suspensión (T.Susp)",
fill = "Media"
) +
tema_grafico
plotly::ggplotly(p_heat, tooltip = "text")El modelo ampliado utilizado es el factorial completo: incluye efectos principales, interacciones de dos factores e interacción triple.
\[ Y = \mu + T.Susp + A.Malla + T.Cicla + T.Susp:A.Malla + T.Susp:T.Cicla + A.Malla:T.Cicla + T.Susp:A.Malla:T.Cicla + \varepsilon \]
modelo_ampliado <- lm(VolSed ~ TSusp * AMalla * TCicla, data = datos)
# Se agregan residuos y ajustados para los diagnósticos.
datos <- datos %>%
mutate(
Ajustado = fitted(modelo_ampliado),
Residuo = residuals(modelo_ampliado),
Residuo_estandar = rstandard(modelo_ampliado),
Residuo_student = rstudent(modelo_ampliado),
Abs_sqrt_resid = sqrt(abs(Residuo_estandar))
)
resumen_modelo <- broom::glance(modelo_ampliado)
DT::datatable(
resumen_modelo,
rownames = FALSE,
options = list(dom = "t", scrollX = TRUE),
caption = "Resumen global del modelo lineal ampliado"
) %>%
DT::formatRound(columns = names(resumen_modelo)[sapply(resumen_modelo, is.numeric)], digits = 4)coeficientes_modelo <- broom::tidy(modelo_ampliado, conf.int = TRUE) %>%
mutate(
termino = limpiar_termino(term),
p.value = p.value,
decision = ifelse(!is.na(p.value) & p.value < alfa, "Significativo", "No significativo")
) %>%
select(termino, estimate, std.error, statistic, p.value, conf.low, conf.high, decision)
DT::datatable(
coeficientes_modelo,
rownames = FALSE,
options = list(pageLength = 12, scrollX = TRUE),
caption = "Coeficientes del modelo ampliado"
) %>%
DT::formatRound(columns = c("estimate", "std.error", "statistic", "conf.low", "conf.high"), digits = 4) %>%
DT::formatSignif(columns = "p.value", digits = 4)p_hist <- ggplot(datos, aes(x = Residuo, text = paste0("Residuo: ", round(Residuo, 3)))) +
geom_histogram(aes(y = after_stat(density)), bins = 12, fill = "#1565C0", color = "white", alpha = 0.82) +
geom_density(color = "#F28E2B", linewidth = 1.2) +
geom_vline(xintercept = 0, linetype = "dashed", color = "gray35") +
labs(
title = "Distribución de residuos del modelo ampliado",
subtitle = "La forma debería aproximarse a una campana centrada en cero",
x = "Residuo",
y = "Densidad"
) +
tema_grafico
plotly::ggplotly(p_hist, tooltip = "text")qq <- qqnorm(datos$Residuo, plot.it = FALSE)
qq_df <- tibble(
teorico = qq$x,
muestra = qq$y,
hover = paste0("Teórico: ", round(qq$x, 3), "<br>Residuo: ", round(qq$y, 3))
)
p_qq <- ggplot(qq_df, aes(x = teorico, y = muestra, text = hover)) +
geom_point(size = 3, color = "#1565C0", alpha = 0.86) +
geom_smooth(method = "lm", se = FALSE, color = "#F28E2B", linewidth = 1) +
labs(
title = "QQ-plot interactivo de residuos",
subtitle = "Puntos cerca de la línea sugieren normalidad de los residuos",
x = "Cuantiles teóricos normales",
y = "Cuantiles muestrales de residuos"
) +
tema_grafico
plotly::ggplotly(p_qq, tooltip = "text")shapiro_res <- shapiro.test(residuals(modelo_ampliado))
shapiro_tbl <- broom::tidy(shapiro_res)
DT::datatable(
shapiro_tbl,
rownames = FALSE,
options = list(dom = "t"),
caption = "Prueba de normalidad de Shapiro-Wilk para los residuos"
) %>%
DT::formatRound(columns = c("statistic", "p.value"), digits = 5)texto_shapiro <- if (shapiro_res$p.value >= alfa) {
paste0("No se rechaza la normalidad de los residuos, porque p = ", fmt_p(shapiro_res$p.value), " es mayor o igual que ", alfa, ".")
} else {
paste0("Se rechaza la normalidad de los residuos, porque p = ", fmt_p(shapiro_res$p.value), " es menor que ", alfa, ". Esto sugiere revisar posibles valores atípicos, transformaciones o confirmar si la conclusión del ANOVA se mantiene por la robustez del diseño balanceado.")
}
cat('<div class="warn-box"><b>Interpretación:</b> ', texto_shapiro, '</div>', sep = "")levene_res <- car::leveneTest(VolSed ~ Grupo, data = datos)
levene_tbl <- as.data.frame(levene_res) %>%
tibble::rownames_to_column("termino")
DT::datatable(
levene_tbl,
rownames = FALSE,
options = list(dom = "t", scrollX = TRUE),
caption = "Test de Levene para igualdad de varianzas entre combinaciones factoriales"
) %>%
DT::formatRound(columns = names(levene_tbl)[sapply(levene_tbl, is.numeric)], digits = 5)cochran_res <- tryCatch(
DescTools::CochranTest(VolSed ~ Grupo, data = datos),
error = function(e1) {
tryCatch(
DescTools::CochranTest(datos$VolSed, datos$Grupo),
error = function(e2) NULL
)
}
)
if (!is.null(cochran_res)) {
cochran_tbl <- broom::tidy(cochran_res)
DT::datatable(
cochran_tbl,
rownames = FALSE,
options = list(dom = "t"),
caption = "Test de Cochran para homogeneidad de varianzas"
) %>%
DT::formatRound(columns = c("statistic", "p.value"), digits = 5)
} else {
cat("No fue posible ejecutar CochranTest con la versión instalada de DescTools. Revisa la instalación del paquete DescTools.")
}## No fue posible ejecutar CochranTest con la versión instalada de DescTools. Revisa la instalación del paquete DescTools.p_res_fit <- ggplot(
datos,
aes(
x = Ajustado,
y = Residuo,
color = Grupo,
text = paste0(
"Corrida: ", Corrida,
"<br>T.Susp: ", TSusp,
"<br>A.Malla: ", AMalla,
"<br>T.Cicla: ", TCicla,
"<br>Ajustado: ", round(Ajustado, 3),
"<br>Residuo: ", round(Residuo, 3)
)
)
) +
geom_hline(yintercept = 0, linetype = "dashed", color = "gray35") +
geom_point(size = 3, alpha = 0.88) +
labs(
title = "Residuos vs valores ajustados",
subtitle = "Una nube sin patrón fuerte favorece el supuesto de varianza constante",
x = "Valor ajustado",
y = "Residuo",
color = "Grupo"
) +
tema_grafico
plotly::ggplotly(p_res_fit, tooltip = "text") %>%
plotly::layout(showlegend = FALSE)# En levene_tbl, la primera fila suele contener el p-valor del factor Grupo.
p_levene <- suppressWarnings(as.numeric(levene_tbl$`Pr(>F)`[1]))
texto_levene <- if (!is.na(p_levene) && p_levene >= alfa) {
paste0("Levene no detecta diferencias significativas de varianza entre grupos, porque p = ", fmt_p(p_levene), ".")
} else if (!is.na(p_levene) && p_levene < alfa) {
paste0("Levene detecta evidencia de varianzas diferentes entre grupos, porque p = ", fmt_p(p_levene), ".")
} else {
"No fue posible leer automáticamente el p-valor de Levene."
}
texto_cochran <- ""
if (!is.null(cochran_res)) {
texto_cochran <- if (cochran_res$p.value >= alfa) {
paste0(" Cochran tampoco detecta una varianza dominante problemática, porque p = ", fmt_p(cochran_res$p.value), ".")
} else {
paste0(" Cochran sugiere que una de las combinaciones podría tener una varianza dominante, porque p = ", fmt_p(cochran_res$p.value), ".")
}
}
cat('<div class="note-box"><b>Interpretación:</b> ', texto_levene, texto_cochran, '</div>', sep = "")dw_res <- lmtest::dwtest(modelo_ampliado)
dw_tbl <- broom::tidy(dw_res)
DT::datatable(
dw_tbl,
rownames = FALSE,
options = list(dom = "t"),
caption = "Test de independencia de Durbin-Watson"
) %>%
DT::formatRound(columns = c("statistic", "p.value"), digits = 5)p_orden <- ggplot(
datos,
aes(
x = Orden,
y = Residuo,
text = paste0(
"Orden: ", Orden,
"<br>Corrida: ", Corrida,
"<br>Residuo: ", round(Residuo, 3),
"<br>Grupo: ", Grupo
)
)
) +
geom_hline(yintercept = 0, linetype = "dashed", color = "gray35") +
geom_line(color = "#1565C0", linewidth = 0.8, alpha = 0.75) +
geom_point(size = 3, color = "#F28E2B") +
labs(
title = "Residuos en el orden de corrida",
subtitle = "Patrones ondulados o secuenciales pueden indicar dependencia",
x = "Orden de observación",
y = "Residuo"
) +
tema_grafico
plotly::ggplotly(p_orden, tooltip = "text")texto_dw <- if (dw_res$p.value >= alfa) {
paste0("No se detecta evidencia estadística de autocorrelación, porque p = ", fmt_p(dw_res$p.value), ".")
} else {
paste0("Se detecta evidencia de autocorrelación, porque p = ", fmt_p(dw_res$p.value), ". Esta conclusión depende de que el orden usado represente el orden real de ejecución experimental.")
}
cat('<div class="warn-box"><b>Interpretación:</b> ', texto_dw, '</div>', sep = "")anova_tbl <- broom::tidy(stats::anova(modelo_ampliado)) %>%
mutate(
termino = limpiar_termino(term),
porcentaje_SS = ifelse(term != "Residuals", 100 * sumsq / sum(sumsq[term != "Residuals"], na.rm = TRUE), NA_real_),
decision = ifelse(!is.na(p.value) & p.value < alfa, "Significativo", "No significativo")
) %>%
select(termino, df, sumsq, meansq, statistic, p.value, porcentaje_SS, decision)
DT::datatable(
anova_tbl,
rownames = FALSE,
options = list(pageLength = 10, scrollX = TRUE),
caption = "Tabla ANOVA del modelo ampliado factorial completo"
) %>%
DT::formatRound(columns = c("sumsq", "meansq", "statistic", "porcentaje_SS"), digits = 4) %>%
DT::formatSignif(columns = "p.value", digits = 4)# ANOVA tipo III con contrastes de suma. Es útil para modelos con interacciones.
anova_tipo3 <- as.data.frame(car::Anova(modelo_ampliado, type = 3)) %>%
tibble::rownames_to_column("termino") %>%
mutate(termino = limpiar_termino(termino))
DT::datatable(
anova_tipo3,
rownames = FALSE,
options = list(pageLength = 12, scrollX = TRUE),
caption = "ANOVA tipo III del modelo ampliado"
) %>%
DT::formatRound(columns = names(anova_tipo3)[sapply(anova_tipo3, is.numeric)], digits = 5)sig_terms <- anova_tbl %>%
filter(termino != "Error", !is.na(p.value), p.value < alfa) %>%
arrange(p.value)
if (nrow(sig_terms) == 0) {
texto_anova <- "Ningún término del modelo resultó significativo al 5 %. En ese caso, la decisión práctica debe apoyarse más en las medias observadas y en criterios técnicos del proceso."
} else {
texto_anova <- paste0(
"Los términos significativos al 5 % son: ",
paste0(sig_terms$termino, " (p = ", fmt_p(sig_terms$p.value), ")", collapse = "; "),
". Estos términos explican diferencias relevantes en el volumen de sedimentación."
)
}
cat('<div class="good-box"><b>Interpretación ANOVA:</b> ', texto_anova, '</div>', sep = "")Como los predictores son categóricos, la estandarización se realiza sobre la variable de respuesta. Los coeficientes indican cambios relativos en desviaciones estándar del volumen de sedimentación respecto a los contrastes del modelo.
datos_std <- datos %>%
mutate(VolSed_z = as.numeric(scale(VolSed)))
modelo_std <- lm(VolSed_z ~ TSusp * AMalla * TCicla, data = datos_std)
coef_std <- broom::tidy(modelo_std, conf.int = TRUE) %>%
filter(term != "(Intercept)") %>%
mutate(
termino = limpiar_termino(term),
abs_beta = abs(estimate),
decision = ifelse(!is.na(p.value) & p.value < alfa, "Significativo", "No significativo")
) %>%
arrange(desc(abs_beta)) %>%
select(termino, beta_estandarizado = estimate, abs_beta, std.error, statistic, p.value, conf.low, conf.high, decision)
DT::datatable(
coef_std,
rownames = FALSE,
options = list(pageLength = 12, scrollX = TRUE),
caption = "Coeficientes estandarizados del modelo ampliado"
) %>%
DT::formatRound(columns = c("beta_estandarizado", "abs_beta", "std.error", "statistic", "conf.low", "conf.high"), digits = 4) %>%
DT::formatSignif(columns = "p.value", digits = 4)coef_std_plot <- coef_std %>%
mutate(
termino = factor(termino, levels = rev(termino)),
hover = paste0(
"Término: ", termino,
"<br>Beta estandarizado: ", round(beta_estandarizado, 4),
"<br>|Beta|: ", round(abs_beta, 4),
"<br>p: ", fmt_p(p.value),
"<br>Decisión: ", decision
)
)
p_beta <- ggplot(coef_std_plot, aes(x = termino, y = abs_beta, fill = decision, text = hover)) +
geom_col(width = 0.72, color = "white") +
coord_flip() +
scale_fill_manual(values = c("Significativo" = "#00A676", "No significativo" = "#B0BEC5")) +
labs(
title = "Magnitud de coeficientes estandarizados",
subtitle = "Ordenados por importancia relativa absoluta",
x = "Término del modelo",
y = "|Beta estandarizado|",
fill = "Decisión"
) +
tema_grafico
plotly::ggplotly(p_beta, tooltip = "text")pareto_anova <- anova_tbl %>%
filter(termino != "Error") %>%
arrange(desc(porcentaje_SS)) %>%
mutate(
acumulado = cumsum(porcentaje_SS),
termino = factor(termino, levels = termino),
hover = paste0(
"Término: ", termino,
"<br>% SS: ", round(porcentaje_SS, 2), "%",
"<br>% acumulado: ", round(acumulado, 2), "%",
"<br>F: ", round(statistic, 3),
"<br>p: ", fmt_p(p.value)
)
)
plotly::plot_ly(
data = pareto_anova,
x = ~termino,
y = ~porcentaje_SS,
type = "bar",
name = "% suma de cuadrados",
text = ~hover,
hoverinfo = "text",
marker = list(color = "#1565C0")
) %>%
plotly::add_trace(
y = ~acumulado,
type = "scatter",
mode = "lines+markers",
name = "% acumulado",
yaxis = "y2",
text = ~hover,
hoverinfo = "text",
line = list(color = "#F28E2B", width = 3),
marker = list(size = 8, color = "#F28E2B")
) %>%
plotly::layout(
title = list(text = "Pareto interactivo de efectos por contribución ANOVA"),
xaxis = list(title = "Término", tickangle = -35),
yaxis = list(title = "% de suma de cuadrados", rangemode = "tozero"),
yaxis2 = list(
title = "% acumulado",
overlaying = "y",
side = "right",
rangemode = "tozero"
),
legend = list(orientation = "h", x = 0.05, y = -0.25),
margin = list(b = 120)
)top_pareto <- pareto_anova %>% slice(1)
cat(
'<div class="good-box">',
'<b>Interpretación del Pareto:</b> El término con mayor contribución a la variabilidad explicada es <b>',
as.character(top_pareto$termino),
'</b>, con aproximadamente <b>', round(top_pareto$porcentaje_SS, 2),
'%</b> de la suma de cuadrados explicada por los tratamientos. ',
'Los primeros términos del Pareto deben ser priorizados al elegir las condiciones de operación para reducir el volumen de sedimentación.',
'</div>',
sep = ""
)medias_interaccion <- datos %>%
group_by(TSusp, AMalla, TCicla) %>%
summarise(
n = n(),
media = mean(VolSed, na.rm = TRUE),
sd = sd(VolSed, na.rm = TRUE),
se = sd / sqrt(n),
ic95 = qt(0.975, df = n - 1) * se,
.groups = "drop"
) %>%
mutate(
hover = paste0(
"T.Susp: ", TSusp,
"<br>A.Malla: ", AMalla,
"<br>T.Cicla: ", TCicla,
"<br>Media: ", round(media, 3),
"<br>IC95: ±", round(ic95, 3),
"<br>SD: ", round(sd, 3),
"<br>n: ", n
)
)p_int_1 <- ggplot(
medias_interaccion,
aes(x = TSusp, y = media, color = AMalla, group = AMalla, text = hover)
) +
geom_line(linewidth = 1.2) +
geom_point(size = 4) +
geom_errorbar(aes(ymin = media - ic95, ymax = media + ic95), width = 0.08, linewidth = 0.8) +
facet_wrap(~ TCicla) +
labs(
title = "Interacción T.Susp × A.Malla",
subtitle = "Líneas no paralelas sugieren interacción entre el tipo de suspensión y la abertura de malla",
x = "Tipo de suspensión (T.Susp)",
y = "Volumen promedio de sedimentación",
color = "A.Malla"
) +
tema_grafico
plotly::ggplotly(p_int_1, tooltip = "text")p_int_2 <- ggplot(
medias_interaccion,
aes(x = TSusp, y = media, color = TCicla, group = TCicla, text = hover)
) +
geom_line(linewidth = 1.2) +
geom_point(size = 4) +
geom_errorbar(aes(ymin = media - ic95, ymax = media + ic95), width = 0.08, linewidth = 0.8) +
facet_wrap(~ AMalla) +
labs(
title = "Interacción T.Susp × T.Cicla",
subtitle = "Permite observar si el efecto de la temperatura de ciclaje cambia según el tipo de suspensión",
x = "Tipo de suspensión (T.Susp)",
y = "Volumen promedio de sedimentación",
color = "T.Cicla"
) +
tema_grafico
plotly::ggplotly(p_int_2, tooltip = "text")p_int_3 <- ggplot(
medias_interaccion,
aes(x = AMalla, y = media, color = TCicla, group = TCicla, text = hover)
) +
geom_line(linewidth = 1.2) +
geom_point(size = 4) +
geom_errorbar(aes(ymin = media - ic95, ymax = media + ic95), width = 0.08, linewidth = 0.8) +
facet_wrap(~ TSusp) +
labs(
title = "Interacción A.Malla × T.Cicla",
subtitle = "Ayuda a decidir la abertura de malla considerando cada nivel de temperatura de ciclaje",
x = "Abertura de malla (A.Malla)",
y = "Volumen promedio de sedimentación",
color = "T.Cicla"
) +
tema_grafico
plotly::ggplotly(p_int_3, tooltip = "text")interacciones_sig <- anova_tbl %>%
filter(grepl(":", termino), !is.na(p.value), p.value < alfa) %>%
arrange(p.value)
if (nrow(interacciones_sig) > 0) {
texto_interacciones <- paste0(
"Las interacciones significativas son: ",
paste0(interacciones_sig$termino, " (p = ", fmt_p(interacciones_sig$p.value), ")", collapse = "; "),
". Cuando una interacción es significativa, no conviene interpretar los factores de forma aislada; se debe analizar la combinación de niveles."
)
} else {
texto_interacciones <- "No se detectaron interacciones significativas al 5 %. En ese caso, los efectos principales pueden interpretarse con mayor claridad."
}
cat('<div class="note-box"><b>Interpretación de interacciones:</b> ', texto_interacciones, '</div>', sep = "")datos_3d <- datos %>%
mutate(
TSusp_num = as.numeric(TSusp),
AMalla_num = as.numeric(AMalla),
TCicla_num = as.numeric(TCicla),
hover_3d = paste0(
"Corrida: ", Corrida,
"<br>T.Susp: ", TSusp,
"<br>A.Malla: ", AMalla,
"<br>T.Cicla: ", TCicla,
"<br>Vol.Sedimentacion: ", VolSed
)
)
plotly::plot_ly(
data = datos_3d,
x = ~TSusp_num,
y = ~AMalla_num,
z = ~VolSed,
color = ~TCicla,
colors = c("#1565C0", "#F28E2B"),
type = "scatter3d",
mode = "markers",
marker = list(size = 5, opacity = 0.86),
text = ~hover_3d,
hoverinfo = "text"
) %>%
plotly::layout(
title = "Nube 3D interactiva del diseño factorial",
scene = list(
xaxis = list(title = "T.Susp", tickvals = c(1, 2, 3), ticktext = c("A1", "A2", "A3")),
yaxis = list(title = "A.Malla", tickvals = c(1, 2), ticktext = c("B1", "B2")),
zaxis = list(title = "Vol.Sedimentacion")
),
legend = list(orientation = "h", x = 0.05, y = -0.05)
)emm_combinaciones <- emmeans::emmeans(modelo_ampliado, ~ TSusp * AMalla * TCicla)
emm_tbl <- as.data.frame(emm_combinaciones) %>%
arrange(emmean) %>%
mutate(
ranking = row_number(),
combinacion = paste("T.Susp", TSusp, "| A.Malla", AMalla, "| T.Cicla", TCicla)
) %>%
select(ranking, combinacion, TSusp, AMalla, TCicla, emmean, SE, df, lower.CL, upper.CL)
DT::datatable(
emm_tbl,
rownames = FALSE,
options = list(pageLength = 12, scrollX = TRUE),
caption = "Medias marginales estimadas por combinación, ordenadas para minimizar Vol.Sedimentacion"
) %>%
DT::formatRound(columns = c("emmean", "SE", "df", "lower.CL", "upper.CL"), digits = 4)emm_plot <- emm_tbl %>%
mutate(
combinacion = factor(combinacion, levels = combinacion),
hover = paste0(
"Ranking: ", ranking,
"<br>", combinacion,
"<br>Media estimada: ", round(emmean, 3),
"<br>IC95: [", round(lower.CL, 3), ", ", round(upper.CL, 3), "]"
)
)
p_emm <- ggplot(emm_plot, aes(x = combinacion, y = emmean, fill = emmean, text = hover)) +
geom_col(color = "white", width = 0.72) +
geom_errorbar(aes(ymin = lower.CL, ymax = upper.CL), width = 0.18, color = "gray20") +
coord_flip() +
scale_fill_viridis_c(option = "C", direction = -1) +
labs(
title = "Medias marginales estimadas por combinación",
subtitle = "La primera barra corresponde a la condición estimada más favorable para minimizar la respuesta",
x = "Combinación",
y = "Media marginal estimada",
fill = "Media"
) +
tema_grafico
plotly::ggplotly(p_emm, tooltip = "text")mejor_emm <- emm_tbl %>% slice(1)
segundo_emm <- emm_tbl %>% slice(2)
factor_top <- pareto_anova %>% slice(1)
texto_normalidad <- if (shapiro_res$p.value >= alfa) {
"El supuesto de normalidad no muestra evidencia de incumplimiento con Shapiro-Wilk."
} else {
"El supuesto de normalidad muestra evidencia de incumplimiento con Shapiro-Wilk; por tanto, conviene revisar residuos atípicos o considerar una transformación si el curso lo exige."
}
texto_varianzas <- if (!is.na(p_levene) && p_levene >= alfa) {
"El supuesto de homocedasticidad es razonable según Levene."
} else {
"La homocedasticidad debe revisarse, porque Levene sugiere diferencias de varianza."
}
cat(
'<div class="good-box">',
'<b>Conclusión orientada a minimizar Vol.Sedimentacion:</b><br><br>',
'1. La condición estimada con menor volumen de sedimentación es <b>', mejor_emm$combinacion, '</b>, con media estimada de <b>', round(mejor_emm$emmean, 3), '</b>.<br>',
'2. La segunda mejor condición es <b>', segundo_emm$combinacion, '</b>, con media estimada de <b>', round(segundo_emm$emmean, 3), '</b>.<br>',
'3. El término con mayor aporte en el Pareto es <b>', as.character(factor_top$termino), '</b>, con aproximadamente <b>', round(factor_top$porcentaje_SS, 2), '%</b> de la suma de cuadrados de tratamientos.<br>',
'4. ', texto_normalidad, '<br>',
'5. ', texto_varianzas, '<br><br>',
'<b>Recomendación:</b> si la condición óptima es viable técnica y económicamente, debe priorizarse para reducir el volumen de sedimentación. Si existen restricciones operativas, compare la condición óptima con la segunda mejor usando los intervalos de confianza y el contexto del proceso.',
'</div>',
sep = ""
)Para explicar el diseño a estudiantes, la lectura sugerida es esta: primero se observa el ranking de combinaciones, luego el mapa de calor para ubicar visualmente dónde se minimiza la respuesta, después se valida el modelo con residuos y pruebas de supuestos, y finalmente se usa ANOVA + Pareto para justificar estadísticamente qué factores o interacciones gobiernan el comportamiento del volumen de sedimentación.