Experimento Factorial Completo 2^4
Modelo Depurado y Optimizado - Tiempo de conteo manual
Sofía Orozco, Katherine Pascasio, Abigail Rivera, Camila Sibaja, Fiorella Monge
08 de June del 2026
1 Datos y álgebra matricial
# ------------------------------------------------------------------
# Datos del experimento (32 corridas, diseño factorial completo 2^4
# con 2 réplicas). Los datos están en el orden de ejecución.
# A = Tipo de etiquetas
# B = Política de disposición de almacenamiento
# C = Tipo de conteo
# D = Manipulación manual
# y = Tiempo de conteo (s)
# NOTA: el factor A se depuró en Minitab (no significativo) y por eso
# NO se incluye en la matriz del modelo; se conserva la columna
# solo como referencia.
# ------------------------------------------------------------------
datos_raw <- data.frame(
corrida = 1:32,
A = c( 1,-1, 1,-1, 1, 1,-1,-1, 1, 1,
1, 1,-1,-1,-1,-1,-1,-1, 1,-1,
1, 1, 1, 1, 1, 1,-1,-1, 1,-1,
-1,-1),
B = c(-1, 1, 1, 1,-1,-1, 1, 1, 1,-1,
-1, 1, 1, 1,-1,-1,-1,-1, 1, 1,
1,-1,-1, 1,-1, 1,-1,-1, 1, 1,
-1,-1),
C = c( 1,-1, 1,-1, 1,-1, 1, 1, 1,-1,
1,-1, 1, 1,-1,-1, 1, 1, 1,-1,
-1,-1,-1,-1, 1, 1, 1,-1,-1,-1,
1,-1),
D = c( 1,-1,-1, 1,-1, 1, 1,-1, 1,-1,
1,-1,-1, 1,-1,-1, 1,-1,-1, 1,
-1, 1,-1, 1,-1, 1, 1, 1, 1,-1,
-1, 1),
y = c(50.23,37.38,40.73,34.61,42.14,39.63,38.19,39.10,37.08,52.39,
48.23,36.88,39.52,39.38,48.30,50.75,46.93,45.08,37.60,31.26,
36.16,42.61,47.11,32.95,40.95,37.87,42.82,43.43,31.11,35.18,
40.81,42.25)
)
# Vectores de factores (en orden de ejecución)
y_vec <- datos_raw$y
n <- length(y_vec)
A_r <- datos_raw$A; B_r <- datos_raw$B
C_r <- datos_raw$C; D_r <- datos_raw$D
# ------------------------------------------------------------------
# MATRIZ DEL MODELO DEPURADO (definido en Minitab)
# Términos: B, C, D, B*C, B*D, C*D, B*C*D (el factor A se excluye)
# ------------------------------------------------------------------
X <- cbind(
I = 1,
B = B_r,
C = C_r,
D = D_r,
BC = B_r * C_r,
BD = B_r * D_r,
CD = C_r * D_r,
BCD = B_r * C_r * D_r)
# Álgebra matricial
XtX <- t(X) %*% X
Xty <- t(X) %*% y_vec
beta_hat <- solve(XtX) %*% Xty
efectos <- 2 * beta_hat
y_grand <- mean(y_vec)
SC_total <- sum((y_vec - y_grand)^2)
gl_error <- n - ncol(X)
contrastes <- as.vector(Xty)[-1]
nombres_ef <- rownames(beta_hat)[-1]
SC_ef <- contrastes^2 / n
SC_error <- SC_total - sum(SC_ef)
CM_error <- SC_error / gl_error
y_hat <- X %*% beta_hat
residuos <- y_vec - y_hat
F_vals <- SC_ef / CM_error
p_vals <- pf(F_vals, 1, gl_error, lower.tail = FALSE)
EE_coef <- sqrt(CM_error / n)
T_vals <- as.vector(beta_hat)[-1] / EE_coef
T_const <- as.vector(beta_hat)[1] / EE_coef
R2_full <- 1 - SC_error / SC_total
R2_adj_full <- 1 - (SC_error/gl_error) / (SC_total/(n-1))
H <- X %*% solve(XtX) %*% t(X)
press <- sum(((y_vec - y_hat) / (1 - diag(H)))^2)
R2_pred <- 1 - press / SC_total
# Nombres legibles de los factores
letras <- c(
"A" = "Tipo de etiquetas",
"B" = "Disposici\u00f3n de almacenamiento",
"C" = "Tipo de conteo",
"D" = "Manipulaci\u00f3n manual"
)
expandir <- function(codigo) {
paste(letras[strsplit(codigo, "")[[1]]], collapse = " * ")
}
nombres_leg <- sapply(nombres_ef, expandir, USE.NAMES = FALSE)
betas_ef <- as.vector(beta_hat)[-1]
efectos_ef <- as.vector(efectos)[-1]
sig <- function(p) ifelse(p<0.001,"***",ifelse(p<0.01,"**",
ifelse(p<0.05,"*", ifelse(p<0.10,".",""))))
# ------------------------------------------------------------------
# Supuestos: Shapiro-Wilk (normalidad) + Durbin-Watson (independencia)
# ------------------------------------------------------------------
sw <- shapiro.test(residuos) # base R: $statistic = W, $p.value
dw <- sum(diff(residuos)^2) / sum(residuos^2)
h_ii <- diag(H)
resid_est <- as.vector(residuos) / (sqrt(CM_error) * sqrt(1 - h_ii))2 Coeficientes codificados
pv_todos <- c(
pf(T_const^2, 1, gl_error, lower.tail=FALSE),
sapply(T_vals, function(t) pf(t^2, 1, gl_error, lower.tail=FALSE)))
coef_df <- data.frame(
Termino = c("Constante", nombres_leg),
Efecto = c("—", sprintf("%.3f", efectos_ef)),
Coef = sprintf("%.3f", c(as.vector(beta_hat)[1], betas_ef)),
EEcoef = sprintf("%.3f", rep(EE_coef, length(beta_hat))),
ValorT = sprintf("%.2f", c(T_const, T_vals)),
Valorp = sprintf("%.4f", pv_todos),
FIV = c("—", rep("1.00", length(betas_ef))),
Sig = sig(pv_todos),
stringsAsFactors = FALSE)
kable(coef_df, escape = FALSE,
caption = "Coeficientes codificados del modelo depurado",
col.names = c("T\u00e9rmino","Efecto","Coef.","EE del coef.",
"Valor T","Valor p","FIV",""),
align = c("l","r","r","r","r","r","c","c")) |>
kable_styling(bootstrap_options = "condensed",
full_width = TRUE, font_size = 13) |>
row_spec(0, background = "#b5728f", color = "white", bold = TRUE) |>
footnote(general = paste0("*** p < 0.001 ",
"** p < 0.01 ",
"* p < 0.05 ",
". p < 0.10"),
escape = FALSE)| Término | Efecto | Coef. | EE del coef. | Valor T | Valor p | FIV | |
|---|---|---|---|---|---|---|---|
| Constante | — | 40.896 | 0.332 | 123.01 | 0.0000 | — | *** |
| Disposición de almacenamiento | -8.666 | -4.333 | 0.332 | -13.03 | 0.0000 | 1.00 | *** |
| Tipo de conteo | 1.541 | 0.771 | 0.332 | 2.32 | 0.0293 | 1.00 |
|
| Manipulación manual | -1.969 | -0.984 | 0.332 | -2.96 | 0.0068 | 1.00 | ** |
| Disposición de almacenamiento * Tipo de conteo | 2.701 | 1.351 | 0.332 | 4.06 | 0.0004 | 1.00 | *** |
| Disposición de almacenamiento * Manipulación manual | -0.544 | -0.272 | 0.332 | -0.82 | 0.4215 | 1.00 | |
| Tipo de conteo * Manipulación manual | 3.819 | 1.909 | 0.332 | 5.74 | 0.0000 | 1.00 | *** |
| Disposición de almacenamiento * Tipo de conteo * Manipulación manual | -2.414 | -1.207 | 0.332 | -3.63 | 0.0013 | 1.00 | ** |
| Note: | |||||||
| *** p < 0.001 ** p < 0.01 * p < 0.05 . p < 0.10 |
3 Resumen del modelo
res_df <- data.frame(
S = round(sqrt(CM_error), 5),
Rcuadrado = paste0(round(R2_full*100, 2), "%"),
Rcuadrado_aj = paste0(round(R2_adj_full*100, 2), "%"),
Rcuadrado_pred = paste0(round(R2_pred*100, 2), "%"),
stringsAsFactors = FALSE)
kable(res_df,
caption = "Resumen del modelo factorial depurado",
col.names = c("S","R-cuadrado",
"R-cuadrado (ajustado)","R-cuadrado (pred)"),
align = "cccc") |>
kable_styling(bootstrap_options = "condensed",
full_width = FALSE) |>
row_spec(0, background = "#b5728f", color = "white", bold = TRUE)| S | R-cuadrado | R-cuadrado (ajustado) | R-cuadrado (pred) |
|---|---|---|---|
| 1.88067 | 91.16% | 88.58% | 84.28% |
4 Análisis de varianza (ANOVA)
SC_modelo <- sum(SC_ef)
grupos <- list()
idx_1 <- which(nchar(nombres_ef) == 1)
idx_2 <- which(nchar(nombres_ef) == 2)
idx_3 <- which(nchar(nombres_ef) == 3)
idx_4 <- which(nchar(nombres_ef) == 4)
if(length(idx_1) > 0) grupos[[length(grupos)+1]] <- list(n="Lineal", idx=idx_1, gl=length(idx_1))
if(length(idx_2) > 0) grupos[[length(grupos)+1]] <- list(n="Interacciones de 2 t\u00e9rminos", idx=idx_2, gl=length(idx_2))
if(length(idx_3) > 0) grupos[[length(grupos)+1]] <- list(n="Interacciones de 3 t\u00e9rminos", idx=idx_3, gl=length(idx_3))
if(length(idx_4) > 0) grupos[[length(grupos)+1]] <- list(n="Interacciones de 4 t\u00e9rminos", idx=idx_4, gl=length(idx_4))
filas <- list(); tipo <- c()
filas[[1]] <- c("Modelo", length(betas_ef), round(SC_modelo,2),
round(SC_modelo/length(betas_ef),3),
round((SC_modelo/length(betas_ef))/CM_error,2), "", "")
tipo <- c(tipo, "modelo")
for (g in grupos) {
SC_g <- sum(SC_ef[g$idx]); CM_g <- SC_g / g$gl
filas[[length(filas)+1]] <- c(
paste0("\u00a0\u00a0", g$n), g$gl,
round(SC_g,2), round(CM_g,3), round(CM_g/CM_error,2), "", "")
tipo <- c(tipo, "grupo")
for (i in g$idx) {
filas[[length(filas)+1]] <- c(
paste0("\u00a0\u00a0\u00a0\u00a0", nombres_leg[i]), 1,
round(SC_ef[i],2), round(SC_ef[i],3),
round(F_vals[i],2), round(p_vals[i],4), sig(p_vals[i]))
tipo <- c(tipo, "efecto")
}
}
filas[[length(filas)+1]] <- c("Error", gl_error,
round(SC_error,2), round(CM_error,3), "", "", "")
tipo <- c(tipo, "error")
filas[[length(filas)+1]] <- c("Total", n-1,
round(SC_total,2), "", "", "", "")
tipo <- c(tipo, "total")
anova_df <- as.data.frame(do.call(rbind,filas), stringsAsFactors=FALSE)
names(anova_df) <- c("Fuente","GL","SC Ajust.","MC Ajust.",
"Valor F","Valor p","Sig")
idx_negrita <- which(tipo %in% c("modelo", "grupo", "error", "total"))
kable(anova_df, escape = FALSE,
caption = "An\u00e1lisis de varianza \u2014 Modelo factorial depurado",
align = c("l","c","r","r","r","r","c")) |>
kable_styling(bootstrap_options = "condensed",
full_width = TRUE, font_size = 13) |>
row_spec(0, background = "#b5728f", color="white", bold=TRUE) |>
row_spec(idx_negrita, bold=TRUE) |>
footnote(general = paste0("*** p < 0.001 ",
"** p < 0.01 ",
"* p < 0.05 ",
". p < 0.10"),
escape = FALSE)| Fuente | GL | SC Ajust. | MC Ajust. | Valor F | Valor p | Sig |
|---|---|---|---|---|---|---|
| Modelo | 7 | 874.85 | 124.979 | 35.34 | ||
| Lineal | 3 | 650.84 | 216.948 | 61.34 | ||
| Disposición de almacenamiento | 1 | 600.83 | 600.831 | 169.87 | 0 | *** |
| Tipo de conteo | 1 | 19 | 19.004 | 5.37 | 0.0293 |
|
| Manipulación manual | 1 | 31.01 | 31.008 | 8.77 | 0.0068 | ** |
| Interacciones de 2 términos | 3 | 177.4 | 59.134 | 16.72 | ||
| Disposición de almacenamiento * Tipo de conteo | 1 | 58.37 | 58.374 | 16.5 | 4e-04 | *** |
| Disposición de almacenamiento * Manipulación manual | 1 | 2.37 | 2.365 | 0.67 | 0.4215 | |
| Tipo de conteo * Manipulación manual | 1 | 116.66 | 116.663 | 32.98 | 0 | *** |
| Interacciones de 3 términos | 1 | 46.61 | 46.61 | 13.18 | ||
| Disposición de almacenamiento * Tipo de conteo * Manipulación manual | 1 | 46.61 | 46.61 | 13.18 | 0.0013 | ** |
| Error | 24 | 84.89 | 3.537 | |||
| Total | 31 | 959.74 | ||||
| Note: | ||||||
| *** p < 0.001 ** p < 0.01 * p < 0.05 . p < 0.10 |
5 Ecuación de regresión en unidades codificadas
Tiempo (s) =
40.8956
- 4.3331 ×
B
+ 0.7706 × C
- 0.9844 ×
D
+ 1.3506 × BC
- 0.2719 ×
BD
+ 1.9094 × CD
- 1.2069 ×
BCD
Factores codificados: -1 = nivel bajo, +1 =
nivel alto.
B = Disposición de almacenamiento, C = Tipo de conteo, D
= Manipulación manual.
BC, BD, CD y BCD
denotan interacciones.
El término B*D se conserva por el principio
de jerarquía aunque no es significativo (p ≈ 0,42).
6 Ajustes y diagnósticos para observaciones poco comunes
p_vars <- ncol(X)
cooks_d <- as.vector((residuos^2 / (p_vars * CM_error)) * (h_ii / (1 - h_ii)^2))
umbral_cook <- 4 / n
poco_idx <- which(abs(resid_est) > 2 | cooks_d > umbral_cook)
tipo_obs <- sapply(poco_idx, function(i) {
t <- c()
if (abs(resid_est[i]) > 2) t <- c(t, "R")
if (cooks_d[i] > umbral_cook) t <- c(t, "C")
paste(t, collapse = ", ")
})
pc_df <- data.frame(
Obs = poco_idx,
Tiempos = round(y_vec[poco_idx], 2),
Ajuste = round(as.vector(y_hat)[poco_idx], 2),
Resid = round(as.vector(residuos)[poco_idx], 2),
Residest = round(resid_est[poco_idx], 2),
Cook = round(cooks_d[poco_idx], 4),
Tipo = tipo_obs,
stringsAsFactors = FALSE)
kable(pc_df,
caption = "Ajustes y diagn\u00f3sticos para observaciones poco comunes",
col.names = c("Obs","Tiempo (s)","Ajuste","Resid.",
"Resid. est.","Dist. Cook","Tipo"),
align = c("c","r","r","r","r","r","c")) |>
kable_styling(bootstrap_options = "condensed", full_width = FALSE) |>
row_spec(0, background = "#b5728f", color = "white", bold = TRUE) |>
footnote(general = paste0("R = Residuo grande (|Resid. est.| > 2)<br>",
"C = Distancia de Cook alta (D > ", round(umbral_cook, 4), ")"),
escape = FALSE)| Obs | Tiempo (s) | Ajuste | Resid. | Resid. est. | Dist. Cook | Tipo |
|---|---|---|---|---|---|---|
| 1 | 50.23 | 47.05 | 3.18 | 1.95 | 0.1586 | C |
| 18 | 45.08 | 42.25 | 2.83 | 1.74 | 0.1262 | C |
| 27 | 42.82 | 47.05 | -4.23 | -2.60 | 0.2814 | R, C |
| Note: | ||||||
|
R = Residuo grande (|Resid. est.| > 2) C = Distancia de Cook alta (D > 0.125) |
# Prueba de Grubbs (residuo más extremo)
res_max_idx <- which.max(abs(residuos))
res_max_val <- residuos[res_max_idx]
G_stat <- abs(res_max_val - mean(residuos)) / sd(residuos)
# Valor crítico de Grubbs
t_crit <- qt(1 - 0.05 / (2 * n), n - 2)
G_crit <- ((n - 1) / sqrt(n)) * sqrt(t_crit^2 / (n - 2 + t_crit^2))
grubbs_df <- data.frame(
Prueba = "Grubbs (Un extremo)",
Max_Obs = res_max_idx,
Estadistico_G = round(G_stat, 4),
Valor_Critico = round(G_crit, 4),
Conclusion = ifelse(G_stat > G_crit,
"Se rechaza H0: Valor at\u00edpico detectado.",
"No se rechaza H0: No hay evidencia de valores at\u00edpicos.")
)
kable(grubbs_df,
caption = "Prueba formal de Grubbs para el residuo m\u00e1s extremo",
col.names = c("Prueba","Obs. m\u00e1s extrema","Estad\u00edstico G",
"Valor Cr\u00edtico (\u03b1=0.05)","Conclusi\u00f3n"),
align = c("l","c","c","c","l")) |>
kable_styling(bootstrap_options = "condensed", full_width = TRUE) |>
row_spec(0, background = "#b5728f", color = "white", bold = TRUE)| Prueba | Obs. más extrema | Estadístico G | Valor Crítico (α=0.05) | Conclusión |
|---|---|---|---|---|
| Grubbs (Un extremo) | 27 | 2.5578 | 2.938 | No se rechaza H0: No hay evidencia de valores atípicos. |
7 Verificación de supuestos
sup_df <- data.frame(
Supuesto = c("Normalidad de residuos",
"Independencia de residuos"),
Prueba = c("Shapiro-Wilk",
"Durbin-Watson"),
Estadistico = c(unname(round(sw$statistic, 4)), round(dw, 4)),
Valorp = c(round(sw$p.value, 4), "---"),
Conclusion = c(
ifelse(sw$p.value > 0.05,
"No se rechaza H\u2080 \u2014 residuos normales",
"Se rechaza H\u2080 \u2014 residuos no normales"),
ifelse(dw > 1.5 & dw < 2.5,
"No hay evidencia de autocorrelaci\u00f3n",
"Posible autocorrelaci\u00f3n, revisar")),
stringsAsFactors = FALSE)
kable(sup_df,
caption = "Verificaci\u00f3n de supuestos del modelo",
col.names = c("Supuesto","Prueba","Estad\u00edstico",
"Valor p","Conclusi\u00f3n"),
align = c("l","l","c","c","l")) |>
kable_styling(bootstrap_options = "condensed",
full_width = TRUE) |>
row_spec(0, background = "#b5728f", color = "white", bold = TRUE) |>
column_spec(5, width = "30%")| Supuesto | Prueba | Estadístico | Valor p | Conclusión |
|---|---|---|---|---|
| Normalidad de residuos | Shapiro-Wilk | 0.9800 | 0.7984 | No se rechaza H₀ — residuos normales |
| Independencia de residuos | Durbin-Watson | 1.9744 | — | No hay evidencia de autocorrelación |
8 Análisis Gráfico (Medias Ajustadas)
8.1 Gráficas de Efectos Principales
# Lista de factores indexable por letra (A en posición 1 aunque no esté
# en el modelo, para que las gráficas de interacción puedan ubicarlo).
factores <- list(A_r, B_r, C_r, D_r)
nombres_f <- c("A: Tipo de etiquetas", "B: Disposición de almacenamiento",
"C: Tipo de conteo", "D: Manipulación manual")
# Solo se grafican los factores presentes en el modelo depurado: B, C, D
idx_modelo <- c(2, 3, 4)
par(mfrow=c(1,3), mar=c(4.5, 4.5, 3, 1), oma=c(0,0,2,0))
for(i in idx_modelo) {
medias <- tapply(y_hat, factores[[i]], mean)
plot(c(-1, 1), medias, type="b", pch=19, col=COL_PPAL, lwd=2.5,
xaxt="n", xlab=nombres_f[i], ylab="Media Ajustada (s)",
main=nombres_f[i], cex.main=1.05, col.main=COL_LINEA)
axis(1, at=c(-1,1), labels=c("-1", "1"))
abline(h=mean(y_hat), lty=2, col="gray60")
}
mtext("Gráficas de Efectos Principales (Medias Ajustadas)", outer=TRUE, cex=1.2, font=2, col=COL_LINEA)
Efectos Principales para Tiempo (s) - Medias Ajustadas
8.2 Gráficas de Interacción
par(mfrow=c(1,3), mar=c(4, 4.5, 3, 1), oma=c(0,0,2,0))
# Interacciones dobles incluidas en el modelo: BC, BD, CD
nombres_dobles <- nombres_ef[nchar(nombres_ef) == 2]
for(term in nombres_dobles) {
letras_idx <- match(strsplit(term, "")[[1]], names(letras))
f1 <- factores[[ letras_idx[1] ]]
f2 <- factores[[ letras_idx[2] ]]
interaction.plot(x.factor = f1, trace.factor = f2, response = y_hat,
fun = mean, type = "b", col = c(COL_CLARO, COL_LINEA),
pch = c(19, 17), lwd = 2.5, trace.label = nombres_f[letras_idx[2]],
xlab = nombres_f[letras_idx[1]], ylab = "Media Ajustada (s)",
main = paste(substr(nombres_f[letras_idx[1]],1,1), "*",
substr(nombres_f[letras_idx[2]],1,1)),
col.main=COL_LINEA, leg.bty="n")
}
mtext("Gráficas de Interacción (Medias Ajustadas)", outer=TRUE, cex=1.2, font=2, col=COL_LINEA)
Interacciones dobles para Tiempo (s) - Medias Ajustadas
8.3 Gráfica de Cubo
# El modelo depurado contiene B, C y D -> un único cubo de 3 factores.
# Eje X (horizontal) = B (Disposición)
# Eje Y (vertical) = C (Tipo de conteo)
# Profundidad = D (Manipulación manual)
off <- 0.45
par(mar=c(2,2,4,2))
plot(0,0, type="n", xlim=c(-0.25, 1.75), ylim=c(-0.25, 1.75), axes=FALSE,
xlab="", ylab="",
main="Gráfica de cubo (medias ajustadas) para Tiempo (s)",
col.main=COL_LINEA, cex.main=1.2)
# Aristas del cubo
rect(0, 0, 1, 1, border=COL_LINEA, lwd=1.6) # cara frontal (D = -1)
rect(off, off, 1+off, 1+off, border=COL_LINEA, lwd=1.6) # cara trasera (D = +1)
segments(c(0,1,0,1), c(0,0,1,1),
c(off,1+off,off,1+off), c(off,off,1+off,1+off),
col=COL_LINEA, lwd=1.6)
# Vértices con la media ajustada
for(d_val in c(-1, 1)) {
for(c_val in c(-1, 1)) {
for(b_val in c(-1, 1)) {
comb <- c(B = b_val, C = c_val, D = d_val)
x_vec_dyn <- c(1, sapply(nombres_ef, function(term) {
prod(comb[strsplit(term, "")[[1]]])
}))
y_pred <- sum(x_vec_dyn * beta_hat)
x_coord <- ifelse(b_val==1, 1, 0) + ifelse(d_val==1, off, 0)
y_coord <- ifelse(c_val==1, 1, 0) + ifelse(d_val==1, off, 0)
points(x_coord, y_coord, pch=21, bg="white", col=COL_PPAL, cex=3.2, lwd=2.5)
text(x_coord, y_coord + 0.13, sprintf("%.2f", y_pred),
cex=0.95, font=2, col="#4a3b42")
}
}
}
text(0.5, -0.15, "B: Disposición", cex=0.95, col=COL_LINEA, font=2)
text(-0.17, 0.5, "C: Tipo de conteo", cex=0.95, srt=90, col=COL_LINEA, font=2)
text(0.17, 0.34, "D: Manipulación", cex=0.9, srt=45, col=COL_LINEA, font=2)
Gráfica de cubo para Tiempo (s) - Medias Ajustadas
9 Optimización de Respuesta
9.1 Configuración de parámetros de optimización
| Respuesta | Meta | Inferior | Objetivo | Superior | Ponderación | Importancia |
|---|---|---|---|---|---|---|
| Tiempo (s) | Mínimo | • | 31.11 | 52.39 | 1 | 1 |
9.2 Solución
Solución óptima global encontrada:
| Solución | B: Disposición de almacenamiento | C: Tipo de conteo | D: Manipulación manual | Tiempo (s) Ajuste | Deseabilidad compuesta |
|---|---|---|---|---|---|
| 1 | Asignación por tipo de SKU | Conteo a ciegas | Con guantes (interfaz restringida) | 32.4825 | 0.935503 |
| Note: | |||||
| El factor A (Tipo de etiquetas) no se incluye por no ser significativo; su nivel es indiferente para el tiempo predicho. |
9.3 Predicción de respuesta múltiple
Predicción de la respuesta para las condiciones óptimas:
| Respuesta | Ajuste | EE de ajuste | IC de 95% | IP de 95% |
|---|---|---|---|---|
| Tiempo (s) | 32.48 | 0.94 | (30.54; 34.42) | (28.14; 36.82) |
Resultado de la Optimización
- Objetivo: Minimizar el tiempo de conteo manual
- Tiempo Predicho (Ajuste): 32.48 segundos
- Deseabilidad Compuesta (D): 0.935503
10 Gráficos de diagnóstico
10.1 Gráficas de residuos
# ------------------------------------------------------------------
# Paleta ROSADA (tema del informe), con la misma estructura de
# diagnóstico que Minitab (cuadrícula, escala probit, serie unida).
# ------------------------------------------------------------------
mb <- COL_PPAL # "#d48eaf" -> marcadores, serie y barras
mr <- COL_LINEA # "#8a4f66" -> recta de referencia
mg <- COL_CLARO # "#f3d8e4" -> cuadrícula
m0 <- "#a87890" # mauve suave -> línea cero discontinua y caja
par(mfrow=c(2,2), mar=c(4, 4.2, 2.6, 1.2), oma=c(0,0,2.6,0),
col.main="#8a4f66", col.lab="#5c434e", col.axis="#5c434e")
## (1) Gráfica de probabilidad normal --------------------------------
# eje X = residuo (lineal); eje Y = porcentaje en escala probit
res_ord <- sort(residuos); nq <- length(res_ord)
pp <- (seq_len(nq) - 0.375) / (nq + 0.25) # posiciones de graficado (Blom)
zq <- qnorm(pp)
pct <- c(1, 10, 50, 90, 99); zt <- qnorm(pct/100) # marcas de % (escala probit)
xt1 <- seq(-5, 5, 2.5)
plot(res_ord, zq, type="n", axes=FALSE, xlim=c(-5,5), ylim=range(zt),
xlab="Residuo", ylab="Porcentaje", main="Gráfica de probabilidad normal")
abline(h=zt, v=xt1, col=mg, lwd=0.8)
abline(a = -mean(residuos)/sd(residuos), b = 1/sd(residuos), col=mr, lwd=1.5)
points(res_ord, zq, pch=16, col=mb, cex=0.95)
axis(1, at=xt1); axis(2, at=zt, labels=pct, las=1); box(col=m0)
## (2) Residuos vs. ajustes ------------------------------------------
xt2 <- seq(30, 50, 5); yt <- seq(-4, 4, 2)
plot(y_hat, residuos, type="n", axes=FALSE, xlim=c(30,50), ylim=c(-4.5,4),
xlab="Valor ajustado", ylab="Residuo", main="vs. ajustes")
abline(h=yt, v=xt2, col=mg, lwd=0.8)
abline(h=0, lty=2, col=m0, lwd=1)
points(y_hat, residuos, pch=16, col=mb, cex=0.95)
axis(1, at=xt2); axis(2, at=yt, las=1); box(col=m0)
## (3) Histograma -----------------------------------------------------
hist(residuos, breaks=seq(-4.5, 3.5, 1), col=mb, border="white",
xlim=c(-4.5,3.5), ylim=c(0,10.2), axes=FALSE,
main="Histograma", xlab="Residuo", ylab="Frecuencia")
axis(1, at=seq(-4, 3, 1)); axis(2, at=seq(0, 10, 2.5), las=1); box(col=m0)
## (4) Residuos vs. orden --------------------------------------------
xt4 <- seq(2, 32, 2)
plot(seq_along(residuos), residuos, type="n", axes=FALSE,
xlim=c(1,32), ylim=c(-4.5,4),
xlab="Orden de observación", ylab="Residuo", main="vs. orden")
abline(h=seq(-4,4,2), v=xt4, col=mg, lwd=0.8)
abline(h=0, lty=2, col=m0, lwd=1)
lines(seq_along(residuos), residuos, col=mb, lwd=1.2)
points(seq_along(residuos), residuos, pch=16, col=mb, cex=0.9)
axis(1, at=xt4); axis(2, at=seq(-4,4,2), las=1); box(col=m0)
mtext("Gráficas de residuos para Tiempo (s)",
outer=TRUE, cex=1.25, font=2, col=COL_LINEA)
Gráficas de residuos para Tiempo (s)
10.2 Diagrama de Pareto de efectos estandarizados
ef_std <- abs(T_vals)
ord <- order(ef_std, decreasing=FALSE)
# Nivel de significancia del experimento: alpha = 0.10 -> qt(0.95, gl_error)
umbral <- qt(0.95, gl_error)
colores <- ifelse(ef_std[ord] > umbral, COL_PPAL, COL_CLARO)
par(mar=c(4, 16, 4, 3))
barplot(ef_std[ord],
names.arg = nombres_leg[ord],
horiz=TRUE, col=colores, border=NA,
las=1, cex.names=0.72,
main=paste0("Diagrama de Pareto de efectos estandarizados\n",
"(la respuesta es Tiempo (s); \u03b1 = 0.10)"),
xlab="Efecto estandarizado",
xlim=c(0, max(ef_std)*1.12))
abline(v=umbral, lty=2, col=COL_LINEA, lwd=1.5)
mtext(round(umbral,2), side=3, at=umbral,
col=COL_LINEA, cex=0.85, line=0.3)
Diagrama de Pareto de efectos estandarizados (alpha = 0.10)