Estructura del análisis: La base wage1
se divide en dos grupos iguales usando el total de observaciones
disponibles (\(n/2\) cada uno):
Se analizan las variables wage, educ, tenure y exper con tres bloques:
data(wage1)
# Seleccionar las 4 variables de interés
x <- wage1[, c("wage", "educ", "tenure", "exper")]
# Total de observaciones
n <- nrow(x)
cat("Total de observaciones en wage1:", n, "\n\n")## Total de observaciones en wage1: 526
# Dividir la base en dos grupos iguales
A <- x[1:(n/2), ]
B <- x[(n/2 + 1):n, ]
cat("Grupo A: observaciones 1 a", n/2, "— n1 =", nrow(A), "\n")## Grupo A: observaciones 1 a 263 — n1 = 263
## Grupo B: observaciones 264 a 526 — n2 = 263
Interpretación: La base wage1 cuenta
con 526 observaciones. Al dividirla en dos mitades iguales se obtienen
dos grupos de 263 individuos cada uno. El Grupo A
corresponde a los primeros 263 registros y el Grupo B a
los restantes. Ambos grupos contienen las mismas cuatro variables:
salario (wage), años de educación (educ), antigüedad
laboral (tenure) y experiencia laboral (exper).
vars <- c("wage", "educ", "tenure", "exper")
desc_A <- data.frame(
Variable = vars,
n = nrow(A),
Media = round(colMeans(A), 4),
Varianza = round(apply(A, 2, var), 4),
Desv.Est = round(apply(A, 2, sd), 4),
Minimo = round(apply(A, 2, min), 4),
Maximo = round(apply(A, 2, max), 4)
)
desc_B <- data.frame(
Variable = vars,
n = nrow(B),
Media = round(colMeans(B), 4),
Varianza = round(apply(B, 2, var), 4),
Desv.Est = round(apply(B, 2, sd), 4),
Minimo = round(apply(B, 2, min), 4),
Maximo = round(apply(B, 2, max), 4)
)
cat("=== Estadisticas descriptivas — Grupo A ===\n")## === Estadisticas descriptivas — Grupo A ===
## Variable n Media Varianza Desv.Est Minimo Maximo
## wage 263 6.3024 16.7656 4.0946 0.53 24.98
## educ 263 12.7833 6.1933 2.4886 2.00 18.00
## tenure 263 4.8479 45.7172 6.7615 0.00 39.00
## exper 263 15.7947 167.9577 12.9598 1.00 48.00
##
## === Estadisticas descriptivas — Grupo B ===
## Variable n Media Varianza Desv.Est Minimo Maximo
## wage 263 5.4898 10.2328 3.1989 1.43 20
## educ 263 12.3422 9.0733 3.0122 0.00 18
## tenure 263 5.3612 58.7354 7.6639 0.00 44
## exper 263 18.2395 198.1523 14.0767 1.00 51
par(mfrow = c(1, 4), mar = c(5, 4, 3, 1))
for (v in vars) {
boxplot(
A[[v]], B[[v]],
names = c("Grupo A", "Grupo B"),
col = c("#3b82f6", "#f97316"),
border = c("#1d4ed8", "#c2410c"),
main = v,
ylab = v
)
grid(col = "#e2e8f0")
}Interpretación: Los boxplots permiten comparar visualmente la distribución de cada variable entre los dos grupos. Si las cajas se superponen ampliamente, las medias de ambos grupos son similares; si están claramente separadas, sugiere diferencias entre grupos. Las diferencias visuales observadas aquí serán contrastadas formalmente en las secciones siguientes mediante pruebas estadísticas.
# Vector de medias de cada grupo
mu_A <- colMeans(A)
mu_B <- colMeans(B)
cat("Vector de medias — Grupo A:\n"); print(round(mu_A, 4))## Vector de medias — Grupo A:
## wage educ tenure exper
## 6.3024 12.7833 4.8479 15.7947
##
## Vector de medias — Grupo B:
## wage educ tenure exper
## 5.4898 12.3422 5.3612 18.2395
##
## Diferencia (mu_A - mu_B):
## wage educ tenure exper
## 0.8126 0.4411 -0.5133 -2.4449
Interpretación: Los vectores de medias muestran el
perfil promedio de cada grupo en las cuatro variables. Las diferencias
entre mu_A y mu_B indican en qué variables los
grupos presentan mayor divergencia a nivel descriptivo. Sin embargo,
para determinar si estas diferencias son estadísticamente
significativas, se deben aplicar las pruebas formales de las secciones
siguientes.
Para cada variable se contrasta de forma independiente: \[H_0: \mu_{A,j} = \mu_{B,j} \qquad \text{vs} \qquad H_1: \mu_{A,j} \neq \mu_{B,j}\] Se aplica la prueba \(t\) de Welch (varianzas no asumidas iguales) con \(\alpha = 0.05\).
alpha <- 0.05
resultados_t <- data.frame(
Variable = character(),
Media_A = numeric(),
Media_B = numeric(),
Diferencia = numeric(),
t_stat = numeric(),
gl = numeric(),
p_valor = numeric(),
Decision = character(),
stringsAsFactors = FALSE
)
for (v in vars) {
tt <- t.test(A[[v]], B[[v]], var.equal = FALSE)
resultados_t <- rbind(resultados_t, data.frame(
Variable = v,
Media_A = round(mean(A[[v]]), 4),
Media_B = round(mean(B[[v]]), 4),
Diferencia = round(mean(A[[v]]) - mean(B[[v]]), 4),
t_stat = round(tt$statistic, 4),
gl = round(tt$parameter, 2),
p_valor = round(tt$p.value, 6),
Decision = ifelse(tt$p.value < alpha,
"Rechazar H0", "No rechazar H0"),
stringsAsFactors = FALSE
))
}
print(resultados_t, row.names = FALSE)## Variable Media_A Media_B Diferencia t_stat gl p_valor Decision
## wage 6.3024 5.4898 0.8126 2.5362 495.02 0.011514 Rechazar H0
## educ 12.7833 12.3422 0.4411 1.8307 505.99 0.067738 No rechazar H0
## tenure 4.8479 5.3612 -0.5133 -0.8145 515.99 0.415729 No rechazar H0
## exper 15.7947 18.2395 -2.4449 -2.0722 520.46 0.038741 Rechazar H0
ic_inf <- numeric(length(vars))
ic_sup <- numeric(length(vars))
for (i in seq_along(vars)) {
tt <- t.test(A[[vars[i]]], B[[vars[i]]], var.equal = FALSE)
ic_inf[i] <- tt$conf.int[1]
ic_sup[i] <- tt$conf.int[2]
}
dif <- resultados_t$Diferencia
col_barras <- ifelse(resultados_t$p_valor < alpha, "#dc2626", "#16a34a")
bp <- barplot(
dif,
names.arg = vars,
col = col_barras,
border = NA,
main = "Diferencia de Medias por Variable (A - B)\nRojo = significativa | Verde = no significativa",
ylab = "Diferencia de medias (A - B)",
ylim = c(min(ic_inf) * 1.5, max(ic_sup) * 1.5)
)
arrows(bp, ic_inf, bp, ic_sup,
angle = 90, code = 3, length = 0.08,
col = "#1e293b", lwd = 1.8)
abline(h = 0, lty = 2, col = "#64748b", lwd = 1.5)
grid(col = "#e2e8f0")Interpretación — Prueba \(t\) individual:
Al nivel de significancia del 5%, se obtienen los siguientes resultados variable por variable:
Variables con diferencia significativa (wage, exper): el p-valor es menor a 0.05, por lo que se rechaza \(H_0\). Existe evidencia estadística de que las medias de estos grupos difieren.
Variables sin diferencia significativa (educ, tenure): el p-valor es mayor a 0.05, por lo que no se rechaza \(H_0\). No hay evidencia suficiente para afirmar que las medias difieren entre grupos.
El gráfico de barras muestra las diferencias de medias (\(\bar{x}_A - \bar{x}_B\)) con sus intervalos de confianza al 95%. Cuando el intervalo no cruza el cero, la diferencia es estadísticamente significativa.
La prueba de Hotelling evalúa simultáneamente la igualdad de todos los vectores de medias: \[H_0: \boldsymbol{\mu}_A = \boldsymbol{\mu}_B \qquad \text{vs} \qquad H_1: \boldsymbol{\mu}_A \neq \boldsymbol{\mu}_B\]
El estadístico es: \[T^2 = \frac{n_1 \cdot n_2}{n_1 + n_2}\,(\bar{\mathbf{x}}_A - \bar{\mathbf{x}}_B)^\top \mathbf{S}_p^{-1}\,(\bar{\mathbf{x}}_A - \bar{\mathbf{x}}_B)\]
con matriz pooled: \[\mathbf{S}_p = \frac{(n_1-1)\mathbf{S}_A + (n_2-1)\mathbf{S}_B}{n_1 + n_2 - 2}\]
##
## Hotelling's two sample T2-test
##
## data: A and B
## T.2 = 3.1763, df1 = 4, df2 = 521, p-value = 0.01354
## alternative hypothesis: true location difference is not equal to c(0,0,0,0)
## Matriz de covarianzas S_A:
## wage educ tenure exper
## wage 16.7656 3.8127 10.6720 10.7291
## educ 3.8127 6.1933 -1.3957 -8.9912
## tenure 10.6720 -1.3957 45.7172 44.3236
## exper 10.7291 -8.9912 44.3236 167.9577
##
## Matriz de covarianzas S_B:
## wage educ tenure exper
## wage 10.2328 4.3250 8.0831 1.6078
## educ 4.3250 9.0733 -0.7424 -13.0250
## tenure 8.0831 -0.7424 58.7354 53.1460
## exper 1.6078 -13.0250 53.1460 198.1523
n1 <- nrow(A)
n2 <- nrow(B)
sp <- ((n1 - 1) * S_A + (n2 - 1) * S_B) / (n1 + n2 - 2)
cat("Matriz de covarianza pooled Sp:\n")## Matriz de covarianza pooled Sp:
## wage educ tenure exper
## wage 13.4992 4.0688 9.3775 6.1684
## educ 4.0688 7.6333 -1.0690 -11.0081
## tenure 9.3775 -1.0690 52.2263 48.7348
## exper 6.1684 -11.0081 48.7348 183.0550
Interpretación: La matriz \(\mathbf{S}_p\) es un promedio ponderado de las matrices de covarianza de cada grupo, asumiendo que ambos grupos tienen la misma estructura de variabilidad (\(\Sigma_A = \Sigma_B = \Sigma\)). Esta es la matriz utilizada para calcular el estadístico \(T^2\).
T2 <- (n1 * n2 / (n1 + n2)) * t(mu_A - mu_B) %*% solve(sp) %*% (mu_A - mu_B)
T2 <- as.numeric(T2)
cat("Estadistico T^2 =", round(T2, 4), "\n")## Estadistico T^2 = 12.7783
p <- ncol(x)
f <- ((n1 + n2 - p - 1) / (p * (n1 + n2 - 2))) * T2
pval_T2 <- pf(f, p, n1 + n2 - p - 1, lower.tail = FALSE)
dec_T2 <- ifelse(pval_T2 < alpha, "Se rechaza H0", "No se rechaza H0")
cat("Numero de variables (p) =", p, "\n")## Numero de variables (p) = 4
## Estadistico F = 3.1763
## df1 = 4 | df2 = 521
## p-valor = 1.354e-02
## alpha = 0.05
## Decision : Se rechaza H0
d_vec <- mu_A - mu_B
ell <- ellipse(sp[1:2, 1:2], centre = d_vec[1:2], level = 0.95)
plot(ell, type = "l", lwd = 2, col = "#2563eb",
main = "Region de confianza al 95%\n(wage vs educ)",
xlab = expression(mu[A] - mu[B] ~ "(wage)"),
ylab = expression(mu[A] - mu[B] ~ "(educ)"),
panel.first = grid(col = "#e2e8f0"))
points(d_vec[1], d_vec[2], pch = 19, col = "#dc2626", cex = 1.8)
points(0, 0, pch = 4, col = "#16a34a", cex = 2.2, lwd = 2.5)
abline(h = 0, v = 0, lty = 2, col = "#94a3b8")
legend("topright",
legend = c("Diferencia observada", "Origen H0"),
pch = c(19, 4),
col = c("#dc2626", "#16a34a"),
pt.lwd = 2, bty = "n")Interpretación — Prueba \(T^2\) de Hotelling:
Al nivel de significancia del 5%, con un estadístico \(T^2 =\) 12.7783 transformado a \(F =\) 3.1763 con \(p\)-valor \(=\) 1.35e-02:
Ventaja sobre las pruebas \(t\) individuales: la prueba de Hotelling controla el error de tipo I global al evaluar todas las variables simultáneamente, evitando la inflación del error por comparaciones múltiples.
Región de confianza: La elipse azul representa la región de confianza al 95% para la diferencia de medias entre grupos en las variables wage y educ. Si el origen \((0, 0)\) — representado por la cruz verde — queda fuera de la elipse, se rechaza \(H_0\) para ese par de variables.
Para cada variable se contrasta la igualdad de varianzas poblacionales: \[H_0: \sigma^2_{A,j} = \sigma^2_{B,j} \qquad \text{vs} \qquad H_1: \sigma^2_{A,j} \neq \sigma^2_{B,j}\]
El estadístico es \(F = S^2_A \,/\, S^2_B \sim F_{n_1-1,\, n_2-1}\) bajo \(H_0\). Se rechaza \(H_0\) si \(F < F_{\alpha/2}\) o \(F > F_{1-\alpha/2}\).
resultados_F <- data.frame(
Variable = character(),
Varianza_A = numeric(),
Varianza_B = numeric(),
Razon_F = numeric(),
F_crit_inf = numeric(),
F_crit_sup = numeric(),
p_valor = numeric(),
Decision = character(),
stringsAsFactors = FALSE
)
for (v in vars) {
vA <- var(A[[v]])
vB <- var(B[[v]])
Fst <- vA / vB
g1 <- n1 - 1
g2 <- n2 - 1
Fci <- qf(alpha / 2, df1 = g1, df2 = g2)
Fcs <- qf(1 - alpha / 2, df1 = g1, df2 = g2)
pv <- 2 * min(
pf(Fst, df1 = g1, df2 = g2, lower.tail = TRUE),
pf(Fst, df1 = g1, df2 = g2, lower.tail = FALSE)
)
resultados_F <- rbind(resultados_F, data.frame(
Variable = v,
Varianza_A = round(vA, 4),
Varianza_B = round(vB, 4),
Razon_F = round(Fst, 4),
F_crit_inf = round(Fci, 4),
F_crit_sup = round(Fcs, 4),
p_valor = round(pv, 6),
Decision = ifelse(pv < alpha, "Rechazar H0", "No rechazar H0"),
stringsAsFactors = FALSE
))
}
print(resultados_F, row.names = FALSE)## Variable Varianza_A Varianza_B Razon_F F_crit_inf F_crit_sup p_valor
## wage 16.7656 10.2328 1.6384 0.7845 1.2747 0.000071
## educ 6.1933 9.0733 0.6826 0.7845 1.2747 0.002082
## tenure 45.7172 58.7354 0.7784 0.7845 1.2747 0.043040
## exper 167.9577 198.1523 0.8476 0.7845 1.2747 0.181560
## Decision
## Rechazar H0
## Rechazar H0
## Rechazar H0
## No rechazar H0
col_F <- ifelse(resultados_F$p_valor < alpha, "#dc2626", "#16a34a")
F_crit_sup <- resultados_F$F_crit_sup[1]
barplot(
resultados_F$Razon_F,
names.arg = vars,
col = col_F,
border = NA,
main = "Razon de Varianzas F = S²A / S²B\nRojo = significativa | Verde = varianzas iguales",
ylab = "F = S²A / S²B",
ylim = c(0, max(resultados_F$Razon_F, F_crit_sup) * 1.3)
)
abline(h = F_crit_sup, lty = 2, col = "#f97316", lwd = 2)
abline(h = 1, lty = 3, col = "#64748b", lwd = 1.5)
grid(col = "#e2e8f0")
legend("topright",
legend = c(paste0("F critico sup = ", round(F_crit_sup, 3)),
"F = 1 (igualdad de varianzas)"),
lty = c(2, 3),
col = c("#f97316", "#64748b"),
bty = "n", cex = 0.88)Interpretación — Prueba \(F\) de igualdad de varianzas:
Al nivel de significancia del 5%, los resultados de la comparación de varianzas son:
Variables con varianzas significativamente diferentes (wage, educ, tenure): se rechaza \(H_0\). La variabilidad de estas variables difiere entre el Grupo A y el Grupo B, lo cual implica que el supuesto de homogeneidad de varianzas no se cumple para ellas.
Variables con varianzas iguales (exper): no se rechaza \(H_0\). No hay evidencia de diferencia en la dispersión entre grupos para estas variables.
Relevancia práctica: este resultado es importante porque la prueba \(T^2\) de Hotelling asume homogeneidad de la matriz de covarianzas (\(\Sigma_A = \Sigma_B\)). Si varias variables presentan varianzas diferentes entre grupos, dicho supuesto podría estar comprometido.
## ======================================================
## RESUMEN GENERAL DEL ANALISIS
## wage1 | n=526 | A: 1-263 | B: 264-526
## ======================================================
## Variables : wage, educ, tenure, exper
## n1 = 263 | n2 = 263 | p = 4
## ── 1. PRUEBA t (medias univariadas) ─────────────────
## wage | A= 6.302 B= 5.490 | dif=+0.8126 | t= 2.5362 | p=0.011514 | Rechazar H0
## educ | A=12.783 B=12.342 | dif=+0.4411 | t= 1.8307 | p=0.067738 | No rechazar H0
## tenure | A= 4.848 B= 5.361 | dif=-0.5133 | t=-0.8145 | p=0.415729 | No rechazar H0
## exper | A=15.795 B=18.239 | dif=-2.4449 | t=-2.0722 | p=0.038741 | Rechazar H0
##
## ── 2. T² DE HOTELLING (medias multivariadas) ────────
## T²=12.7783 | F=3.1763 | df1=4 | df2=521 | p=0.013540 | Se rechaza H0
##
## ── 3. PRUEBA F (varianzas univariadas) ──────────────
## wage | S²A=16.7656 S²B=10.2328 | F=1.6384 | p=0.000071 | Rechazar H0
## educ | S²A=6.1933 S²B=9.0733 | F=0.6826 | p=0.002082 | Rechazar H0
## tenure | S²A=45.7172 S²B=58.7354 | F=0.7784 | p=0.043040 | Rechazar H0
## exper | S²A=167.9577 S²B=198.1523 | F=0.8476 | p=0.181560 | No rechazar H0
##
## [!] Rechazar H0 | [=] No rechazar H0
## alpha = 0.05 en todos los contrastes
## ======================================================
## Con base en los tres análisis realizados sobre los grupos A y B
## de la base wage1 (n1 = n2 = 263 ), se concluye:
## 1. COMPARACION DE MEDIAS (prueba t variable por variable)
## ─────────────────────────────────────────────────────
## wage : A=6.302 vs B=5.490 | p=0.01151 [SIGNIFICATIVA]
## educ : A=12.783 vs B=12.342 | p=0.06774 [NO SIGNIFICATIVA]
## tenure : A=4.848 vs B=5.361 | p=0.41573 [NO SIGNIFICATIVA]
## exper : A=15.795 vs B=18.239 | p=0.03874 [SIGNIFICATIVA]
##
## De las 4 variables, 2 presentan diferencias significativas
## en sus medias entre grupos: wage, exper.
##
## 2. COMPARACION MULTIVARIANTE (T² de Hotelling)
## ─────────────────────────────────────────────────────
## Se RECHAZA H0 (T²=12.7783, F=3.1763, p=0.013540).
## Los vectores de medias de ambos grupos son conjuntamente
## diferentes al nivel de significancia del 5%.
##
## 3. COMPARACION DE VARIANZAS (prueba F variable por variable)
## ─────────────────────────────────────────────────────
## wage : S²A=16.7656 vs S²B=10.2328 | p=0.00007 [SIGNIFICATIVA]
## educ : S²A=6.1933 vs S²B=9.0733 | p=0.00208 [SIGNIFICATIVA]
## tenure : S²A=45.7172 vs S²B=58.7354 | p=0.04304 [SIGNIFICATIVA]
## exper : S²A=167.9577 vs S²B=198.1523 | p=0.18156 [NO SIGNIFICATIVA]
##
## 3 variable(s) presentan varianzas significativamente
## diferentes entre grupos: wage, educ, tenure.
## Esto sugiere que el supuesto de homogeneidad de covarianzas
## de la prueba T² podria estar comprometido en esas variables.