Experimento Factorial Completo 2^5
Modelo Depurado y Optimizado
Sofía Orozco, Katherine Pascasio, Abigail Rivera, Camila Sibaja, Fiorella Monge
18 de May del 2026
1 Datos y álgebra matricial
datos_raw <- data.frame(
orden_alea = c(37,55,19,38,17,10,15,56,53,46,
2,14,23,29,34,33,28, 8,63,52,
26, 6,61,35,44,20,27,62,59,64,
42, 7,54,22,58,40,18,43,39, 4,
47,21,31,16,32, 3,36,48,50, 5,
49,30, 1,51,57,41,24, 9,12,60,
45,11,25,13),
corrida = 1:64,
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, 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,-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, 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,-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),
E = 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, 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(37.4,36.3,42.8,30.4,44.6,39.1,33.5,31.3,45.8,33.0,
37.1,29.7,36.3,41.0,38.9,43.3,35.6,32.5,33.8,36.7,
33.1,31.2,37.8,44.5,34.0,35.0,35.2,29.2,37.9,31.5,
35.2,35.0,30.1,29.2,36.6,31.1,43.1,38.3,37.2,36.6,
33.3,40.6,34.1,29.7,32.8,43.6,37.1,30.2,42.5,42.2,
44.9,30.1,43.2,41.6,41.0,44.9,31.2,44.0,36.4,33.6,
37.9,42.6,43.2,42.2)
)
yates_col = function(k, n) rep(rep(c(-1,1), each=2^(k-1)), times=n/(2^k))
n_trat <- 32; n_rep <- 2
ydf <- data.frame(A=yates_col(1,n_trat), B=yates_col(2,n_trat),
C=yates_col(3,n_trat), D=yates_col(4,n_trat),
E=yates_col(5,n_trat), trat_num=1:n_trat)
ydf$trat_key <- paste(ydf$A,ydf$B,ydf$C,ydf$D,ydf$E,sep="_")
datos_raw$trat_key <- paste(datos_raw$A,datos_raw$B,datos_raw$C,
datos_raw$D,datos_raw$E,sep="_")
datos_raw <- datos_raw[order(datos_raw$trat_key,datos_raw$corrida),]
datos_raw$rep <- ave(seq_len(nrow(datos_raw)),datos_raw$trat_key,FUN=seq_along)
r1 <- datos_raw[datos_raw$rep==1,c("trat_key","y")]
r2 <- datos_raw[datos_raw$rep==2,c("trat_key","y")]
ydf <- merge(ydf,r1,by="trat_key"); names(ydf)[names(ydf)=="y"] <- "y1"
ydf <- merge(ydf,r2,by="trat_key"); names(ydf)[names(ydf)=="y"] <- "y2"
ydf <- ydf[order(ydf$trat_num),]
y_vec <- c(ydf$y1, ydf$y2)
n <- length(y_vec)
trat_id <- rep(1:n_trat, times=n_rep)
A_r <- ydf$A[trat_id]; B_r <- ydf$B[trat_id]
C_r <- ydf$C[trat_id]; D_r <- ydf$D[trat_id]; E_r <- ydf$E[trat_id]
# ── Matriz X depurada de Minitab: 24 términos + intercepto ───────
X <- cbind(
I = 1,
A = A_r, B = B_r, C = C_r, D = D_r, E = E_r,
AB = A_r*B_r, AC = A_r*C_r, AD = A_r*D_r, AE = A_r*E_r,
BC = B_r*C_r, BD = B_r*D_r, BE = B_r*E_r,
CD = C_r*D_r, CE = C_r*E_r, DE = D_r*E_r,
ABC = A_r*B_r*C_r, ABD = A_r*B_r*D_r,
ACD = A_r*C_r*D_r, ACE = A_r*C_r*E_r,
BCD = B_r*C_r*D_r, BCE = B_r*C_r*E_r,
BDE = B_r*D_r*E_r, CDE = C_r*D_r*E_r,
ABCD = A_r*B_r*C_r*D_r
)
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) # 64 - 25 = 39
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_reales_lista <- c(
"A"="Formato", "B"="Tamaño letra", "C"="Agrupación", "D"="Alineación", "E"="Guías",
"AB"="Formato * Tamaño letra", "AC"="Formato * Agrupación", "AD"="Formato * Alineación", "AE"="Formato * Guías",
"BC"="Tamaño letra * Agrupación", "BD"="Tamaño letra * Alineación", "BE"="Tamaño letra * Guías",
"CD"="Agrupación * Alineación", "CE"="Agrupación * Guías", "DE"="Alineación * Guías",
"ABC"="Formato * Tamaño letra * Agrupación", "ABD"="Formato * Tamaño letra * Alineación",
"ACD"="Formato * Agrupación * Alineación", "ACE"="Formato * Agrupación * Guías",
"BCD"="Tamaño letra * Agrupación * Alineación", "BCE"="Tamaño letra * Agrupación * Guías",
"BDE"="Tamaño letra * Alineación * Guías", "CDE"="Agrupación * Alineación * Guías",
"ABCD"="Formato * Tamaño letra * Agrupación * Alineación"
)
nombres_leg <- nombres_reales_lista[nombres_ef]
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<ALPHA,".",""))))
lf <- lillie.test(residuos)
dw <- sum(diff(residuos)^2) / sum(residuos^2)
h_ii <- diag(H)
resid_est <- as.vector(residuos) / (sqrt(CM_error) * sqrt(1-h_ii))
cat(sprintf("Modelo depurado: 24 terminos + intercepto | gl_error = %d\n", gl_error))## Modelo depurado: 24 terminos + intercepto | gl_error = 39cat(sprintf("S=%.5f R2=%.2f%% R2adj=%.2f%% R2pred=%.2f%%\n",
sqrt(CM_error), R2_full*100, R2_adj_full*100, R2_pred*100))## S=1.62871 R2=93.20% R2adj=89.01% R2pred=81.68%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=paste0("Coeficientes codificados del modelo depurado (alfa = ",
ALPHA, ")"),
col.names=c("Término","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 | — | 36.934 | 0.204 | 181.42 | 0.0000 | — | *** | |
| A | Formato | -6.131 | -3.066 | 0.204 | -15.06 | 0.0000 | 1.00 | *** |
| B | Tamaño letra | -2.538 | -1.269 | 0.204 | -6.23 | 0.0000 | 1.00 | *** |
| C | Agrupación | -5.269 | -2.634 | 0.204 | -12.94 | 0.0000 | 1.00 | *** |
| D | Alineación | -1.962 | -0.981 | 0.204 | -4.82 | 0.0000 | 1.00 | *** |
| E | Guías | -0.212 | -0.106 | 0.204 | -0.52 | 0.6047 | 1.00 | |
| AB | Formato * Tamaño letra | 1.713 | 0.856 | 0.204 | 4.21 | 0.0001 | 1.00 | *** |
| AC | Formato * Agrupación | -0.819 | -0.409 | 0.204 | -2.01 | 0.0513 | 1.00 | . |
| AD | Formato * Alineación | 0.450 | 0.225 | 0.204 | 1.11 | 0.2759 | 1.00 | |
| AE | Formato * Guías | 0.175 | 0.088 | 0.204 | 0.43 | 0.6697 | 1.00 | |
| BC | Tamaño letra * Agrupación | 0.162 | 0.081 | 0.204 | 0.40 | 0.6920 | 1.00 | |
| BD | Tamaño letra * Alineación | -0.306 | -0.153 | 0.204 | -0.75 | 0.4565 | 1.00 | |
| BE | Tamaño letra * Guías | -0.406 | -0.203 | 0.204 | -1.00 | 0.3246 | 1.00 | |
| CD | Agrupación * Alineación | 0.837 | 0.419 | 0.204 | 2.06 | 0.0464 | 1.00 |
|
| CE | Agrupación * Guías | 0.500 | 0.250 | 0.204 | 1.23 | 0.2268 | 1.00 | |
| DE | Alineación * Guías | -0.881 | -0.441 | 0.204 | -2.16 | 0.0366 | 1.00 |
|
| ABC | Formato * Tamaño letra * Agrupación | 1.588 | 0.794 | 0.204 | 3.90 | 0.0004 | 1.00 | *** |
| ABD | Formato * Tamaño letra * Alineación | 0.856 | 0.428 | 0.204 | 2.10 | 0.0420 | 1.00 |
|
| ACD | Formato * Agrupación * Alineación | 0.575 | 0.288 | 0.204 | 1.41 | 0.1658 | 1.00 | |
| ACE | Formato * Agrupación * Guías | -0.762 | -0.381 | 0.204 | -1.87 | 0.0686 | 1.00 | . |
| BCD | Tamaño letra * Agrupación * Alineación | -0.069 | -0.034 | 0.204 | -0.17 | 0.8668 | 1.00 | |
| BCE | Tamaño letra * Agrupación * Guías | 0.719 | 0.359 | 0.204 | 1.77 | 0.0854 | 1.00 | . |
| BDE | Tamaño letra * Alineación * Guías | 1.063 | 0.531 | 0.204 | 2.61 | 0.0128 | 1.00 |
|
| CDE | Agrupación * Alineación * Guías | 0.694 | 0.347 | 0.204 | 1.70 | 0.0964 | 1.00 | . |
| ABCD | Formato * Tamaño letra * Agrupación * Alineación | -0.856 | -0.428 | 0.204 | -2.10 | 0.0420 | 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=paste0("Resumen del modelo factorial depurado (alfa = ",ALPHA,")"),
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.62871 | 93.2% | 89.01% | 81.68% |
4 Análisis de varianza (ANOVA)
SC_modelo <- sum(SC_ef)
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)
grupos <- list()
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érminos", idx=idx_2, gl=length(idx_2))
if(length(idx_3)>0) grupos[[length(grupos)+1]] <- list(n="Interacciones de 3 términos", idx=idx_3, gl=length(idx_3))
if(length(idx_4)>0) grupos[[length(grupos)+1]] <- list(n="Interacciones de 4 términos", 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=paste0("Análisis de varianza — Modelo depurado (alfa = ", ALPHA, ")"),
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 | 24 | 1417.07 | 59.045 | 22.26 | ||
| Lineal | 5 | 1211 | 242.2 | 91.3 | ||
| Formato | 1 | 601.48 | 601.476 | 226.74 | 0 | *** |
| Tamaño letra | 1 | 103.02 | 103.023 | 38.84 | 0 | *** |
| Agrupación | 1 | 444.16 | 444.156 | 167.44 | 0 | *** |
| Alineación | 1 | 61.62 | 61.622 | 23.23 | 0 | *** |
| Guías | 1 | 0.72 | 0.722 | 0.27 | 0.6047 | |
| Interacciones de 2 términos | 10 | 93.59 | 9.359 | 3.53 | ||
| Formato * Tamaño letra | 1 | 46.92 | 46.923 | 17.69 | 1e-04 | *** |
| Formato * Agrupación | 1 | 10.73 | 10.726 | 4.04 | 0.0513 | . |
| Formato * Alineación | 1 | 3.24 | 3.24 | 1.22 | 0.2759 | |
| Formato * Guías | 1 | 0.49 | 0.49 | 0.18 | 0.6697 | |
| Tamaño letra * Agrupación | 1 | 0.42 | 0.422 | 0.16 | 0.692 | |
| Tamaño letra * Alineación | 1 | 1.5 | 1.501 | 0.57 | 0.4565 | |
| Tamaño letra * Guías | 1 | 2.64 | 2.641 | 1 | 0.3246 | |
| Agrupación * Alineación | 1 | 11.22 | 11.222 | 4.23 | 0.0464 |
|
| Agrupación * Guías | 1 | 4 | 4 | 1.51 | 0.2268 | |
| Alineación * Guías | 1 | 12.43 | 12.426 | 4.68 | 0.0366 |
|
| Interacciones de 3 términos | 8 | 100.75 | 12.594 | 4.75 | ||
| Formato * Tamaño letra * Agrupación | 1 | 40.32 | 40.323 | 15.2 | 4e-04 | *** |
| Formato * Tamaño letra * Alineación | 1 | 11.73 | 11.731 | 4.42 | 0.042 |
|
| Formato * Agrupación * Alineación | 1 | 5.29 | 5.29 | 1.99 | 0.1658 | |
| Formato * Agrupación * Guías | 1 | 9.3 | 9.302 | 3.51 | 0.0686 | . |
| Tamaño letra * Agrupación * Alineación | 1 | 0.08 | 0.076 | 0.03 | 0.8668 | |
| Tamaño letra * Agrupación * Guías | 1 | 8.27 | 8.266 | 3.12 | 0.0854 | . |
| Tamaño letra * Alineación * Guías | 1 | 18.06 | 18.063 | 6.81 | 0.0128 |
|
| Agrupación * Alineación * Guías | 1 | 7.7 | 7.701 | 2.9 | 0.0964 | . |
| Interacciones de 4 términos | 1 | 11.73 | 11.731 | 4.42 | ||
| Formato * Tamaño letra * Agrupación * Alineación | 1 | 11.73 | 11.731 | 4.42 | 0.042 |
|
| Error | 39 | 103.46 | 2.653 | |||
| Total | 63 | 1520.52 | ||||
| Note: | ||||||
| *** p < 0.001 ** p < 0.01 * p < 0.05 . p < 0.10 |
5 Ecuación de regresión en unidades codificadas
Tiempo (s) =
36.934
- 3.066 ×
(Formato)
- 1.269 × (Tamaño letra)
-
2.634 × (Agrupación)
- 0.981 ×
(Alineación)
+ 0.856 × (Formato * Tamaño
letra)
- 0.409 × (Formato *
Agrupación)
+ 0.419 × (Agrupación *
Alineación)
- 0.441 × (Alineación *
Guías)
+ 0.794 × (Formato * Tamaño letra *
Agrupación)
+ 0.428 × (Formato * Tamaño letra *
Alineación)
- 0.381 × (Formato * Agrupación *
Guías)
+ 0.359 × (Tamaño letra * Agrupación *
Guías)
+ 0.531 × (Tamaño letra * Alineación *
Guías)
+ 0.347 × (Agrupación * Alineación *
Guías)
- 0.428 × (Formato * Tamaño letra * Agrupación *
Alineación)
Términos significativos con p < 0.10 (alfa =
0.10).
Ecuación expresada estrictamente en Unidades Codificadas de
Minitab.
Todos los factores e interacciones operan geométricamente
en la escala balanceada estándar de [-1; +1].
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ósticos 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 |
|---|---|---|---|---|---|---|
| 5 | 37.4 | 40.59 | -3.19 | -2.51 | 0.1618 | R, C |
| 10 | 39.1 | 36.64 | 2.46 | 1.93 | 0.0957 | C |
| 13 | 37.9 | 40.07 | -2.17 | -1.71 | 0.0746 | C |
| 21 | 45.8 | 42.41 | 3.39 | 2.67 | 0.1827 | R, C |
| 26 | 33.1 | 35.36 | -2.26 | -1.77 | 0.0807 | C |
| 43 | 42.6 | 40.14 | 2.46 | 1.93 | 0.0957 | C |
| 45 | 42.2 | 40.07 | 2.13 | 1.68 | 0.0720 | C |
| Note: | ||||||
|
R = Residuo grande (|Resid. est.| > 2) C = Distancia de Cook alta (D > 0.0625) |
res_max_idx <- which.max(abs(residuos))
G_stat <- abs(residuos[res_max_idx]-mean(residuos)) / sd(residuos)
t_crit <- qt(1 - ALPHA/(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)",
Obs_extrema = 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ípico detectado",
"No se rechaza H0: no hay evidencia de valores atípicos")
)
kable(grubbs_df,
caption=paste0("Prueba de Grubbs (alfa = ", ALPHA, ")"),
col.names=c("Prueba","Obs. más extrema","Estadístico G",
"Valor crítico","Conclusión"),
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 | Conclusión |
|---|---|---|---|---|
| Grubbs (un extremo) | 21 | 2.6483 | 3.051 | 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("Lilliefors (Kolmogorov-Smirnov)",
"Durbin-Watson"),
Estadistico = c(round(lf$statistic, 4), round(dw, 4)),
Valorp = c(round(lf$p.value, 4), "---"),
Conclusion = c(
ifelse(lf$p.value > ALPHA,
paste0("No se rechaza H0 — residuos normales (alfa=",ALPHA,")"),
paste0("Se rechaza H0 — residuos no normales (alfa=",ALPHA,")")),
ifelse(dw > 1.5 & dw < 2.5,
"No hay evidencia de autocorrelación",
"Posible autocorrelación, revisar")),
stringsAsFactors=FALSE)
kable(sup_df,
caption=paste0("Verificación de supuestos (alfa = ", ALPHA, ")"),
col.names=c("Supuesto","Prueba","Estadístico","Valor p","Conclusión"),
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="28%")| Supuesto | Prueba | Estadístico | Valor p | Conclusión | |
|---|---|---|---|---|---|
| D | Normalidad de residuos | Lilliefors (Kolmogorov-Smirnov) | 0.0450 | 0.9875 | No se rechaza H0 — residuos normales (alfa=0.1) |
| Independencia de residuos | Durbin-Watson | 1.8175 | — | No hay evidencia de autocorrelación |
8 Análisis gráfico (medias ajustadas)
8.1 Gráficas de efectos principales
par(mfrow=c(2,3), mar=c(4.5,4.5,3.8,2), oma=c(0,0,2.5,0))
factores = list(A_r, B_r, C_r, D_r, E_r)
nombres_f = c("A: Formato","B: Tamaño letra","C: Agrupación",
"D: Alineación","E: Guías")
for(i in 1:5) {
medias <- tapply(y_hat, factores[[i]], mean)
plot(0, 0, type="n", xaxt="n", xlab=nombres_f[i], ylab="Media ajustada (s)",
main=nombres_f[i], cex.main=1.0, col.main=COL_LINEA,
xlim=c(-1.2, 1.2), ylim=c(33, 41))
lines(c(-1,1), medias, type="b", pch=19, col=COL_PPAL, lwd=2.5, cex=1.5)
axis(1, at=c(-1,1), labels=c("-1","+1"))
abline(h=mean(y_hat), lty=2, col="gray60", lwd=1)
posicion_texto <- ifelse(medias > 38.5, 1, 3)
text(c(-1,1), medias, labels=sprintf("%.1f s", medias),
pos=posicion_texto, cex=0.90, col=COL_LINEA, font=2)
}
mtext("Gráficas de efectos principales (Escala unificada 33 - 41 s)",
outer=TRUE, cex=1.1, font=2, col=COL_LINEA)
par(mfrow=c(1,1), mar=c(5,4,4,2), oma=c(0,0,0,0))
Graficas de efectos principales para Tiempo
8.2 Gráficas de interacción
nombres_dobles <- nombres_ef[nchar(nombres_ef)==2]
nc <- 2; nr <- ceiling(length(nombres_dobles)/nc)
par(mfrow=c(nr, nc), mar=c(4, 4.2, 3, 1), oma=c(0,0,3,0))
for(term in nombres_dobles) {
letras_split <- strsplit(term, "")[[1]]
idx1 <- match(letras_split[1], c("A","B","C","D","E"))
idx2 <- match(letras_split[2], c("A","B","C","D","E"))
f1 <- factores[[idx1]]
f2 <- factores[[idx2]]
nf1 <- nombres_f[idx1]
nf2 <- nombres_f[idx2]
nombre_traza <- substr(nf2, regexpr(":", nf2) + 2, nchar(nf2))
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 = 3,
xaxt = "n",
xlab = nf1,
ylab = "Media ajustada (s)",
main = paste0(nf1, " x ", nombre_traza),
col.main = COL_LINEA,
text.col = "#4a3b42",
cex.main = 1.0,
cex.axis = 1.1,
cex.lab = 1.1,
legend = TRUE,
trace.label = nombre_traza,
leg.bty = "n",
ylim = c(30, 44)
)
axis(1, at=c(-1,1), labels=c("-1","+1"), cex.axis=1.1)
}
n_vacios <- nr*nc - length(nombres_dobles)
if(n_vacios > 0) for(i in seq_len(n_vacios)) plot.new()
mtext("Gráficas de interacción (Escala unificada 30 - 44 s)",
outer=TRUE, cex=1.1, font=2, col=COL_LINEA)
Graficas de interaccion para Tiempo
8.3 Gráficas de cubo
par(mfrow=c(2,2), mar=c(2.5, 2.5, 4, 2), oma=c(0,0,3,0))
for(d_val in c(-1,1)) {
for(e_val in c(-1,1)) {
plot(0,0, type="n", xlim=c(-0.2,1.65), ylim=c(-0.2,1.65),
axes=FALSE, xlab="", ylab="",
main=sprintf("D (Alineación) = %+d | E (Guías) = %+d",
d_val, e_val),
col.main=COL_LINEA, cex.main=1.05)
rect(0,0,1,1, border=COL_LINEA, lwd=1.8)
rect(0.4,0.4,1.4,1.4, border=COL_LINEA, lwd=1.8)
segments(c(0,1,0,1), c(0,0,1,1),
c(0.4,1.4,0.4,1.4), c(0.4,0.4,1.4,1.4),
col=COL_LINEA, lwd=1.8)
for(c_val in c(-1,1)) for(b_val in c(-1,1)) for(a_val in c(-1,1)) {
vc <- c(A=a_val, B=b_val, C=c_val, D=d_val, E=e_val)
xv <- c(1, sapply(nombres_ef, function(t)
prod(vc[strsplit(t,"")[[1]]])))
yp <- sum(xv * beta_hat)
xc <- ifelse(a_val==1, 1, 0) + ifelse(c_val==1, 0.4, 0)
yc <- ifelse(b_val==1, 1, 0) + ifelse(c_val==1, 0.4, 0)
points(xc, yc, pch=21, bg="white", col=COL_PPAL, cex=3.5, lwd=2.5)
text(xc, yc, sprintf("%.1f", yp), cex=0.82, font=2, col="#4a3b42")
}
text(0.5, -0.13, "A: Formato", cex=0.85, col=COL_LINEA, font=2)
text(-0.15, 0.5, "B: Tamaño", cex=0.85, srt=90, col=COL_LINEA, font=2)
text(0.15, 0.25, "C: Agrupación", cex=0.78, srt=40, col=COL_LINEA, font=2)
text(c(0,1), c(-0.07,-0.07), c("-1","+1"), cex=0.72, col="gray40")
text(c(-0.08,-0.08), c(0,1), c("-1","+1"), cex=0.72, col="gray40")
}
}
mtext("Gráficas de cubo — Medias ajustadas (s)",
outer=TRUE, cex=1.2, font=2, col=COL_LINEA)
Graficas de cubo para Tiempo
9 Optimización de respuesta
9.1 Parámetros
| Respuesta | Meta | Inferior | Objetivo | Superior | Ponderación | Importancia |
|---|---|---|---|---|---|---|
| Tiempo (s) | Mínimo |
|
29.2 | 45.8 | 1 | 1 |
9.2 Solución
| Solución | Formato | Tamaño letra | Agrupación | Alineación | Guías | Tiempo (s) Ajuste | Deseabilidad compuesta |
|---|---|---|---|---|---|---|---|
| 1 | Arial | Fuente de 10 pt | En bloques | Tabular | Con sombreado intercalado | 29.5688 | 0.977786 |
9.3 Predicción de respuesta múltiple
| Respuesta | Ajuste | EE de ajuste | IC de 95% | IP de 95% |
|---|---|---|---|---|
| Tiempo (s) | 29.57 | 1.02 | (27.51; 31.63) | (25.68; 33.45) |
Configuración Óptima Seleccionada
- Formato: Arial (+1)
- Tamaño letra: Fuente de 10 pt (−1)
- Agrupación: En bloques (+1)
- Alineación: Tabular (+1)
- Guías: Con sombreado intercalado (+1)
10 Gráficos de diagnóstico
# ---- CONFIGURACIÓN DE PANEL DE DIAGNÓSTICO 4 EN 1 - PALETA DE ROSADOS ----
# Sincronización cromática total usando las variables estéticas del reporte
par(mfrow=c(2,2), mar=c(4.5,4.5,3,1.5), oma=c(0,0,2.5,0))
# 1. Gráfica de probabilidad normal
qqnorm(residuos, main="Gráfica de probabilidad normal",
xlab="Residuo", ylab="Porcentaje", pch=20, col=COL_PPAL, cex=1.2)
qqline(residuos, col=COL_LINEA, lwd=1.5)
# 2. Ajustes vs. Residuos
plot(as.vector(y_hat), as.vector(residuos), pch=20, col=COL_PPAL, cex=1.2,
main="Contra los ajustes", xlab="Valor ajustado", ylab="Residuo")
abline(h=0, lty=2, col=COL_LINEA, lwd=1.2)
# 3. Histograma
hist(residuos, col=COL_PPAL, border="white",
main="Histograma", xlab="Residuo", ylab="Frecuencia", breaks=10)
# 4. Orden vs. Residuos
plot(seq_along(residuos), residuos, type="b", pch=20, col=COL_PPAL, cex=1.2,
main="Contra el orden", xlab="Orden de observación", ylab="Residuo")
abline(h=0, lty=2, col=COL_LINEA, lwd=1.2)
mtext("Gráficas de residuos para Tiempo (s) — Panel 4 en 1",
outer=TRUE, cex=1.1, font=2, col=COL_LINEA)
Graficas de residuos para Tiempo
10.1 Diagrama de Pareto de efectos estandarizados
ef_std = abs(T_vals)
ord = order(ef_std, decreasing=FALSE)
umbral = qt(1 - ALPHA/2, gl_error)
colores = ifelse(ef_std[ord] > umbral, COL_PPAL, COL_CLARO)
par(mar=c(4, 22, 4, 3))
barplot(ef_std[ord],
names.arg = nombres_leg[ord],
horiz=TRUE, col=colores, border=NA,
las=1, cex.names=0.63,
main=paste0("Diagrama de Pareto de efectos estandarizados\n",
"(la respuesta es Tiempo (s); alfa = ", ALPHA, ")"),
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